Obtener el número de serie de una unidad USB es un tema buscado en las redes y muy mal documentado. En principio podríamos suponer que la tarea puede hacerse fácilmente con DeviceIoControl IOCTL_STORAGE_GET_MEDIA_SERIAL_NUMBER, pero la realidad es que falla para las unidades de disco USB. cHackAll escribió hace unos años un código que se basaba el leer el registro para encontrar esa información, pero en los actuales S.O. no funciona correctamente. Con motivo de una pregunta en CD, me acordé del antiguo código de cHackAll y me propuse revisar el tema. El código que propongo se basa en la lectura del registro y en verificar si la unidad está "pinchada" en nuestro PC.
El código está probado en WinXP y Win10.
En realidad es una información muy poco útil salvo para aquellos que quieran proteger sus creaciones con una mochila basada en un pendrive.
Este es el código:
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;
Y un 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;
Subo un proyecto completo con el ejemplo.
Saludos.