PDA

Ver la Versión Completa : Obtener Numero de serie de fabrica de pendrive


buenarquero
21-10-2016, 18:42:52
Hola a todos, especialmente a ChackAll, al que dirijo esta consulta.
Quiero obtener el número de serie de fábrica de un pendrive desde mi aplicación con el fin de que no funcione si no está conectado el pendrive en que la entregaré.
Soy poco ducho en esto de la programación, pero conseguí con mucho esfuerzo y de forma autodidacta crear mi aplicación, a base de consultar libros de delphi y este foro.
Me he hartado de buscar lo que necesito en el foro y después de probar varias opciones que publican algunos foreros, no he conseguido lo que busco.
En este post del foro http://www.clubdelphi.com/foros/showthread.php?t=64022 el amigo ChackAll pone un enlace a un código que parece ser que funciona a juzgar por MAXIUM que es el forero que lo solicitó, pero ya no funciona ese enlace, de manera que no puedo acceder al citado código.
Por favor, amigo ChackAll o amigo MAXIUM o alguien que tenga éste código en concreto, ¿podría ponerlo en el post o mandarmelo?. Os lo agradeceré enormemente.
¡Gracias de antemano! hacéis una labor estupenda ayudando a otros en este campo tan complejo de la programación.

Casimiro Notevi
21-10-2016, 18:47:45
Hola a todos, especialmente a ChackAll, al que dirijo esta consulta.Pues hace más de 5 años que no pasa por aquí :rolleyes:

buenarquero
21-10-2016, 18:52:57
Pues hace más de 5 años que no pasa por aquí :rolleyes:

Vaya por Dios. Y ¿no sería posible que volviera a funcionar el enlace al que hago referencia? no se si depende de ChackAll o del foro.

Casimiro Notevi
21-10-2016, 18:56:33
¿Qué enlace es?

buenarquero
21-10-2016, 19:10:11
Es la carita que aparece en su primera respuesta del post del que he adjuntado el enlace

