Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 10.02.2015, 16:13
MotoArhangel MotoArhangel вне форума
Новичок
 
Регистрация: 14.10.2012
Сообщения: 58
Версия Delphi: Delphi 10.4
Репутация: 10
По умолчанию 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 и пару моментов.
Вложения
Тип файла: zip USB.zip (12.0 Кбайт, 9 просмотров)

Последний раз редактировалось MotoArhangel, 13.02.2015 в 22:07. Причина: Решено.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 23:24.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025