Buscar serial do HD

[robinhocne]

Pessoal, eu tenho essa função para pegar o serial do HD

procedure TFrmIzaLoja.BuscaSerialHd;
var nPro, nCPr, nHDS, nPa1, nPa2, nSer, pSHD : String;
    i : Integer;
    nRes : Extended;
    vReg : TRegistry;
begin
   vReg         := TRegistry.Create;
   vReg.RootKey := HKEY_LOCAL_MACHINE;
   // le a chave ProductID
   vReg.OpenKey( 'SOFTWARE\Microsoft\Windows\CurrentVersion', False );
   nPro  := vReg.ReadString( 'ProductID' );
   // remove todos os caracteres não numericos da chave do produto
   nCPr  := '';
   dskSer.ExamineDrive;
   pSHD  := dskSer.DiskSerial;
   for i := 1 to Length( nPro ) do
      begin   
         if ENumero( Copy( nPro, i, 1 ) ) then
            nCPr := nCPr + Copy( nPro, i, 1 );
      end;
   // remove todos os caracteres não numericos do serial do HD
   nHDS  := '';
   for i := 1 to Length( pSHD ) do
      begin
         if ENumero( Copy( pSHD, i, 1 ) ) then
            nHDS := nHDS + Copy( pSHD, i, 1 );
      end;
   // calcula o serial do programa
   nRes := ( StrToFloat( nCPr ) * StrToFloat( nCPr ) ) + StrToFloat( nHDS );
   nRes := nRes / ( StrToFloat( nHDS ) * 2 );
   i    := Pos( ',', FloatToStr( nRes ) );
   // verifica se foi encontrada alguma virgula no numero definido
   if ( i > 0 ) then
      begin
         nPa1 := Copy( FloatToStr( nRes ), 01, ( i - 1 ) );
         nPa2 := Copy( FloatToStr( nRes ), ( i + 1 ), ( Length( FloatToStr( nRes ) ) - i  ) );
      end;
   if Length( nPa1 ) > Length( nPa2 ) then
      nSer := nPa1
   else
      nSer := nPa2;

   SerialHd := nSer;

end;

porém quando chega nessa linha ele dá erro.

nRes := ( StrToFloat( nCPr ) * StrToFloat( nCPr ) ) + StrToFloat( nHDS );

'' is not a valid floating point value.

isso tambem no windows seven, pois no xp na dava esse erro !

alguém tem esse procedimento para o windows seven ?

[Jhonas]

alguém tem esse procedimento para o windows seven ?

Tente usando esse código

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function GetIdeDiskSerialNumber : 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; // especificar "comandos" SMART
     bSectorCountReg  : Byte; // registro de contador de setor 
     bSectorNumberReg : Byte; // registro de número de setores 
     bCylLowReg       : Byte; // valor de cilindro (byte mais baixo) 
     bCylHighReg      : Byte; // valor de cilindro (byte mais alto) 
     bDriveHeadReg    : Byte; // registro de drive/cabeça 
     bCommandReg      : Byte; // comando IDE 
     bReserved        : Byte; // reservado- tem que ser zero
   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; // PSendCmdOutParams
   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 do 
   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 
   // Windows NT, Windows 2000, Windows XP 
   begin
   // recuperar handle da porta SCSI 
     hDevice := CreateFile('\\.\Scsi0:', 
     // Nota: '\\.\C:' precisa de privilégios administrativos 
     GENERIC_READ or GENERIC_WRITE, 
     FILE_SHARE_READ or FILE_SHARE_WRITE, 
     nil, OPEN_EXISTING, 0, 0);

     if hDevice=INVALID_HANDLE_VALUE then Exit; 
     try 
       srbControl.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    := $A0; 
           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 
     // Windows 95 OSR2, Windows 98, Windows ME 
     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    := $A0; 
           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; 
end;

Function SerialNum(FDrive:String) :String;
Var
  Serial:DWord;
  DirLen,Flags: DWord;
  DLabel : Array[0..11] of Char;

begin
  Try
    GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
    Result := IntToHex(Serial,8); 
  Except
    Result :='';
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
var
  VolumeSerialNumber : DWORD;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
  TheSerialNumber : String;
begin
  if GetVolumeInformation('C:\',nil,0,@VolumeSerialNumber,
     MaximumComponentLength,FileSystemFlags,nil,0)
     then
     begin
     TheSerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) +
                        IntToHex(LoWord(VolumeSerialNumber), 4);
     end;
  ShowMessage('O Numero serial do drive é: '+TheSerialNumber);
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
   ShowMessage('O Numero serial do drive é: '+ SerialNum('C'));
end;

procedure TForm1.Button3Click(Sender: TObject);
var s : String; rc : DWORD;
begin
     s := GetIdeDiskSerialNumber;
     if s='' then
     begin
       rc := GetLastError;
       if rc=0 then
         showmessage('Drive IDE não suporta SMART')
       else
         showmessage(SysErrorMessage(rc));
     end
     else
       showmessage('O Nº Serial Físico do HD é: ' + s);

end;

abraço