Kopieren Sie den Codecode wie folgt:
//Referenz- und TYPE-Variablendeklaration
verwendet
Windows, Nachrichten, SysUtils, Varianten, Klassen, Grafiken, Steuerelemente, Formulare,
Dialoge, StdCtrls,nb30; {Wichtiges Zitat}
Typ
PASTAT = ^TASTAT;
TASTAT=Datensatz
Adapter: TAdapterStatus;
name_buf: TNameBuffer;
Ende;
TForm1 = Klasse(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Button2: TButton;
Edit4: TEdit;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
Privat
{Private Erklärungen}
öffentlich
{Öffentliche Erklärungen}
Ende;
var
Form1: TForm1;
Durchführung
{$R *.dfm}
Typ
TCPUID = array[1..4] of Longint;
//Erhalten Sie die Seriennummer der Festplatte:
function GetIdeSerialNumber: pchar; //Die werkseitige Seriennummer der Festplatte abrufen;
const IDENTIFY_BUFFER_SIZE = 512;
Typ
TIDERegs = gepackter Datensatz
bFeaturesReg: BYTE;
bSectorCountReg: BYTE;
bSectorNumberReg: BYTE;
bCylLowReg: BYTE;
bCylHighReg: BYTE;
bDriveHeadReg: BYTE;
bCommandReg: BYTE;
bReserviert: BYTE;
Ende;
TSendCmdInParams = gepackter Datensatz
cBufferSize: DWORD;
irDriveRegs: TIDERegs;
bDriveNumber: BYTE;
bReserved: array[0..2] of Byte;
dwReserved: Array[0..3] von DWORD;
bBuffer: array[0..0] of Byte;
Ende;
TIdSector = gepackter Datensatz
wGenConfig: Word;
wNumCyls: Wort;
wReserviert: Wort;
wNumHeads: Wort;
wBytesPerTrack: Word;
wBytesPerSector: Word;
wSectorsPerTrack: Word;
wVendorUnique: Array[0..2] von Word;
sSerialNumber: array[0..19] of CHAR;
wBufferType: Word;
wBufferSize: Word;
wECCSize: Word;
sFirmwareRev: array[0..7] of Char;
sModelNumber: array[0..39] of Char;
wMoreVendorUnique: Word;
wDoubleWordIO: Wort;
wCapabilities: Word;
wReserved1: Wort;
wPIOTiming: Wort;
wDMATiming: Wort;
wBS: Wort;
wNumCurrentCyls: Word;
wNumCurrentHeads: Word;
wNumCurrentSectorsPerTrack: Word;
ulCurrentSectorCapacity: DWORD;
wMultSectorStuff: Word;
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: Wort;
wMultiWordDMA: Wort;
bReserved: array[0..127] of BYTE;
Ende;
PIdSector = ^TIdSector;
TDriverStatus = gepackter Datensatz
bDriverError: Byte;
bIDEStatus: Byte;
bReserved: array[0..1] of Byte;
dwReserved: Array[0..1] von DWORD;
Ende;
TSendCmdOutParams = gepackter Datensatz
cBufferSize: DWORD;
DriverStatus: TDriverStatus;
bBuffer: array[0..0] of BYTE;
Ende;
var
hGerät: Thandle;
cbBytesReturned: DWORD;
SCIP:TSendCmdInParams;
aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder(var Data; Size: Integer);//Der Prozess in der Funktion
var
ptr: Pchar;
i: Ganzzahl;
c: Char;
beginnen
ptr := @Data;
für I := 0 bis (Size shr 1) - 1 beginnen
c := ptr^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := c;
Inc(ptr, 2);
Ende;
Ende;
begin //Funktionskörper
Ergebnis := '';
wenn SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT dann
begin // Windows NT, Windows 2000
hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ oder GENERIC_WRITE,
FILE_SHARE_READ oder FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
Ende
else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, Create_NEW, 0, 0);
wenn hDevice = INVALID_HANDLE_VALUE, dann Exit;
versuchen
FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
cbBytesReturned := 0;
mit SCIP tun
beginnen
cBufferSize := IDENTIFY_BUFFER_SIZE;
mit irDriveRegs tun
beginnen
bSectorCountReg := 1;
bSectorNumberReg := 1;
bDriveHeadReg := $A0;
bCommandReg := $EC;
Ende;
Ende;
wenn nicht DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;
Endlich
CloseHandle(hDevice);
Ende;
mit PIdSector(@IdOutCmd.bBuffer)^ tun
beginnen
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
Ergebnis := Pchar(@sSerialNumber);
Ende;
Ende;
//============================================= =================
//CPU-Seriennummer:
FUNCTION GetCPUID: TCPUID; Assembler;
asm
PUSH EBX {Betroffenes Register speichern}
PUSH-EDI
MOV EDI,EAX {@Resukt}
MOV EAX,1
DW $A20F {CPUID-Befehl}
STOSD {CPUID[1]}
MOV EAX,EBX
STOSD {CPUID[2]}
MOV EAX,ECX
STOSD {CPUID[3]}
MOV EAX,EDX
STOSD {CPUID[4]}
POP EDI {Register wiederherstellen}
POPEBX
ENDE;
Funktion GetCPUIDStr:String;
var
CPUID:TCPUID;
beginnen
CPUID:=GetCPUID;
Ergebnis:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
Ende;
///============================================= = ==================================
///MAC abrufen (nicht integrierte Netzwerkkarte):
function NBGetAdapterAddress(a: Integer): string;
var
NCB: TNCB; // Netbios-Steuerblock //NetBios-Steuerblock
ADAPTER: TADAPTERSTATUS; // NetBIOS-Adapterstatus//Netzwerkkartenstatus abrufen
LANAENUM: TLANAENUM; // Netbios lana
intIdx: Integer; // Temporärer Arbeitswert // Temporäre Variable
cRC: Char; // Netbios-Rückgabecode//NetBios-Rückgabewert
strTemp: string; // Temporäre Zeichenfolge // Temporäre Variable
beginnen
//Initialisieren
Ergebnis := '';
versuchen
// Nullkontrollblock
ZeroMemory(@NCB, SizeOf(NCB));
// Enum-Befehl ausgeben
NCB.ncb_command := Chr(NCBENUM);
cRC := NetBios(@NCB);
// Enum-Befehl erneut ausgeben
NCB.ncb_buffer := @LANAENUM;
NCB.ncb_length := SizeOf(LANAENUM);
cRC := NetBios(@NCB);
wenn ord(cRC) <> 0 dann
Ausfahrt;
//Adapter zurücksetzen
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana[a];
cRC := NetBios(@NCB);
wenn ord(cRC) <> 0 dann
Ausfahrt;
// Adapteradresse abrufen
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana[a];
StrPCopy(NCB.ncb_callname, '*');
NCB.ncb_buffer := @ADAPTER;
NCB.ncb_length := SizeOf(ADAPTER);
cRC := NetBios(@NCB);
// Konvertiere es in einen String
strTemp := '';
für intIdx := 0 bis 5 do
strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
Ergebnis := strTemp;
Endlich
Ende;
Ende;
//============================================= ==========================
// MAC-Adresse abrufen (integrierte Netzwerkkarte und nicht integrierte Netzwerkkarte):
Funktion Getmac:string;
var
NZB: TNCB;
s:string;
anpassen: TASTAT;
lanaEnum : TLanaEnum;
i, j, m: ganze Zahl;
strPart, strMac : string;
beginnen
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length := SizeOf(TLanaEnum);
s:=Netbios(@ncb);
for i := 0 to integer(lanaEnum.length)-1 do
beginnen
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana[i];
Netbios(@ncb);
Netbios(@ncb);
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Chr(NCBAstat);
ncb.ncb_lana_num := lanaEnum.lana[i];
ncb.ncb_callname := '* ';
ncb.ncb_buffer := PChar(@adapt);
ncb.ncb_length := SizeOf(TASTAT);
m:=0;
if (Win32Platform = VER_PLATFORM_WIN32_NT) dann
m:=1;
wenn m=1 dann
beginnen
wenn Netbios(@ncb) = Chr(0) dann
strMac := '';
für j := 0 bis 5 do
beginnen
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
Ende;
SetLength(strMac, Länge(strMac)-1);
Ende;
wenn m=0 dann
wenn Netbios(@ncb) <> Chr(0) dann
beginnen
strMac := '';
für j := 0 bis 5 do
beginnen
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
Ende;
SetLength(strMac, Länge(strMac)-1);
Ende;
Ende;
Ergebnis:=strmac;
Ende;
function PartitionString(StrV,PrtSymbol: string): TStringList;
var
iTemp: Ganzzahl;
beginnen
Ergebnis := TStringList.Create;
iTemp := pos(PrtSymbol,StrV);
während iTemp>0 beginnt
wenn iTemp>1 dann result.Append(copy(StrV,1,iTemp-1));
delete(StrV,1,iTemp+length(PrtSymbol)-1);
iTemp := pos(PrtSymbol,StrV);
Ende;
if Strv<>'' then result.Append(StrV);
Ende;
Funktion MacStr():String;
var
Str:TStrings;
i:Integer;
MacStr:String;
beginnen
MacStr:='';
Str:=TStringList.Create;
Str:=PartitionString(Getmac,'-');
for i:=0 to Str.Count-1 do
MacStr:=MacStr+Str[i];
Ergebnis:=MacStr;
Ende;
//===========================================
//Aufrufbeispiel
procedure TForm1.Button1Click(Sender: TObject);
beginnen
Edit3.Text:=strpas(GetIdeSerialNumber);//Festplattennummer abrufen
Edit2.text:=GetCPUIDStr;//CPU-Seriennummer
edit4.Text:=NBGetAdapterAddress(12);//Nicht integrierte Netzwerkkarte
Edit1.text:=MacStr;//Integrierte und nicht integrierte Netzwerkkarten
Ende;