Valeu cara, Obrigado pela ajuda acho que vou usar essa da CPU mesmo.
Obrigado. De: delphi-br@yahoogrupos.com.br [mailto:delphi...@yahoogrupos.com.br] Em nome de Willian Jhonnes L. dos Santos Enviada em: quarta-feira, 27 de janeiro de 2010 20:30 Para: delphi-br@yahoogrupos.com.br Assunto: Re: [delphi-br] Pegar Serial Fisico de HD no Delphi 2010 Em 27/1/2010 18:29, Iran Lima escreveu: > Se alguém tiver uma função que retorne o serial físico do HD ou da > BIOS , que funcione no D2010 e puder me passar ficarei grato.[ > > Iran Essa [1] eu testei até o Delphi 2007 e funciona apenas com HDs IDE. Mas abandonei esta idéia a partir do momento em q a maioria dos clientes começou a usar HDs SATA. Passei a usar a CPUID, que não varia, mesmo que o cliente troque o HD. Pra isso uso essa função [2]. [1]---------------------------------------------------------- Function GetIdeSerialNumber:String; const IDENTIFY_BUFFER_SIZE = 512; type TIDERegs = packed record bFeaturesReg : BYTE; // Used for specifying SMART "commands". bSectorCountReg : BYTE; // IDE sector count register bSectorNumberReg : BYTE; // IDE sector number register bCylLowReg : BYTE; // IDE low order cylinder value bCylHighReg : BYTE; // IDE high order cylinder value bDriveHeadReg : BYTE; // IDE drive/head register bCommandReg : BYTE; // Actual IDE command. bReserved : BYTE; // reserved for future use. Must be zero. end; TSendCmdInParams = packed record // Buffer size in bytes cBufferSize : DWORD; // Structure with drive register values. irDriveRegs : TIDERegs; // Physical drive number to send command to (0,1,2,3). bDriveNumber : BYTE; bReserved : Array[0..2] of Byte; dwReserved : Array[0..3] of DWORD; bBuffer : Array[0..0] of Byte; // Input buffer. end; 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 : DWORD; wMultSectorStuff : Word; ulTotalAddressableSectors : DWORD; wSingleWordDMA : Word; wMultiWordDMA : Word; bReserved : Array[0..127] of BYTE; end; PIdSector = ^TIdSector; TDriverStatus = packed record // Error code from driver, or 0 if no error. bDriverError : Byte; // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR. bIDEStatus : Byte; bReserved : Array[0..1] of Byte; dwReserved : Array[0..1] of DWORD; end; TSendCmdOutParams = packed record // Size of bBuffer in bytes cBufferSize : DWORD; // Driver status structure. DriverStatus : TDriverStatus; // Buffer of arbitrary length in which to store the data read from the drive. bBuffer : Array[0..0] of BYTE; end; var hDevice : THandle; cbBytesReturned : DWORD; ptr : PChar; SCIP : TSendCmdInParams; aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte; IdOutCmd : TSendCmdOutParams absolute aIdOutCmd; procedure ChangeByteOrder( var Data; Size : Integer ); var Ptr: PChar; I: Integer; C: Char; Begin Ptr := @Data; For I := 0 to (Size shr 1) - 1 Do Begin C := Ptr^; Ptr^ := (Ptr + 1)^; (Ptr + 1)^ := C; Inc(Ptr, 2); end; end; Begin Result := ''; // return empty String on error If SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000 begin // warning! change name for other drives: ex.: second drive '\\.\PhysicalDrive1\' hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 ); end Else // Version Windows 95 OSR2, Windows 98 hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 ); If hDevice=INVALID_HANDLE_VALUE Then Exit; Try FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0); FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0); cbBytesReturned := 0; // Set up data structures for IDENTIFY command. With SCIP Do Begin cBufferSize := IDENTIFY_BUFFER_SIZE; // bDriveNumber := 0; With irDriveRegs Do Begin bSectorCountReg := 1; bSectorNumberReg := 1; // if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0 // else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4); bDriveHeadReg := $A0; bCommandReg := $EC; end; end; If not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams) - 1, @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) Then Exit; Finally CloseHandle(hDevice); end; With PIdSector(@IdOutCmd.bBuffer)^ Do Begin ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) ); (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0; Result := PChar(@sSerialNumber); end; end; [/1]---------------------------------------------------------- [2]---------------------------------------------------------- function GetCPUID: String; var A, B, C, D: LongWord; begin try asm mov eax,1 // eax registeri cpuid komutunun parametresidir db $0F, $A2 // cpuid komutu mov a,EAX mov b,EBX mov c,ECX mov d,EDX end; Result := IntToHex(A, 8) + '-' + IntToHex(B, 8) + '-' + IntToHex(C, 8) + '-' + IntToHex(D, 8); Except Result := 'ERRO!'; //'0000-D342-F921-M068'; end; end; [/2]---------------------------------------------------------- []'s ------------ --------------------------------------- Att.: Willian Jhonnes L. dos Santos Analista/Desenvolvedor Object/Free Pascal willianjhon...@yahoo.com.br <mailto:willianjhonnes%40yahoo.com.br> <mailto:willianjhonnes%40yahoo.com.br> --------------------------------------------------- Seja livre. Use Linux. Grupo de Usuários GNU/Linux de São José dos Pinhais Linux user number 449753 --------------------------------------------------- Powered by Slackware Linux 12.2 Kernel 2.6.27.8-i686-core2 --------------------------------------------------- [As partes desta mensagem que não continham texto foram removidas] [As partes desta mensagem que não continham texto foram removidas]
