Usb info (подскажите что не так)
Пробую получить информацию о подключенной флешке. Но по каким то причинам не работает, возвращается пустая строка, хотя с ADB интерфейсом работает нормально. Возможно Guid не тот указал для усб, но навряд ли брал с MSDN.
Прикрепил проект. Так же размещу код.
Основной модуль. получаем информацию об устройстве
Код:
unit UsbInfo;
interface
uses
Windows,
Classes,
SetupAPI;
function AddUSBInfo(aGUID:TGUID;PropertyCode:integer):string;
implementation
function ExtractMultiString(const Value: String): String;
var
P: PChar;
begin
P := @Value[1];
while P^ <> #0 do
begin
if Result <> '' then
Result := Result + ', ';
Result := Result + P;
Inc(P, lstrlen(P) + 1);
end;
end;
function DWORDtoDiskNames(val:DWORD):string;
var
_i: integer;
begin
Result:='';
for _i := 0 to 25 do
begin
if ((val mod 2)=1) then Result:=result+ chr(_i + 65);
val:=val shr 1;
end;
end;
function InfoUsbDevice(PropertyCode: Integer; PnPHandle: HDEVINFO;const DevData: TSPDevInfoData): String;
var
dwPropertyRegDataType, dwRequiredSize: DWORD;
begin
Result := '';
dwRequiredSize := 0;
dwPropertyRegDataType := REG_SZ;
SetupDiGetDeviceRegistryPropertyA(PnPHandle, DevData,
PropertyCode, dwPropertyRegDataType, nil, 0, dwRequiredSize);
if not (dwPropertyRegDataType in [REG_SZ, REG_MULTI_SZ]) then Exit;
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
SetLength(Result, dwRequiredSize);
SetupDiGetDeviceRegistryPropertyA(PnPHandle, DevData,
PropertyCode, dwPropertyRegDataType, @Result[1],
dwRequiredSize, dwRequiredSize);
end;
case dwPropertyRegDataType of
REG_SZ: Result := PChar(Result);
REG_MULTI_SZ: Result := ExtractMultiString(Result);
end;
end;
function AddUSBInfo(aGUID:TGUID;PropertyCode:integer):string;
var
DrivePnPHandle: HDEVINFO;
DeviceNumber:DWORD;
DevData: TSPDevInfoData;
DeviceInterfaceData: TSPDeviceInterfaceData;
RES:BOOL;
begin
DrivePnPHandle := SetupDiGetClassDevs(@aGUID, nil, 0, DIGCF_PRESENT);
if DrivePnPHandle = INVALID_HANDLE_VALUE then Exit;
DeviceNumber := 0;
repeat
DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
DevData.cbSize := SizeOf(TSPDevInfoData);
RES := SetupDiEnumDeviceInfo(DrivePnPHandle, DeviceNumber, DevData);
if (RES) then
begin
result:=pansichar(InfoUsbDevice(PropertyCode,DrivePnPHandle, DevData));
Inc(DeviceNumber);
end;
until not RES;
SetupDiDestroyDeviceInfoList(DrivePnPHandle);
end;
end.
Ловим подключившееся устройство
Код:
unit MainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,Vcl.ExtCtrls,
StrUtils, setupAPI, USBinfo;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
procedure UsbNotification;
procedure OnDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
{ Private declarations }
public
procedure SetLine(AMemo: TMemo);
procedure DeviceInfo;
function ExistWordInString(aString:PWideChar;aSearchString:string;aSearchOptions: TStringSearchOptions): Boolean;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function Tform1.ExistWordInString(aString:PWideChar;aSearchString:string;aSearchOptions: TStringSearchOptions): Boolean;
var
Size : Integer;
begin
Result:=false;
Size:=StrLen(aString);
result := SearchBuf(aString, Size, 0, 0, aSearchString, aSearchOptions)<>nil;
end;
procedure TForm1.DeviceInfo;
Var
s:string;
begin
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE,SPDRP_MFG);
if s<>'' then Memo1.Lines.Add('1 '+s);
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE,SPDRP_DEVICEDESC);
if s<>''then Memo1.Lines.Add('2 '+s);
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE,SPDRP_DEVICEDESC);
if s<>'' then Memo1.Lines.Add('3 '+s);
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE,SPDRP_SERVICE );
if s<>'' then Memo1.Lines.Add('4 '+s);
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE,SPDRP_FRIENDLYNAME );
if s<>'' then Memo1.Lines.Add('5 '+s);
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE,SPDRP_UI_NUMBER );
if s<>'' then Memo1.Lines.Add('6 '+s);
s:='';
s:=AddUSBInfo(GUID_DEVINTERFACE_USB_DEVICE, SPDRP_HARDWAREID );
if s<>'' then Memo1.Lines.Add('7 '+s);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
UsbNotification;
end;
procedure Tform1.SetLine(AMemo: TMemo);
var
p : TPoint;
FirstVisible : longint;
begin
with AMemo do
begin
p.X := 0;
p.Y := Lines.Count;
CaretPos := p;
FirstVisible := SendMessage(Handle,EM_GETFIRSTVISIBLELINE,0,0);
SendMessage(Handle,EM_LINESCROLL,0, p.Y - FirstVisible );
SetFocus;
end;
end;
procedure TForm1.UsbNotification;
var
NF:TDEV_BROADCAST_DEVICEINTERFACE;
Size: Integer;
begin
Size := SizeOf(TDEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@NF, Size);
NF.dbcc_size := Size;
//NF.dbcc_size:=sizeof(TDEV_BROADCAST_DEVICEINTERFACE);
NF.dbcc_devicetype:=DBT_DEVTYP_DEVICEINTERFACE;
NF.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
NF.dbcc_reserved := 0;
NF.dbcc_name := #0;
//RegisterDeviceNotification(Handle,@NF,DEVICE_NOTIFY_ALL_INTERFACE_CLASSES);
RegisterDeviceNotification(Handle,@NF,device_notify_window_handle);
end;
procedure TForm1.OnDeviceChange(var Msg: TMessage);
var
MSGSTR:String;
begin
if Msg.WParam=DBT_DEVICEARRIVAL then
begin
case PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype of
DBT_DEVTYP_DEVICEINTERFACE:
DeviceInfo;
DBT_DEVTYP_HANDLE:
Memo1.Lines.Add('новый системный хендл');
DBT_DEVTYP_OEM:
Memo1.Lines.Add('новое OEM- или IHV- устройство');
end;
end;
if Msg.WParam=DBT_DEVICEREMOVECOMPLETE then
begin
case PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype of
DBT_DEVTYP_DEVICEINTERFACE:
DeviceInfo;
DBT_DEVTYP_HANDLE:
Memo1.Lines.Add('уничтожен системный хендл');
DBT_DEVTYP_OEM:
Memo1.Lines.Add('извлечено OEM- или IHV- устройство');
end;
end;
end;
end.
Ну и сам SetupAPI взят с JEDI версию не помню. Можно посмотреть в проекте. Немного добавил из MSDN.
Добавил только:
Код:
// Classes GUIDs
GUID_DEVCLASS_FLASH: TGUID = '{feb8d079-0681-11d4-9531-0060089abc08}';
GUID_DEVCLASS_ADB: TGUID = '{F72FE0D4-cbcb-407d-8814-9ed673d0dd6b}';
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
SPDRP_SERVICE = $00000004;
SPDRP_UI_NUMBER = $00000010;
SPDRP_HARDWAREID = $00000001;
Решено. Причина: Guid и пару моментов.
|