Function SetupDiEnumDeviceInterfaces(DeviceInfoSet: HDEVINFO; DeviceInfoData: PSPDevInfoData; Const InterfaceClassGuid: TGUID; MemberIndex: DWORD; Var DeviceInterfaceData: TSPDeviceInterfaceData): BOOL; Stdcall; External SetupAPI; {$EXTERNALSYM SetupDiEnumDeviceInterfaces}
Function SetupDiGetDeviceInterfaceDetailA(DeviceInfoSet: HDEVINFO; DeviceInterfaceData: PSPDeviceInterfaceData; DeviceInterfaceDetailData: PSPDeviceInterfaceDetailDataA; DeviceInterfaceDetailDataSize: DWORD; Var RequiredSize: DWORD; Device: PSPDevInfoData): BOOL; Stdcall; External SetupAPI;
Function SetupDiDestroyDeviceInfoList(DeviceInfoSet: HDEVINFO): BOOL; Stdcall; External SetupAPI;
Function GetUSBDiskID(DiskID: String; Var PID: String): Boolean; Var USBGuid: TGUID; USBHandle: HDEVINFO; Success: LongBool; Devn: Integer; DevData: TSPDevInfoData; DeviceInterfaceData: TSPDeviceInterfaceData; FunctionClassDeviceData: PSPDeviceInterfaceDetailDataA; BytesReturned: DWORD; Reg: TRegistry; RegData: Array Of Char; i, RegSize: Integer; Str, USBPath: String; Begin Result := false; Pid := ''; Reg := TRegistry.Create; Reg.RootKey := HKEY_LOCAL_MACHINE; Reg.OpenKey('SYSTEM\MountedDevices', false); RegSize := Reg.GetDataSize(Format('\DosDevices\%s', [DiskID])); SetLength(RegData, RegSize + 1); Reg.ReadBinaryData(Format('\DosDevices\%s', [DiskID]), RegData[0], RegSize + 1); For i := 0 To RegSize - 1 Do If RegData[i] <> #0 Then Str := Str + RegData[i]; Str := Copy(Str, Pos('#RemovableMedia#', Str) + 16, Length(Str)); Str := Copy(Str, 1, Pos('RM', Str) - 2); Str := UpperCase(Str); Reg.CloseKey;
USBGuid := StringToGUID('{53f56307-b6bf-11d0-94f2-00a0c91efb8b}'); USBHandle := SetupDiGetClassDevsA(@USBGuid, Nil, 0, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE); If USBHandle = Pointer(INVALID_HANDLE_VALUE) Then Exit; Devn := 0; Repeat DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData); Success := SetupDiEnumDeviceInterfaces(USBHandle, Nil, USBGuid, Devn, DeviceInterfaceData); If Success Then Begin DevData.cbSize := SizeOf(DevData); BytesReturned := 0; SetupDiGetDeviceInterfaceDetailA(USBHandle, @DeviceInterfaceData, Nil, 0, BytesReturned, @DevData); If (BytesReturned <> 0) And (GetLastError = ERROR_INSUFFICIENT_BUFFER) Then Begin FunctionClassDeviceData := AllocMem(BytesReturned); FunctionClassDeviceData^.cbSize := SizeOf(TSPDeviceInterfaceDetailDataA); If SetupDiGetDeviceInterfaceDetailA(USBHandle, @DeviceInterfaceData, FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) Then Begin USBPath := StrPas(PChar(@FunctionClassDeviceData.DevicePath)); If Reg.OpenKeyReadOnly(Format('SYSTEM\CurrentControlSet\Enum%s', [StringReplace(Copy(USBPath, 4, Pos('{', USBPath) - 5), '#', '\', [rfReplaceAll])])) Then If UpperCase(Reg.ReadString('ParentIdPrefix')) = Str Then Begin PID := StringReplace(Str, '&', '', [rfReplaceAll]); Result := True; Break; End; Reg.CloseKey; Inc(Devn); End; FreeMem(FunctionClassDeviceData); End; End; Until Not Success; SetupDiDestroyDeviceInfoList(USBHandle); Reg.Free; End;
//使用方法 Procedure TForm1.Button1Click(Sender: TObject); Var Drv, Pid: String; Begin Drv := ExtractFileDrive(ParamStr(0)); If GetDriveType(PChar(Drv + '\')) <> DRIVE_REMOVABLE Then Application.MessageBox('对不起，请把本程序放至到优盘上使用!', 'Error', MB_ICONHAND) Else If GetUSBDiskID(Drv, Pid) Then Memo1.Lines.Add(Pid); End;
