en win7 no funciona esta funcion pa sacar ID unico del disco duro
 

un saludo al Club
tengo eta dificulta
esta es una de las mejores funciones que encontre para sacar el ID unico del disco duro y funciona perfectamente en winXP pero cuando lo ejecuto en win7 no me sale nada.. no probe en win vista

les facilito el codigo por ahi a que hacer una modificacion para que funcione en todos los windows

o si tiene alguna otra funcion mucho mas completo y que funcione en todos los win les agradesco.

Código Delphi [-]
/////////////////////////////////////////////////
// Get first IDE harddisk serial number 
function GetIdeSerialNumber : SerialNumber; 
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;

aqui llamo de cualquier edit o label

Código Delphi [-]
///////////////////
llamar a 
label1.Caption := GetIdeSerialNumber;

Estimado tu problema es sencillo

Código Delphi [-]
function GetIdeSerialNumber : SerialNumber; 

//cambia por 
function GetIdeSerialNumber : String;

realice ese cambio
con disco Segate de 500G + Win7 no me da el ID unico :(

¿Lo ejecutas como administrador?...:rolleyes:

Saludos.

Con WMI sería más fácil no...

Igual suelto una tontería pero....¿GetVolumeInformation no da ese dato?

Estoy de acuerdo con Maxium. Ya lo he comentado otras veces en el Blog y creo que alguna por aquí en los foros. A partir de sistemas "modernos" (a partir de XP y para server a partir del 2003) creo que la mejor forma es utilizar WMI. Es más sencillo y asegura mejor la compatibilidad de futuro.

La clase Win32_DiskDrive debería devolver sin problemas el SerialNumber. En la misma documentación se lee lo siguiente:
"Windows Server 2003, Windows XP, Windows 2000, and Windows NT 4.0: This property is not available."

He subido un ejemplillo con WMI al FTP, con la demo incluída. Probadlo (o compiladlo de nuevo) a ver si os da respuesta. En W7 y un Server2005 funciona sin problemas.

Neftali es interesante la aplicacion
una consulta en el ejemplo del ejemplillo con WMI me voy al "DiskDriveInfo1" y cual es el ID unico del disco duro en la "function GetIdeSerialNumber : String;" que postee me da un valor del disco duro. que no encuentro en tu aplicacion.

encontre "ProcessorInfo1" <TProcessorProperties.Processorldes> me da un valor mi consulta es esto es ID unico del procesador que no se puede cambiar ?

estoy buscando datos unicos que no sean modificables del hardware para crear licencias
encotre info que la mac de red es facil de cambiar por favor con tu experiencia confirmame el dato.

saludos

¿En qué versión de sistema lo estás ejecutando?

Por ejemplo en mi XP, no aparece la propiedad SerialNumber (porque no lo soporta), pero si ese mismo programa lo ejecuta en Windows 7 sí me aparece la propiedad y el valor.

Como ya he dicho antes, no todos los sistemas soportan esa propiedad.

Mira ésta si te funciona

Código Delphi [-]
function GetVolumeSeriealNumber(const Drive: TFileName): LongWord;
var
  VolumeName, FilesystemName: Array[0..MAX_PATH -1] of char;
  VolumeSerialNumber, MaxFilenameLength, FileSystemFlags: LongWord;
begin
  GetVolumeInformation(PChar(IncludeTrailingBackslash(Drive)),
    VolumeName, MAX_PATH, @VolumeSerialNumber, MaxFilenameLength,
    FileSystemFlags, FilesystemName, MAX_PATH);

  Result := VolumeSerialNumber;
end;

Un saludo

olbeup la funcion si llega a funcionar me da el Id de la Unidad c:\ o la unidad que elija
lo que busco es que me de el ID unico del disco duro para win xp and win 7

gracias de todas formas.

mira este a ver si te funciona nunca lo probe en win7 puede ser q te funcione

Código Delphi [-]
const
  METHOD_BUFFERED = 0;
  FILE_ANY_ACCESS = 0;
  FILE_DEVICE_MASS_STORAGE = $2D;
  IOCTL_STORAGE_BASE = FILE_DEVICE_MASS_STORAGE;

  IOCTL_STORAGE_QUERY_PROPERTY =
    (IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or
    ($500 shl 2) or  METHOD_BUFFERED;

type
  PSTORAGE_DESCRIPTOR_HEADER = ^TSTORAGE_DESCRIPTOR_HEADER;
  TSTORAGE_DESCRIPTOR_HEADER = packed record
    Version: ULONG;
    Size: ULONG;
  end;

  PSTORAGE_DEVICE_DESCRIPTOR = ^STORAGE_DEVICE_DESCRIPTOR;
  STORAGE_DEVICE_DESCRIPTOR = packed record
    Version: ULONG;
    Size: ULONG;
    DeviceType: UCHAR;
    DeviceTypeModifier: UCHAR;
    RemovableMedia: Boolean;
    CommandQueueing: Boolean;
    VendorIdOffset: ULONG;
    ProductIdOffset: ULONG;
    ProductRevisionOffset: ULONG;
    SerialNumberOffset: ULONG;
    BusType: ULONG;
    RawPropertiesLength: ULONG;
    RawDeviceProperties: array[0..0] of UCHAR;
  end;

// Descodifica el numero de serie
function DecodeSerialNumber(SerialNumber: string): string;
var
  i: Integer;
begin
  Result:= EmptyStr;
  while Length(SerialNumber) > 0 do
  begin
    if TryStrToInt('$'+Copy(SerialNumber,1,4),i) then
    begin
      Result:= Result + Char(Lo(i)) + Char(Hi(i));
      Delete(SerialNumber,1,4);
    end else
    begin
      Result:= EmptyStr;
      Exit;
    end;
  end;
  Result:= Trim(Result);
end;

// Obtiene la informacion sobre el dispositivo
// Parametros:
//   Letra: Letra de la unidad (A,B,C,D...)
//   VendorId: Identificacion del vendedor
//   ProductId: Identificacion del producto
//   SerialNumber: Numero de serie
//   Extraible: Indica si el dispositivo es extraible (disquete, memoria usb)
//
function GetSerialNumber(Letra: Char; var VendorId: string; var ProductId: string;
  var SerialNumber: string; var Extraible: Boolean): string;
var
  Disk: THandle;
  Size: Cardinal;
  Buffer: Pointer;
  DeviceDescriptor: PSTORAGE_DEVICE_DESCRIPTOR;
begin
  Result:= EmptyStr;
  Disk:= CreateFile(PChar('\\.\' + Letra + ':'),GENERIC_READ,FILE_SHARE_READ
    or FILE_SHARE_WRITE,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if Disk <> INVALID_HANDLE_VALUE then
  begin
    GetMem(Buffer,12);
    try
      FillChar(Buffer^,12,0);
      if DeviceIOControl(Disk, IOCTL_STORAGE_QUERY_PROPERTY,
        Buffer,12,Buffer,12,Size, nil) then
      begin
        FreeMem(Buffer);
        Size:= PSTORAGE_DESCRIPTOR_HEADER(Buffer).Size;
        GetMem(Buffer, Size);
        FillChar(Buffer^,Size,0);
        if DeviceIOControl(Disk, IOCTL_STORAGE_QUERY_PROPERTY,
          Buffer,12,Buffer,Size,Size, nil) then
          begin
            DeviceDescriptor:= Buffer;
            Extraible:= DeviceDescriptor.RemovableMedia;
            if DeviceDescriptor.VendorIdOffset > 0 then
              VendorId:= String(PChar(Buffer) + DeviceDescriptor.VendorIdOffset)
            else
              VendorId:= EmptyStr;
            if DeviceDescriptor.ProductIdOffset > 0 then
              ProductId:= String(PChar(Buffer) + DeviceDescriptor.ProductIdOffset)
            else
              ProductId:= EmptyStr;
            if (DeviceDescriptor.SerialNumberOffset > 0) and
               (DeviceDescriptor.SerialNumberOffset < Size) then
              SerialNumber:= String(PChar(Buffer) + DeviceDescriptor.SerialNumberOffset)
            else
              SerialNumber:= EmptyStr;
          end else Result:= SysErrormessage(GetLastError);
      end else Result:= SysErrormessage(GetLastError);
    finally
      FreeMem(Buffer);
    end;
    CloseHandle(Disk);
  end else Result:= SysErrormessage(GetLastError);
end;

EJEMPLO de uso

var
  VendorId: string;
  ProductId: string;
  SerialNumber: string;
  Extraible: Boolean;
  Mensaje: string;
begin
  Mensaje:= GetSerialNumber('C', VendorId, ProductId, SerialNumber, Extraible);
  if Mensaje = EmptyStr then
  begin
    ShowMessage
    (
      'VendorId: '     + VendorID     + #13 +
      'ProductId: '    + ProductId    + #13 +
      'SerialNumber: ' + DecodeSerialNumber(SerialNumber) + #13 +
      'Extraible: '    + BoolToStr(Extraible,TRUE)
     );
  end else
    ShowMessage(Mensaje);
end;
end.

Hola como estan! en el ejemplo de Neftali subido al ftp, ¿SerialNumber funciona bajo XP? Lo probe en WIN7 y va muy bien.
Saludos!

Según se lee más arriba:

Mil disculpas se me paso por alto. Entonces se podria obtener la version de win instalada y combinar el codigo de neftali con el de darkbits, entonces dependiendo de la version, que use uno u otro codigo para obtener el numero de serie fisico del disco

Esa creo que es una muy buena idea, y es la que he propuesto alguna vez en el blog. Para anteriores a W7 usar un sistema alternativo, para W7 y posteriores, WMI es una buena opción.