Obtener Numero de serie de fabrica de pendrive

[[escafandra]]

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.

Código Delphi [-]
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.