TOPX
21-10-2016, 19:16:58
... existe algo llamado Wayback Machine (https://es.wikipedia.org/wiki/Wayback_Machine), que es útil en esos casos ~
https://web.archive.org/web/20090409103547/http://chackall.clubdelphi.com/?id=2
-

buenarquero
21-10-2016, 19:26:26
Muchas gracias TOPX por contestar, pero el problema es que está en Visual Basic y el código lo necesito en Delphi. Desgraciadamente mis conocimientos no me permiten traspasarlo a Delphi.
Ahora me doy cuenta que el código de ChackAll tambiésn debía estar en Visual Basic.
Espero que MAXIUM, que lo iba a traducir, me conteste.

Casimiro Notevi
21-10-2016, 19:26:50
Es la carita que aparece en su primera respuesta del post del que he adjuntado el enlace
Ah, eso ya no existe.
Pero echa un vistazo a estos enlaces:
http://www.clubdelphi.com/foros/showthread.php?t=47683
http://www.clubdelphi.com/foros/showthread.php?t=53814
http://www.clubdelphi.com/foros/showthread.php?t=64774

buenarquero
21-10-2016, 19:39:09
Ah, eso ya no existe.
Pero echa un vistazo a estos enlaces:
http://www.clubdelphi.com/foros/showthread.php?t=47683
http://www.clubdelphi.com/foros/showthread.php?t=53814
http://www.clubdelphi.com/foros/showthread.php?t=64774

Bueno, Gracias Casimiro Notevi, pero ya he probado todo lo que me adjuntas. El componente de Neftalí no funciona en windows 7, el enlace de Seoane no funciona y el código de Mav solo da el número de serie del disco duro conectado al puerto IDE.

Casimiro Notevi
21-10-2016, 19:45:23
Bueno, Gracias Casimiro Notevi, pero ya he probado todo lo que me adjuntas. El componente de Neftalí no funciona en windows 7, el enlace de Seoane no funciona y el código de Mav solo da el número de serie del disco duro conectado al puerto IDE.
¿Qué cosa no funciona en w7?, pregunta a Neftali.
La web de seoane: https://delphi.jmrds.com/ puedes preguntarle también.

escafandra
21-10-2016, 19:50:46
function Search(hParent: HKEY; var SubKey: ShortString): LongBool;
var
hChild: HKEY;
Index: Cardinal;
Data: ShortString;
begin
Index := 0;
RegOpenKey(hParent, @SubKey[1], hChild);
RegQueryValue(hChild, 'ParentIdPrefix', Data, SizeOf(Data));
Result := not LongBool(lstrcmp(@Data, @Device));
while not Result and (RegEnumKey(hChild, Index, @SubKey[1], SizeOf(SubKey) - 1) = ERROR_SUCCESS) do
begin
Result := Search(hChild, SubKey);
Inc(Index);
end;
RegCloseKey(hChild);
end;

function usbGetSerial;
var
lpSerialNumber: PChar;
hKey: Windows.HKEY;
Index: Integer;
Value: Char;
begin
Result := False;
ValueName[12] := Drive;
RegOpenKey(HKEY_LOCAL_MACHINE, 'SYSTEM\MountedDevices', hKey);
RegQueryValue(hKey, @ValueName, Device, SizeOf(Device));
RegCloseKey(hKey);
Index := 0;
repeat if Device[(Index + 3) * 2 + 54] <> '#' then
Value := Device[Index * 2 + 54] else Value := #0;
Device[Index] := Value;
Inc(Index);
until Value = #0;
SerialNumber[0] := #0;
lstrcpy(@SerialNumber[1], 'SYSTEM\CurrentControlSet\Enum\USBSTOR');
if (Device[0] <> #0) and Search(HKEY_LOCAL_MACHINE, SerialNumber) then
begin
lpSerialNumber := @SerialNumber[1];
repeat Inc(SerialNumber[0]);
Inc(lpSerialNumber);
if lpSerialNumber[0] = '&' then
lpSerialNumber[0] := #0;
until lpSerialNumber[0] = #0;
Result := True;
end;
end;



Saludos

Casimiro Notevi
21-10-2016, 20:08:36
^\||/^\||/^\||/

buenarquero
21-10-2016, 20:43:11
Muchas gracias escafandra, voy a probarlo. Ya os digo como fue.

buenarquero
21-10-2016, 21:03:12
Bueno, pues parece que no hay suerte. El código que me has puesto, escafandra, no funciona. es posible que falte poner algo en el uses, pero desconozco el que. Me da todos estos errores:

[Error] Unit1.pas(34): Incompatible types: 'ShortString' and 'PAnsiChar'
[Error] Unit1.pas(34): Types of actual and formal var parameters must be identical
[Error] Unit1.pas(35): Undeclared identifier: 'Device'
[Error] Unit1.pas(44): Function needs result type
[Error] Unit1.pas(52): Undeclared identifier: 'ValueName'
[Error] Unit1.pas(52): Undeclared identifier: 'Drive'
[Error] Unit1.pas(54): Undeclared identifier: 'Device'
[Error] Unit1.pas(54): Types of actual and formal var parameters must be identical
[Error] Unit1.pas(62): Undeclared identifier: 'SerialNumber'
[Error] Unit1.pas(64): Operator not applicable to this operand type
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

buenarquero
21-10-2016, 21:16:05
Intento corregir los errores que da el código al compilarlo, pero con mis conocimientos no lo consigo.
También deduzco revisando el código que el número de serie pretende obtenerlo del registro de Windows, ¿me equivoco?. Si es así, no es esto lo que pretendo, sino leerlo directamente del pendrive.
De todas formas gracias por vuestra aportación. A ver si hay alguien que pueda desfacer el entuerto.

escafandra
23-10-2016, 03:24:25
Intento corregir los errores que da el código al compilarlo, pero con mis conocimientos no lo consigo.
También deduzco revisando el código que el número de serie pretende obtenerlo del registro de Windows, ¿me equivoco?. Si es así, no es esto lo que pretendo, sino leerlo directamente del pendrive.
De todas formas gracias por vuestra aportación. A ver si hay alguien que pueda desfacer el entuerto.

Windows cuando instala un nuevo dispositivo USB guarda su número de serie en el registro y es por eso que el código lo busca en el registro de Windows.


El código de cHackAll es un poco antiguo. Lo he reformado para un Win10 64 bits en una unit de un proyecto simple de ejemplo compilado en delphi 7:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;

function StrStrI(s1: PCHAR; s2: PCHAR): PCHAR; stdcall; external 'Shlwapi.dll' name 'StrStrIA';

var
Form1: TForm1;

implementation
{$R *.dfm}
var
Device: ShortString;
ValueName: array [0..15] of Char = '\DosDevices\\:';


function Search(hParent: HKEY; var SubKey: ShortString): LongBool;
var
hChild: HKEY;
Index: Cardinal;
Data: ShortString;
Size: integer;
ValueType: DWORD;
begin
Result:= false;
Index := 0;
Size:= sizeof(Data);
ValueType:=0;
RegOpenKey(hParent, @SubKey[1], hChild);
repeat
RegEnumKey(hChild, Index, @SubKey[1], SizeOf(SubKey) - 1);
Inc(Index);
until StrStrI(@SubKey[1], @Device) <> nil;
hParent:= hChild;
RegOpenKey(hParent, @SubKey[1], hChild);
Result:= (0 = RegEnumKey(hChild, 0, @SubKey[1], SizeOf(SubKey) - 1));
RegCloseKey(hChild);
RegCloseKey(hParent);
end;

function usbGetSerial(Drive: Char; var SerialNumber: ShortString): LongBool;
var
lpSerialNumber: PChar;
hKey: Windows.HKEY;
Index: Integer;
Value: Char;
Size: DWORD;
b: array[0..8024] of char;
i: integer;
ValueType: DWORD;
begin
ValueType:= 3;
Size:= SizeOf(Device);
Result := False;
ValueName[12] := Drive;
i:= RegOpenKey(HKEY_LOCAL_MACHINE, 'SYSTEM\MountedDevices', hKey);
RegQueryValueEx(hKey, @ValueName, nil, @ValueType{REG_BINARY}, @Device, @Size);
RegCloseKey(hKey);

Index := 0;
repeat if Device[(Index + 3) * 2 + 54] <> '#' then
Value := Device[Index * 2 + 54] else Value := #0;
Device[Index] := Value;
Inc(Index);
until Value = #0;
SerialNumber[0] := #0;
lstrcpy(@SerialNumber[1], 'SYSTEM\CurrentControlSet\Enum\USBSTOR');
if (Device[0] <> #0) and Search(HKEY_LOCAL_MACHINE, SerialNumber) then
begin
lpSerialNumber := @SerialNumber[1];
repeat Inc(SerialNumber[0]);
Inc(lpSerialNumber);
if lpSerialNumber[0] = '&' then
lpSerialNumber[0] := #0;
until lpSerialNumber[0] = #0;
Result := True;
end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
SerialNumber: ShortString;
begin
usbGetSerial(Key, SerialNumber);
Label1.Caption:= SerialNumber;
end;

end.




Saludos.

escafandra
23-10-2016, 04:50:00
Adjunto de nuevo el código por presentar un bug.
Aún así, en algunos pendrives antiguos no encuentra bien el número de serie.


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;

function StrStrI(s1: PCHAR; s2: PCHAR): PCHAR; stdcall; external 'Shlwapi.dll' name 'StrStrIA';

var
Form1: TForm1;

implementation
{$R *.dfm}
var
Device: ShortString;
ValueName: array [0..15] of Char = '\DosDevices\\:';


function Search(hParent: HKEY; var SubKey: ShortString): LongBool;
var
hChild: HKEY;
Index: Cardinal;
Data: ShortString;
Size: integer;
ValueType: DWORD;
Error: DWORD;
begin
Result:= false;
Index := 0;
Size:= sizeof(Data);
ValueType:=0;
RegOpenKey(hParent, @SubKey[1], hChild);
repeat
Error:= RegEnumKey(hChild, Index, @SubKey[1], SizeOf(SubKey) - 1);
Inc(Index);
until (StrStrI(@SubKey[1], @Device) <> nil) or (Error = ERROR_NO_MORE_ITEMS);
hParent:= hChild;
RegOpenKey(hParent, @SubKey[1], hChild);
Result:= (0 = RegEnumKey(hChild, 0, @SubKey[1], SizeOf(SubKey) - 1));
RegCloseKey(hChild);
RegCloseKey(hParent);
end;

function usbGetSerial(Drive: Char; var SerialNumber: ShortString): LongBool;
var
lpSerialNumber: PChar;
hKey: Windows.HKEY;
Index: Integer;
Value: Char;
Size: DWORD;
b: array[0..8024] of char;
i: integer;
ValueType: DWORD;
begin
ValueType:= 3;
Size:= SizeOf(Device);
Result := False;
ValueName[12] := Drive;
i:= RegOpenKey(HKEY_LOCAL_MACHINE, 'SYSTEM\MountedDevices', hKey);
RegQueryValueEx(hKey, @ValueName, nil, @ValueType{REG_BINARY}, @Device, @Size);
RegCloseKey(hKey);

Index := 0;
repeat if Device[(Index + 3) * 2 + 54] <> '#' then
Value := Device[Index * 2 + 54] else Value := #0;
Device[Index] := Value;
Inc(Index);
until Value = #0;
SerialNumber[0] := #0;
lstrcpy(@SerialNumber[1], 'SYSTEM\CurrentControlSet\Enum\USBSTOR');
if (Device[0] <> #0) and Search(HKEY_LOCAL_MACHINE, SerialNumber) then
begin
lpSerialNumber := @SerialNumber[1];
repeat Inc(SerialNumber[0]);
Inc(lpSerialNumber);
if lpSerialNumber[0] = '&' then
lpSerialNumber[0] := #0;
until lpSerialNumber[0] = #0;
Result := True;
end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
SerialNumber: ShortString;
begin
Edit1.Text:='';
Label1.Caption:= '';
usbGetSerial(Key, SerialNumber);
Label1.Caption:= SerialNumber;
end;

end.



Saludos.

buenarquero
23-10-2016, 12:25:52
Gracias escafandra. Aunque sigue pareciéndome que se obtiene el número de serie a partir del registro, como no encuentro nada que me sirva, lo voy a probar. Al menos, si funciona en windows XP y siguientes, será un buen complemento de protección para lo que ya tenia implementado en la aplicación.
Muchas gracias.

buenarquero
23-10-2016, 19:32:37
Bueno, pues, una vez probado el código en Windows XP y en Windows 7, resulta que en Windows XP siempre da el mismo número sea cual sea la letra de unidad que se introduzca en el edit y en Windows 7, da un número diferente dependiendo de la unidad que se introduzca, pero dicho número es igual siempre para esa unidad, aunque cambie el pendrive o incluso sin tener ningún pendrive conectado, lo cual no sirve para hacer que un programa no funcione si no tiene conectada el pendrive correspondiente.
Imagino que esto ocurre por que lee el número del registro y no del pendrive directamente.
Desgraciadamente no sirve, pero gracias.

escafandra
23-10-2016, 22:01:06
Bueno, pues, una vez probado el código en Windows XP y en Windows 7, resulta que en Windows XP siempre da el mismo número sea cual sea la letra de unidad que se introduzca en el edit y en Windows 7, da un número diferente dependiendo de la unidad que se introduzca, pero dicho número es igual siempre para esa unidad, aunque cambie el pendrive o incluso sin tener ningún pendrive conectado, lo cual no sirve para hacer que un programa no funcione si no tiene conectada el pendrive correspondiente.
Imagino que esto ocurre por que lee el número del registro y no del pendrive directamente.
Desgraciadamente no sirve, pero gracias.

Desafortunadamente WinXP es diferente y el código lo adapte lara Win10 y por lo que dices, veo que funciona en Win7.

Te coloco una mezcla del código de cHackAll adaptado para XP y una versión mejorada para los siguientes. También detecta una unidad no conecta.

Ten en cuenta que la versión del S.O. puede ser mal detectada si lo ejecutas sobre un IDE en compatibilidad con WinXP, así que no lo ejecutes así para probar.


var
Device: ShortString;
ValueName: array [0..15] of Char = '\DosDevices\\:';


const
IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = $00560000;

// Encuentra el número de disco físico que corresponde a una letra de unidad
function GetPhysicalNumOfDrive(Volume: Char): integer;
var
hFile: THandle;
Vde: array [0..56] of BYTE; // VOLUME_DISK_EXTENTS
BytesReturned: Cardinal;
begin
Result:= -1;
hFile:= CreateFile(PAnsiChar('\\.\' + Volume + ':'),0,0,nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then
begin
if DeviceIoControl(hFile, IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, nil, 0, @Vde, SizeOf(Vde), BytesReturned, nil) then
Result:= PBYTE(DWORD(@Vde)+8)^;
CloseHandle(hFile);
end;
end;

// Encuentra el número de serie de una letra de unidad para Win10
function GetUSBSerial10(Drive: Char; var SerialNumber: ShortString): LongBool;
var
hKey: Windows.HKEY;
Device: ShortString;
ValueName: array [0..15] of Char;
Index: Integer;
Value: Char;
Size: DWORD;
i: integer;
ValueType: DWORD;
begin
ValueType:= 3;
Size:= SizeOf(Device);
Result := False;
lstrcpy(ValueName, '\DosDevices\\:');
ValueName[12] := Drive;
RegOpenKey(HKEY_LOCAL_MACHINE, 'SYSTEM\MountedDevices', hKey);
i:= RegQueryValueEx(hKey, @ValueName, nil, @ValueType{REG_BINARY}, @Device, @Size);
RegCloseKey(hKey);
if i = 0 then
begin
i:= SizeOf(Device);
repeat dec(i); until Device[i] = '&'; Device[i]:= #0;
repeat dec(i); until Device[i] = '#';
Index := 1;
repeat
Value := Device[i + Index * 2];
SerialNumber[Index]:= Value;
inc(Index);
until Value = #0;
SerialNumber[0]:= CHAR(lstrlen(@SerialNumber[1]));
Result:= SerialNumber[1] <> #0;
end;
end;

// Modificado del código de cHackAll
function Search(hParent: HKEY; var SubKey: ShortString): LongBool;
var
hChild: HKEY;
Index: Cardinal;
Data: ShortString;
Size: DWORD;
ValueType: DWORD;
begin
ValueType:= 1; //REG_SZ
Size:= SizeOf(Device);
Index := 0;
RegOpenKey(hParent, @SubKey[1], hChild);
RegQueryValueEx(hChild, 'ParentIdPrefix', nil, @ValueType, @Data[0], @Size);
Result := not LongBool(lstrcmp(@Data, @Device));
while not Result and (RegEnumKey(hChild, Index, @SubKey[1], SizeOf(SubKey) - 1) = ERROR_SUCCESS) do
begin
Result := Search(hChild, SubKey);
Inc(Index);
end;
RegCloseKey(hChild);
end;

// Modificado del código de cHackAll
function usbGetSerial(Drive: Char; var SerialNumber: ShortString): LongBool;
var
lpSerialNumber: PChar;
hKey: Windows.HKEY;
Index: Integer;
Value: Char;
Size: DWORD;
i: integer;
ValueType: DWORD;
begin
ValueType:= 3;
Size:= SizeOf(Device);
Result := False;
ValueName[12] := Drive;
i:= RegOpenKey(HKEY_LOCAL_MACHINE, 'SYSTEM\MountedDevices', hKey);
RegQueryValueEx(hKey, @ValueName, nil, @ValueType{REG_BINARY}, @Device, @Size);
RegCloseKey(hKey);

Index := 0;
repeat if Device[(Index + 3) * 2 + 54] <> '#' then
Value := Device[Index * 2 + 54] else Value := #0;
Device[Index] := Value;
Inc(Index);
until Value = #0;
SerialNumber[0] := #0;
lstrcpy(@SerialNumber[1], 'SYSTEM\CurrentControlSet\Enum\USBSTOR');
if (Device[0] <> #0) and Search(HKEY_LOCAL_MACHINE, SerialNumber) then
begin
lpSerialNumber := @SerialNumber[1];
repeat Inc(SerialNumber[0]);
Inc(lpSerialNumber);
if lpSerialNumber[0] = '&' then
lpSerialNumber[0] := #0;
until lpSerialNumber[0] = #0;
Result := True;
end;
end;

function GetSOVersion: integer;
var
VerInfo: TOSVersioninfo;
begin
VerInfo.dwOSVersionInfoSize:= SizeOf(TOSVersionInfo);
GetVersionEx(VerInfo);
Result:= VerInfo.dwMajorVersion; // 5 es XP, mayor vista...
end;

function GetUSBSerial(Drive: Char; var SerialNumber: ShortString): LongBool;
begin
if(GetSOVersion > 5) then
Result:= GetUSBSerial10(Drive, SerialNumber)
else
Result:= usbGetSerial(Drive, SerialNumber);
end;



Ejemplo de uso:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
SerialNumber: ShortString;
begin
Edit1.Text:='';
Label1.Caption:= '';
if GetPhysicalNumOfDrive(Key) <> -1 then
begin
GetUSBSerial(Key, SerialNumber);
Label1.Caption:= SerialNumber;
end
else MessageBox(Handle, 'Unmounted drive', 'Error', MB_ICONEXCLAMATION);
end;


PD:
Para usar un Pendrive como mochila también puedes escribir datos en la unidad física fuera del espacio del directorio, con lo que serán invisibles al usuario al explorarlo.


Saludos.

escafandra
26-10-2016, 19:23:52
Por si fuera de interés, he estado experimentando otras vía más directa para obtener el número de serie que también trabaja con HD pero que no me convence porque no encuentra los números de serie USB en WinXP en las memorias que he probado y en Win10, al menos en una de ellas, cambia el último dígito del mismo al compararlo con el dato encontrado en el registro de Windows. Se basa en el uso de IOCTL (https://msdn.microsoft.com/es-es/library/windows/desktop/aa363219(v=vs.85).aspx). Otra posibilidad puede ser con WMI.


const
IOCTL_STORAGE_QUERY_PROPERTY = $2D1400;

type
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;

PSTORAGE_PROPERTY_QUERY = ^STORAGE_PROPERTY_QUERY;
STORAGE_PROPERTY_QUERY = record
PropertyId: DWORD; // StorageDeviceProperty = 0
QueryType: DWORD; // PropertyStandardQuery = 0
AdditionalParameters: array[0..0] of UCHAR;
end;

function GetSerialNumber(Volume: Char; var SerialNumber: string): BOOL;
var
hFile: THANDLE;
SPQ: STORAGE_PROPERTY_QUERY;
SDD: STORAGE_DEVICE_DESCRIPTOR;
PSDD: PSTORAGE_DEVICE_DESCRIPTOR;
Size: DWORD;
begin
Result:= FALSE;
SerialNumber:= '';
hFile:= CreateFile(PAnsiChar('\\.\' + Volume + ':'),0,0,nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then
begin
ZeroMemory(@SPQ, sizeof(SPQ));
if DeviceIoControl(hFile, IOCTL_STORAGE_QUERY_PROPERTY, @SPQ, sizeof(SPQ), @SDD, sizeof(SDD), Size, nil) then
begin
PSDD:= VirtualAlloc(nil, SDD.Size, MEM_COMMIT, PAGE_READWRITE);
ZeroMemory(PSDD, SDD.Size);
if DeviceIoControl(hFile, IOCTL_STORAGE_QUERY_PROPERTY, @SPQ, sizeof(SPQ), PSDD, SDD.Size, Size, nil) then
begin
if PSDD.SerialNumberOffset <> 0 then
SerialNumber:= String(PCHAR(PSDD) + PSDD.SerialNumberOffset);
end;
VirtualFree(PSDD, 0, MEM_RELEASE);
end;
CloseHandle(hFile);
end;
Result:= Length(SerialNumber) <> 0;
end;



Saludos.