На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> delphi Отловить подключение usb , организация в dll
    Нашел на просторах рунета код для отлова подключения к усб порту

    Скрытый текст
    ExpandedWrap disabled
      unit usb_utils;
       
      //http://www.swissdelphicenter.ch/en/tipsindex.php
       
      interface
       
      uses
       Windows, Messages, SysUtils, Classes, Forms;
       
      type
       
       PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;
       DEV_BROADCAST_HDR = packed record
         dbch_size: DWORD;
         dbch_devicetype: DWORD;
         dbch_reserved: DWORD;
       end;
       
       PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
       DEV_BROADCAST_DEVICEINTERFACE = record
         dbcc_size: DWORD;
         dbcc_devicetype: DWORD;
         dbcc_reserved: DWORD;
         dbcc_classguid: TGUID;
         dbcc_name: short;
       end;
       
      const
       GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
       DBT_DEVICEARRIVAL          = $8000;          // system detected a new device
       DBT_DEVICEREMOVECOMPLETE   = $8004;          // device is gone
       DBT_DEVTYP_DEVICEINTERFACE = $00000005;      // device interface class
       
      type
       
       TComponentUSB = class(TComponent)
       private
         FWindowHandle: HWND;
         FOnUSBArrival: TNotifyEvent;
         FOnUSBRemove: TNotifyEvent;
         procedure WndProc(var Msg: TMessage);
         function USBRegister: Boolean;
       protected
         procedure WMDeviceChange(var Msg: TMessage); dynamic;
       public
         constructor Create(AOwner: TComponent); override;
         destructor Destroy; override;
       published
         property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
         property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
       end;
       
      implementation
       
      constructor TComponentUSB.Create(AOwner: TComponent);
      begin
       inherited Create(AOwner);
       FWindowHandle := AllocateHWnd(WndProc);
       USBRegister;
      end;
       
      destructor TComponentUSB.Destroy;
      begin
       DeallocateHWnd(FWindowHandle);
       inherited Destroy;
      end;
       
      procedure TComponentUSB.WndProc(var Msg: TMessage);
      begin
       if (Msg.Msg = WM_DEVICECHANGE) then  
       begin
         try
           WMDeviceChange(Msg);
         except
           Application.HandleException(Self);
         end;
       end
       else
         Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
      end;
       
      procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
      var
       devType: Integer;
       Datos: PDevBroadcastHdr;
      begin
       if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then  
       begin
         Datos := PDevBroadcastHdr(Msg.lParam);
         devType := Datos^.dbch_devicetype;
         if devType = DBT_DEVTYP_DEVICEINTERFACE then  
         begin // USB Device
           if Msg.wParam = DBT_DEVICEARRIVAL then  
           begin
             if Assigned(FOnUSBArrival) then
               FOnUSBArrival(Self);
           end  
           else  
           begin
             if Assigned(FOnUSBRemove) then
               FOnUSBRemove(Self);
           end;
         end;
       end;
      end;
       
      function TComponentUSB.USBRegister: Boolean;
      var
       dbi: DEV_BROADCAST_DEVICEINTERFACE;
       Size: Integer;
       r: Pointer;
      begin
       Result := False;
       Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
       ZeroMemory(@dbi, Size);
       dbi.dbcc_size := Size;
       dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
       dbi.dbcc_reserved := 0;
       dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;
       dbi.dbcc_name := 0;
       
       r := RegisterDeviceNotification(FWindowHandle, @dbi,
         DEVICE_NOTIFY_WINDOW_HANDLE
         );
       if Assigned(r) then Result := True;
      end;
       
      end.


    Все бы хорошо, но вот не особо у меня получается его совместить с dll (хочу потом заинжектить длл в процесс). Тобищь, нужно чтоб длл отлавливала подключения флешки, как я использовал код выше

    Скрытый текст
    ExpandedWrap disabled
      library dll;
       
      uses
       SysUtils,
       Classes,windows,dialogs,messages;
       
      type
       
      PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;
      DEV_BROADCAST_HDR = packed record
        dbch_size: DWORD;
        dbch_devicetype: DWORD;
        dbch_reserved: DWORD;
      end;
       
      PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
      DEV_BROADCAST_DEVICEINTERFACE = record
        dbcc_size: DWORD;
        dbcc_devicetype: DWORD;
        dbcc_reserved: DWORD;
        dbcc_classguid: TGUID;
        dbcc_name: short;
      end;
       
      const
      GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
      DBT_DEVICEARRIVAL          = $8000;          // system detected a new device
      DBT_DEVICEREMOVECOMPLETE   = $8004;          // device is gone
      DBT_DEVTYP_DEVICEINTERFACE = $00000005;      // device interface class
       
      type
       
      TComponentUSB = class(TComponent)
      private
        FWindowHandle: HWND;
        FOnUSBArrival: TNotifyEvent;
        FOnUSBRemove: TNotifyEvent;
        procedure WndProc(var Msg: TMessage);
        function USBRegister: Boolean;
      protected
        procedure WMDeviceChange(var Msg: TMessage); dynamic;
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
      published
        property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
        property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
      end;
       
      {$R *.res}
       
      constructor TComponentUSB.Create(AOwner: TComponent);
      begin
      inherited Create(AOwner);
      FWindowHandle := AllocateHWnd(WndProc);
      USBRegister;
      end;
       
      destructor TComponentUSB.Destroy;
      begin
      DeallocateHWnd(FWindowHandle);
      inherited Destroy;
      end;
       
      procedure TComponentUSB.WndProc(var Msg: TMessage);
      begin
      if (Msg.Msg = WM_DEVICECHANGE) then
      begin
        try
          WMDeviceChange(Msg);
        except
        showmessage('error');
       //   Application.HandleException(Self);
        end;
      end
      else
        Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
      end;
       
      procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
      var
      devType: Integer;
      Datos: PDevBroadcastHdr;
      begin
      if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
      begin
        Datos := PDevBroadcastHdr(Msg.lParam);
        devType := Datos^.dbch_devicetype;
        if devType = DBT_DEVTYP_DEVICEINTERFACE then
        begin // USB Device
          if Msg.wParam = DBT_DEVICEARRIVAL then
          begin
          showmessage('tada!');
            if Assigned(FOnUSBArrival) then
              FOnUSBArrival(Self);
          end
          else
          begin
            if Assigned(FOnUSBRemove) then
              FOnUSBRemove(Self);
          end;
        end;
      end;
      end;
       
      function TComponentUSB.USBRegister: Boolean;
      var
      dbi: DEV_BROADCAST_DEVICEINTERFACE;
      Size: Integer;
      r: Pointer;
      begin
      Result := False;
      Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
      ZeroMemory(@dbi, Size);
      dbi.dbcc_size := Size;
      dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
      dbi.dbcc_reserved := 0;
      dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;
      dbi.dbcc_name := 0;
       
      r := RegisterDeviceNotification(FWindowHandle, @dbi,
        DEVICE_NOTIFY_WINDOW_HANDLE
        );
      if Assigned(r) then Result := True
      else
      showmessage('bad');
       
      end;
       
      begin
      showmessage('good');
      TComponentUSB.Create(nil);
      while true do
      sleep(100);
      end.


    Инжектю длл, выходит сообщение good, значит заинжектилось норм, но вот при вставке флэшки не выходит сообщение tada!, хотя на форме все работает хорошо. Я думаю, что проблема в регистрации (USBRegister) мб хэндл не тот, можете мне подсказать ?
      А в WndProc вообще заходит?
        Цитата Fr0sT @
        А в WndProc вообще заходит?

        я так полагаю, что нет. Сделал так
        ExpandedWrap disabled
          procedure TComponentUSB.WndProc(var Msg: TMessage);
          begin
          if (Msg.Msg = WM_DEVICECHANGE) then
          begin
             try
             showmessage('WndProc');
               WMDeviceChange(Msg);
             except
             showmessage('error');
            //   Application.HandleException(Self);
             end;
          end
          else
             Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
          end;


        но сообщение не выскочило, значит не заходит.


        на стековерфлоу ответили так

        Цитата
        вы же сами препятствуете получению сообщений созданным окном, окно, которое создается в конструкторе TComponentUSB. Именно ему ОС отправляет сообщения. И именно в его оконной функции вы их обрабатываете. Для получения окнами сообщений нужен цикл выборки, реализуемый потоком. Когда вы создаете TComponentUSB в главном потоке приложения ("на форме")- цикл выборки за вас реализует TApplication. А в своем потоке, тем более - в "чужом" процессе это нужно делать самому


        только я не знаю, как сделать цикл выборки GetMessage - TranslateMessage - DispatchMessage.

        можете помочь ?
          ExpandedWrap disabled
            while GetMessage() do begin
                TranslateMessage
                DispatchMessage
              end;
          Сообщение отредактировано: MBo -
            Цитата xerasy @
            но сообщение не выскочило, значит не заходит.

            Вообще проверять надо было первой строчкой, причем лучше всего - выводом в файл или в debug. Потому как не уверен, что в инжекнутой dll showmessage отработает.

            Первая мысль у меня была, что как раз сообщение не доходит до Wndproc, но поразмышляв, не увидел, почему бы этой схеме не работать. Окно создается в главном потоке, при создании в свойства записывается указатель на Wndproc, и DispatchMessage должна перенаправить сообщение куда надо.

            Что касается обработки в потоке, то в Execute
            ExpandedWrap disabled
                // Вызываем фейковую функцию для получения сообщения, чтобы система создала
                // очередь сообщений. Без этого некоторое время после запуска потока отправка
                // сообщений ему завершается с ошибкой. Поэтому после PeekMessage ставим флаг,
                // что очередь сообщений создана. В основной же программе после запуска ждём,
                // пока флаг не будет установлен.
                // Размещение PeekMessage в конструкторе эффекта не даёт (т.к. выполняется
                // в контексте главного потока).
                // http://msdn.microsoft.com/en-us/library/ms644946(v=VS.85).aspx
                PeekMessage(MsgRec, 0, WM_USER, WM_USER, PM_NOREMOVE);
               
                // основной цикл - организуем свой цикл выборки сообщений, но еще и проверяем,
                // не завершён ли поток. GetMessage возвращает False, когда получен WM_QUIT
                while (not Terminated) and GetMessage(MsgRec, 0, 0, 0) do
                begin
                  ... - обработать сообщения непосредственно потоку
                  TranslateMessage - если обрабатываются клавиши
                  DispatchMessage - раскидать сообщения по окнам потока
                end;
              да, вы правы. Спасибо всем большое за помощь.
                Цитата Fr0sT @
                Первая мысль у меня была, что как раз сообщение не доходит до Wndproc, но поразмышляв, не увидел, почему бы этой схеме не работать. Окно создается в главном потоке, при создании в свойства записывается указатель на Wndproc, и DispatchMessage должна перенаправить сообщение куда надо.

                Во-первых, не факт, что окно создается в главном потоке, т.к. инжект может выполняться через CreateRemoteThread. Но главное, второе - в begin..end своей dll он крутит бесконечный цикл со sleep(100), что ни в какие ворота не лезет, т.к. код потока просто крутится в этом цикле и соотв-но никакой выборки сообщений в любом случае не происходит. (Поэтому, если при этом прога не виснет наглухо, то dll точно инжектится через CreateRemoteThread).

                Правильный ответ с запуском отдельного потока для создания окна и обработки сообщений дан автору на stackoverflow (пока мы все спали, как нормальные люди :) )
                Сообщение отредактировано: leo -
                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                0 пользователей:


                Рейтинг@Mail.ru
                [ Script execution time: 0,0319 ]   [ 17 queries used ]   [ Generated: 28.03.24, 20:27 GMT ]