(Resolvido) Serial Fisico HD

[Fabiomiojo]

Olá Amigos,

Desculpe voltar com esses post sobre pegar serial físico de hd mas estou precisando de ajuda e os últimos posts que pesquisei aqui são de 2009!

vamos lá.

Estou utilizando o seguinte código

unit Unit2;

interface

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

type
  TForm4 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

function GetWMIstring (wmiHost, wmiClass, wmiProperty : string):string;
var  // These are all needed for the WMI querying process
  Locator:  ISWbemLocator;
  Services: ISWbemServices;
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;
  SN: string;
begin
  try
  Locator := CoSWbemLocator.Create;  // Create the Location object
  // Connect to the WMI service, with the root\cimv2 namespace
   Services :=  Locator.ConnectServer(wmiHost, 'root\cimv2', '', '', '','', 0, nil);
  ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL',
    wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
  Enum :=  (ObjSet._NewEnum) as IEnumVariant;
  while (Enum.Next(1, TempObj, Value) = S_OK) do
  begin
    SObject := IUnknown(tempObj) as ISWBemObject;
    SProp := SObject.Properties_.Item(wmiProperty, 0);
    if VarIsNull(SProp.Get_Value) then
      result := ''
    else
    begin
      SN := SProp.Get_Value;
      result :=  SN;
    end;
  end;
  except // Trap any exceptions (Not having WMI installed will cause one!)
   on exception do
    result := '';
   end;
end;

procedure TForm4.Button1Click(Sender: TObject);
var
Y:string;

begin


    Y:=GetWMIstring('','Win32_DiskDrive','SerialNumber')     ;

    ShowMessage('Serial fisico hd: ' + y);
end;

end.

gostaria da ajuda de vocês pra identificar o porque que em determinado sistema operacional e hd não retorna serial.

testei em XP/7 - x32 com HDs IDE/SATA

alguém sabe me ajudar com esse problema??

não testei em versão x64, acredito que também funcione.

Gostaria também de identificar sobre qual ou quias dll esse código trabalha!

aguardo ajudas :blink:

Edited March 11, 2015 by Fabiomiojo

[Jhonas]

faça assim

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ procedure utilizada pela função que pega o serial do hd }

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;

{ função que pega o serial number FÍSICO do HD e retorna string }

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;
 
  begin
    Result := '';
    FillChar(Buffer,BufferSize,#0);
 
    if Win32Platform=VER_PLATFORM_WIN32_NT then
    // Windows NT, Windows 2000, Windows XP, Windows Vista, Win 7
    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;


procedure TForm1.Button1Click(Sender: TObject);
begin
   Label1.Caption := GetIdeDiskSerialNumber;
end;

end.

abraço

[Fabiomiojo]

Olá Jhonas,

Também Utilizo seu código pois como eu havia falado, em alguns momentos não é possível obter o Serial do HD. :ninja:

Acredito que exista uma relação ao Fabricante do HD, pois pelo que li, alguns não fornecem o numero de serie fisicamente, ou seja, não colocam dentro do HD tal numero.

Será que procede?? :unsure:

Testei com HDs Sata e IDE das marcas SEAGATE e SAMSUNG nas versões do windows XP, na Versão 7 foi necessário rodar o aplicativo com privilegio de adm.

quem testar mais posta aqui os teste pra gente poder definir melhor. :D

Abraços.

[Jhonas]

é possivel que alguns HDs não tenham numero fisico ( mas todas as BIOS tem )

mas no prompt do DOS .. iniciar > executar > cmd.exe > vol

esse comando exibe um rotulo e numero de serie do HD caso exista

ou pode tentar esse

http://www.devmedia.com.br/forum/numero-de-serie-fisico-do-hd-solucao/231252

abraço

[Fabiomiojo]

<script type='text/javascript'>window.mod_pagespeed_start = Number(new Date());</script>

é possivel que alguns HDs não tenham numero fisico ( mas todas as BIOS tem )

mas no prompt do DOS .. iniciar > executar > cmd.exe > vol

esse comando exibe um rotulo e numero de serie do HD caso exista

Olá Jhonas,

esse parâmetro do cmd.exe retorna o Serial do Volume do hd.

ou seja, é o serial atribuído no momento da formatação sendo este, vulnerável a copias e alterações por programas.

Nesse caso em que se basta utilizar do Serial do Volume, pode ser usado a função

GetVolumeInformation

O proposito em se colher o Serial Físico do HD é para que realmente não exista o uso indevido do sistema em autorização.

acredito que seria viável receber o serial de outro hardware ao invés do HD devido essa falha dos fabricantes.

Você conhece funções que pode fazer isso? como pegar serial da placa mãe por exemplo?ou da BIOS?

[Jhonas]

exemplo

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetBiosCheckSum: string;
var
  s: Int64;
  i: longword;
  p: PChar;
begin
  i := 0;
  s := 0;
  p := PChar($F0000);
  repeat
    inc(s,ord(^p)shl i);
    if i < 64 then inc(i) else i := 0;
    inc(p);
  until p > PChar($FFFFF);
  Result := IntToHex(s,16);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   a,b,c,d: LongWord; CPUID: string;
begin
   asm
      push EAX
      push EBX
      push ECX
      push EDX

      mov eax, 1
      db $0F, $A2
      mov a, EAX
      mov b, EBX
      mov c, ECX
      mov d, EDX

      pop EDX
      pop ECX
      pop EBX
      pop EAX
   end;

   CPUID:= inttohex(a,8) + '-' + inttohex(b,8) + '-' + inttohex(c,8) + '-' + inttohex(d,8);

   ShowMessage('SERIAL NUMBER PLACA MÃE :  ' +CPUID);

   SHOWMESSAGE('SERIAL NUMBER DA BIOS : ' + GetBiosCheckSum);
end;


end.

Nesse link tem uma Unit mais completa

http://read.pudn.com/downloads162/sourcecode/delphi_control/734363/VersionId.pas__.htm

ou

http://forum.imasters.com.br/topic/114605-info-de-hardware/

abraço