uses
JwaWinBase, JwaWinType, Cfg, CfgMgr32, SetupApi, mySysUtils;
{$R *.dfm}
// encapsulate GetVolumeNameForVolumeMountPoint in a Delphi-style function
function GetVolumeNameForVolumeMountPointString(
Name:
string):
string;
var
Volume:
array [0..MAX_PATH]
of Char;
begin
FillChar(Volume[0], SizeOf(Volume), 0);
GetVolumeNameForVolumeMountPoint(PChar(
Name), @Volume[0], SizeOf(Volume));
Result := Volume;
end;
// fills the TStringList with the mount points of all removable drives
procedure FillInRemovableDriveMountPoints(MountPoints: TStrings);
const
MAX_DRIVES = 26;
var
I: Integer;
dwDriveMask: DWORD;
DriveName:
string;
begin
MountPoints.Clear;
// get all mounted drive letters as bitmask
dwDriveMask := GetLogicalDrives;
DriveName := '
A:\';
// check all drive letters
for I := 0
to MAX_DRIVES - 1
do
// if drive letter exists
if (dwDriveMask
and (1
shl I)) <> 0
then
begin
DriveName[1] := '
A';
Inc(DriveName[1], I);
// see if it is a removable drive
if GetDriveType(PChar(DriveName)) = DRIVE_REMOVABLE
then
// store mount point string and corresponding drive letter in list
MountPoints.AddObject(GetVolumeNameForVolumeMountPointString(DriveName), TObject(DriveName[1]));
end;
end;
// Delphi style encapsulation for CM_Get_Device_ID
function GetDeviceID(Inst: DEVINST):
string;
var
Buffer: PTSTR;
Size: ULONG;
begin
CM_Get_Device_ID_Size(Size, Inst, 0);
// Required! See DDK help for CM_Get_Device_ID
Inc(Size);
Buffer := AllocMem(Size * SizeOf(TCHAR));
CM_Get_Device_ID(Inst, Buffer, Size, 0);
Result := Buffer;
FreeMem(Buffer);
end;
// simple extraction of the bus name from DeviceID string
function ExtractBus(DeviceID:
string):
string;
begin
Result := Copy(DeviceID, 1, Pos('
\', DeviceID) - 1);
end;
// get the "SymbolicName" registry entry of a device
// for an USB device this string contains VID, PID and SerialNumber string
function GetSymbolicName(Inst: DEVINST):
string;
var
Len: DWORD;
Key: HKEY;
// a hopefully sufficiently large buffer
Buffer:
array [0..4095]
of Char;
begin
CM_Open_DevNode_Key(Inst, KEY_READ, 0,
REGDISPOSITION(RegDisposition_OpenExisting), Key, 0);
Buffer[0] := #0;
if Key <> INVALID_HANDLE_VALUE
then
begin
Len := SizeOf(Buffer);
RegQueryValueEx(Key, '
SymbolicName',
nil,
nil, @Buffer[0], @Len);
RegCloseKey(Key);
end;
Result := Buffer;
end;
// extract a 4 digit hex number from SymbolicName
// example "\??\USB#Vid_08ec&Pid_0010#0918121014000B59#{a5dcbf10-6530-11d2-901f-00c04fb951ed}"
function ExtractNum(
const SymbolicName, Prefix:
string): Integer;
var
S:
string;
N: Integer;
begin
S := LowerCase(SymbolicName);
N := Pos(Prefix, S);
if N > 0
then
begin
S := '
$' + Copy(SymbolicName, N + Length(Prefix), 4);
Result := StrToInt(S);
end
else
Result := 0;
end;
function ExtractVID(
const SymbolicName:
string): Integer;
begin
Result := ExtractNum(SymbolicName, '
vid_');
end;
function ExtractPID(
const SymbolicName:
string): Integer;
begin
Result := ExtractNum(SymbolicName, '
pid_');
end;
function ExtractSerialNumber(SymbolicName:
string):
string;
var
N: Integer;
begin
N := Pos('
#', SymbolicName);
if N >= 0
then
begin
SymbolicName := Copy(SymbolicName, N + 1, Length(SymbolicName));
N := Pos('
#', SymbolicName);
if N >= 0
then
begin
SymbolicName := Copy(SymbolicName, N + 1, Length(SymbolicName));
N := Pos('
#', SymbolicName);
if N >= 0
then
Result := Copy(SymbolicName, 1, N - 1)
else
Result := '
';
end;
end
else
Result := '
';
end;
// find the "bus" DeviceID for a given mount point
function GetDriveInstanceID(MountPointName:
string;
var DeviceInst: DEVINST): Boolean;
const
GUID_DEVINTERFACE_VOLUME: TGUID = '
{53f5630d-b6bf-11d0-94f2-00a0c91efb8b}';
var
StorageGUID: TGUID;
PnPHandle: HDEVINFO;
DevData: TSPDevInfoData;
DeviceInterfaceData: TSPDeviceInterfaceData;
FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
Success: LongBool;
Devn: Integer;
BytesReturned: DWORD;
Inst: DEVINST;
S, FileName, MountName, DevID:
string;
begin
Result := False;
DeviceInst := 0;
// enumerate all volumes
StorageGUID := GUID_DEVINTERFACE_VOLUME;
PnPHandle := SetupDiGetClassDevs(@StorageGUID,
nil, 0, DIGCF_PRESENT
or DIGCF_DEVICEINTERFACE);
if PnPHandle = Pointer(INVALID_HANDLE_VALUE)
then
Exit;
Devn := 0;
repeat
DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
Success := SetupDiEnumDeviceInterfaces(PnPHandle,
nil, StorageGUID, Devn, DeviceInterfaceData);
if Success
then
begin
DevData.cbSize := SizeOf(DevData);
BytesReturned := 0;
SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
nil, 0, BytesReturned, @DevData);
if (BytesReturned <> 0)
and (GetLastError = ERROR_INSUFFICIENT_BUFFER)
then
begin
FunctionClassDeviceData := AllocMem(BytesReturned);
try
FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
if SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData)
then
begin
FileName := PTSTR(@FunctionClassDeviceData.DevicePath[0]);
// get the grandparent DevNode which is the "bus" device
// like "USB". This is the DevNode for CM_Request_Device_Eject and
// several other useful operations
Inst := DevData.DevInst;
CM_Get_Parent(Inst, Inst, 0);
CM_Get_Parent(Inst, Inst, 0);
DevID := GetDeviceID(Inst);
// no need in this example to check for USB only
// if ExtractBus(DevID) = 'USB' then
begin
S := '
\';
S := PTSTR(@FunctionClassDeviceData.DevicePath) + S;
MountName := GetVolumeNameForVolumeMountPointString(S);
if MountName = MountPointName
then
begin
DeviceInst := Inst;
Result := True;
Exit;
end;
end;
end;
finally
FreeMem(FunctionClassDeviceData);
end;
end;
end;
Inc(Devn);
until not Success;
SetupDiDestroyDeviceInfoList(PnPHandle);
end;
//============================================================================
procedure TaForm.FormCreate(Sender: TObject);
var i : Integer;
begin
// never forget to load the dynamically linked APIs
LoadSetupApi;
LoadConfigManagerApi;
DriveMountPoints := TStringList.Create;
DriveMountPoints.Sorted := True;
// initialize drive list
if ParamCount > 0
then begin
for i := 1
to ParamCount
do begin
if (Pos('
DRIVEREMOVE:', UpperCase(ParamStr(i))) > 0)
and (ParamStr(i)[length(ParamStr(i))]
in ['
A'..'
Z','
a'..'
z'])
then begin
if not SaveRemoveDrive(ParamStr(i)[length(ParamStr(i))])
then begin end;
end;
end;
end;
PostMessage(
Handle, WM_CLOSE, 0, 0);
end;
procedure TaForm.FormDestroy(Sender: TObject);
begin
DriveMountPoints.Free;
UnloadConfigManagerApi;
UnloadSetupApi;
end;