Delphi Get HDD serial number function getidenum:string; Type Tsrbiocontrol = packed record headerlength:ulong; SIGNATURE:ARRAY[0..7] of Char; Timeout:ulong; Controlcode:ulong; Returncode:ulong; Length:ulong; End Srb_io_control = Tsrbiocontrol; Psrbiocontrol = ^tsrbiocontrol; Tideregs = packed record bfeaturesreg:byte; Bsectorcountreg:byte; Bsectornumberreg:byte; Bcyllowreg:byte; Bcylhighreg:byte; Bdriveheadreg:byte; Bcommandreg:byte; Breserved:byte; End Ideregs = Tideregs; Pideregs = ^tideregs; Tsendcmdinparams = packed record cbuffersize:dword; Irdriveregs:tideregs; Bdrivenumber:byte; BRESERVED:ARRAY[0..2] of Byte; DWRESERVED:ARRAY[0..3] of DWORD; bbuffer:array[0..0] of Byte; End Sendcmdinparams = Tsendcmdinparams; Psendcmdinparams = ^tsendcmdinparams; Tidsector = packed record wgenconfig:word; Wnumcyls:word; WReserved:word; Wnumheads:word; Wbytespertrack:word; Wbytespersector:word; Wsectorspertrack:word; WVENDORUNIQUE:ARRAY[0..2] of 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:word; Wcapabilities:word; Wreserved1:word; Wpiotiming:word; Wdmatiming:word; Wbs:word; Wnumcurrentcyls:word; Wnumcurrentheads:word; Wnumcurrentsectorspertrack:word; Ulcurrentsectorcapacity:ulong; Wmultsectorstuff:word; Ultotaladdressablesectors:ulong; Wsingleworddma:word; Wmultiworddma:word; BRESERVED:ARRAY[0..127] of Byte; End Pidsector = ^tidsector; Const Ide_id_function = $EC; Identify_buffer_size = 512; Dfp_receive_drive_data = $0007c088; Ioctl_scsi_minipoRT = $0004d008; Ioctl_scsi_miniport_identify = $001b0501; datasize = sizeof (tsendcmdinparams) -1+identify_buffer_size; buffersize = SizeOf (Srb_io_control) +datasize; W9xbuffersize = identify_buffer_size+16; var Hdevice:thandle; Cbbytesreturned:dword; Pindata:psendcmdinparams; Poutdata:pointer; Buffer:array[0..buffersize-1] of Byte; Srbcontrol:tsrbiocontrol Absolute Buffer; Procedure Changebyteorder (Var Data; Size:integer); var Ptr:pchar; I:integer; C:char; Begin PTR: = @Data; For I: = 0 to (Size shr 1)-1 does begin c: = ptr^; ptr^: = (ptr+1) ^; (ptr+1) ^: = C; INC (ptr,2); End End Begin Result: = '; Fillchar (Buffer,buffersize, #0); If Win32platform=ver_platform_win32_nt then begin hdevice: = CreateFile ('//./scsi0: ', generic_read or Generic_write, File_share_read or File_share_write,nil, open_existing, 0, 0); If Hdevice=invalid_handle_value then Exit; TrySrbcontrol.headerlength: = SizeOf (Srb_io_control); System.move (' Scsidisk ', srbcontrol.signature,8); Srbcontrol.timeout: = 2; Srbcontrol.length: = DataSize; Srbcontrol.controlcode: = ioctl_scsi_miniport_identify; Pindata: = Psendcmdinparams (PChar (@Buffer) +sizeof (Srb_io_control)); Poutdata: = Pindata; With pindata^ do begin cbuffersize: = Identify_buffer_size; Bdrivenumber: = 0; With Irdriveregs do begin bfeaturesreg: = 0; Bsectorcountreg: = 1; Bsectornumberreg: = 1; Bcyllowreg: = 0; Bcylhighreg: = 0; Bdriveheadreg: = $A 0; Bcommandreg: = ide_id_function; End End If not DeviceIoControl (Hdevice, Ioctl_scsi_miniport, @Buffer, buffersize, @Buffer, buffersize,cbbytesreturned, nil) Then Exit; Finally CloseHandle (hdevice); End End ELSE begin Hdevice: = CreateFile ('//./smArtvsd ', 0, 0, nil,create_new, 0, 0); If Hdevice=invalid_handle_value then Exit; Try Pindata: = Psendcmdinparams (@Buffer); Poutdata: = @pInData ^.bbuffer; With pindata^ do begin cbuffersize: = Identify_buffer_size; Bdrivenumber: = 0; With Irdriveregs do begin bfeaturesreg: = 0; Bsectorcountreg: = 1; Bsectornumberreg: = 1; Bcyllowreg: = 0; Bcylhighreg: = 0; Bdriveheadreg: = $A 0; Bcommandreg: = ide_id_function; End End If not DeviceIoControl (Hdevice, Dfp_receive_drive_data,pindata, SizeOf (tsendcmdinparams)-1, Poutdata,w9xbuffersize, cbbytesreturned, nil) then Exit; Finally CloseHandle (hdevice); End End With Pidsector (PChar (poutdata) +16) ^ do begin Changebyteorder (sserialnumber,sizeof (Sserialnumber)); SetString (result,sserialnumber,sizeof (Sserialnumber)); End ResulT:=trim (Result); End The following three functions are implemented together to obtain the CPU ID function getcpuid:tcpuid; Assembler; Register ASM Push EBX push EDI mov edi,eax mov eax,1 DW $A 20F stosd mov eax,ebx STOSD mov eax,e CX stosd MOV eax,edx stosd pop EDI pop EBX end; function Iscpuid_available:boolean; Register ASM pushfd Pop EAX MOV edx,eax xor eax,$200000 PUSH EAX popfd pushfd POP EAX xor Eax,edx JZ @exit MOV al,true @exit: End; function cpu_getcpunum:string; var Cpuid:tcpuid; I:integer; Begin result:= ' 0 '; Try for I: = Low (CPUID) to High (CPUID) do cpuid[i]: =-1; If Iscpuid_available then begin cpuid:= Getcpuid; Result:=inttostr (cpuid[1]) + '-' +inttostr (cpuid[2]) + '-' +inttostr (cpuid[3]) + '-' +inttostr (cpuid[4]); End; Except result:= ' 0 '; End; End The following function gets the BIOS number {*************************************** author/date:description: Gets the BIOS number ********} function getbiosnum:string; Var biosdate,biosname,biosversion,biosnum,bioscopyright:string; Begin Try Biosdate:=string (Pchar (PTR ($ffff 5)); Biosname:=string (Pchar (PTR ($ffa 68))); Biosversion:=string (Pchar (PTR ($fe 061))); Biosnum:=string (Pchar (PTR ($FEC 71))); Bioscopyright:=string (Pchar (PTR ($fe 091))); Result:=biosnum; Except result:= '; End; End
Delphi gets the hard drive serial number, CPU number, BIOS number, network card number