Cita:
Empezado por buenarquero
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.
Código Delphi
[-]
var
Device: ShortString;
ValueName: array [0..15] of Char = '\DosDevices\\:';
const
IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = $00560000;
function GetPhysicalNumOfDrive(Volume: Char): integer;
var
hFile: THandle;
Vde: array [0..56] of BYTE; 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;
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, @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;
function Search(hParent: HKEY; var SubKey: ShortString): LongBool;
var
hChild: HKEY;
Index: Cardinal;
Data: ShortString;
Size: DWORD;
ValueType: DWORD;
begin
ValueType:= 1; 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;
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, @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; 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:
Código Delphi
[-]
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.