Конференция "WinAPI" » зависание при установке ловушки [D7, WinXP]
 
  • MasDen © (03.10.08 18:16) [0]
    Добрый день написал dll в которой отлавливаются события создания и закрытия окна и вот проблема при запуске программы виснет компьютер или происходит ошибка. Помогите разобраться, чв чем роблема..вот код dll - библиотеки

    library hook;

    uses
     windows, messages, dialogs;

     {$R *.res}

    var
     SysHook: HHOOK = 0; //дескриптор системной ловушки
     Wnd: word;

     //============================================================================
     //процедура обработки сообщений
     //в которой мы счиываем заголовок окна и выводим его простым сообщением
     function SysMsgProc(code: Integer; wParam: word; lParam: longint):Longint; stdcall;
     var
       windtext: array[0..255] of char;
     begin
       Result := CallNextHookEx(SysHook, code, wParam, lParam);
       case code of
         HCBT_CREATEWND:
         begin
           Wnd:=Wparam;
           GetWindowText(Wnd, windtext, 255);
         end;
         HCBT_DESTROYWND:
         begin
           Wnd:=wParam;
           if Wnd<>0 then
             GetWindowText(Wnd, windtext, 255);
         end;
       end;
       ShowMessage(windtext);
     end;

    //Процедура установки ловушки
     procedure SetHook(Hook: Boolean) export; stdcall;
     begin
       if Hook then
       begin
           SysHook:=SetWindowsHookEx(WH_CBT,
             @SysMsgProc, HInstance, 0);
       end
       else
       begin
           UnhookWindowsHookEx(SysHook);
           SysHook:=0;
       end;
     end;

     //============================================================================

     exports SetHook index 1;

    begin
    end.



    А вот как в программе вызывается данная библиотека

    ...
    var
     frmCatalog: TfrmCatalog;
     procedure SetHook(Hook: Boolean) stdcall; external 'hook.dll' index 1;
    ...
    procedure TfrmCatalog.FormCreate(Sender: TObject);
    begin
     SetHook(true); //устанавливаем ловушку
    end;

    procedure TfrmCatalog.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
     SetHook(false); //удаляем ловушку
    end;

  • easy © (03.10.08 18:29) [1]
    function SysMsgProc(code: Integer; wParam: word; lParam: longint):Longint; stdcall;
    var
      windtext: array[0..255] of char;
    begin
      case code of
        HCBT_CREATEWND:
        begin
          Wnd:=Wparam;
          GetWindowText(Wnd, windtext, 255);
        end;
        HCBT_DESTROYWND:
        begin
          Wnd:=wParam;
          if Wnd<>0 then
            GetWindowText(Wnd, windtext, 255);
        end;
      end;
      ShowMessage(windtext);
      Result := CallNextHookEx(SysHook, code, wParam, lParam);
    end;

  • easy © (03.10.08 18:40) [2]
    var
      windtext: array[0..255] of char;
      Wnd:HWND;

  • MasDen © (03.10.08 18:59) [3]
    Спасибо, попробовал..все-равно загрузка по максимум, пробовал и а компе и на ноутбуке, эффект один и тот же=((
  • easy © (03.10.08 19:04) [4]
    library hook;
    uses
    windows, messages;

    {$R *.res}

    var
    SysHook: HHOOK = 0; //дескриптор системной ловушки
    Wnd: word;

    //============================================================================
    //процедура обработки сообщений
    //в которой мы счиываем заголовок окна и выводим его простым сообщением
    function SysMsgProc(code: Integer; wParam: word; lParam: longint):Longint; stdcall;
    var
      windtext: array[0..255] of char;
      Wnd:HWND;
    begin

      case code of
        HCBT_CREATEWND:
        begin
          Wnd:=Wparam;
          GetWindowText(Wnd, windtext, 255);
          //ShowMessage(windtext);
          MessageBox(0,'Wnd is created!!','Alarm',MB_OK);
        end;
        HCBT_DESTROYWND:
        begin
          Wnd:=wParam;
          if Wnd<>0 then
            GetWindowText(Wnd, windtext, 255);
            //ShowMessage(windtext);
            MessageBox(0,'Wnd is destroyed!!','Alarm',MB_OK);
        end;
      end;

      Result := CallNextHookEx(SysHook, code, wParam, lParam);
    end;

    //Процедура установки ловушки
    procedure SetHook(Hook: Boolean) export; stdcall;
    begin
      if Hook then
      begin
          SysHook:=SetWindowsHookEx(WH_CBT,
            @SysMsgProc, HInstance, 0);
      end
      else
      begin
          UnhookWindowsHookEx(SysHook);
          SysHook:=0;
      end;
    end;

    //============================================================================

    exports SetHook index 1;

    begin
    end.



    > А вот как в программе вызывается данная библиотека
    >
    > ...
    > var
    >  frmCatalog: TfrmCatalog;
    >  procedure SetHook(Hook: Boolean) stdcall; external 'hook.
    > dll' index 1;
    > ...
    > procedure TfrmCatalog.FormCreate(Sender: TObject);
    > begin
    >  SetHook(true); //устанавливаем ловушку
    > end;
    >
    > procedure TfrmCatalog.FormClose(Sender: TObject; var Action:
    >  TCloseAction);
    > begin
    >  SetHook(false); //удаляем ловушку
    > end;
    >

    procedure TForm1.Button1Click(Sender: TObject);
    begin
     SetHook(true);
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    begin
     SetHook(false);
    end;

  • easy © (03.10.08 19:06) [5]
    и алярмы разгребать.
  • DVM © (03.10.08 21:55) [6]
    вызывать функции, создающие окна из HCBT_CREATEWND - грамотно придумано, ничего не скажешь.
  • Rouse_ © (03.10.08 22:05) [7]
    Мдя... я раньше плакал - теперь привык...
    Да кто-ж вас учил то WParam в виде WORD-а делать, да еще к тому-же ShowMessage на обработчике WH_CBT поднимать?
    Фленов что-ли? :)
  • Городской Шаман (03.10.08 22:28) [8]
    Ошибка в этой строчке

    HCBT_CREATEWND
    A window is about to be created. The system calls the hook procedure before sending the WM_CREATE or WM_NCCREATE message to the window. If the hook procedure returns a nonzero value, the system destroys the window; the CreateWindow function returns NULL, but the WM_DESTROY message is not sent to the window. If the hook procedure returns zero, the window is created normally.


    Окна пока нет, здесь только уведомление о его создании.
  • Городской Шаман (03.10.08 22:30) [9]

    > Rouse_ ©   (03.10.08 22:05) [7]
    >
    > Мдя... я раньше плакал - теперь привык...
    > Да кто-ж вас учил то WParam в виде WORD-а делать, да еще
    > к тому-же ShowMessage на обработчике WH_CBT поднимать?
    > Фленов что-ли? :)


    Ну глобальный хук ставить в этой ситуации я ему посетовал ставить, но не думал что его использовать будут ТАК.
  • MasDen © (04.10.08 11:52) [10]
    Спасибо всем кто откликнулся, да для вас всех этот код оказался туп до невозможности, но что сделать если этот код писал человек, который занимается разработкай web-приложений? Я не пишу Windows приложения, я не умею толком работать, да и вообще не умею с сообщениями ОС, имено по этому и написал здесь. У меня есть опыт создания приложений для Windows на Delphi. Но писал я в основном программы для работы с БД, но никак уж не системные.

    Если не против, может вы поможете мне еще один раз? Я только что понял, что в принципе сделал тпо, когда создал отдельную dll и начал в ней ловить сообщения, так как если я словил нужное мне нужно выполнить одну процедуру из exe файла. Скажите пожалуйста как правильно объявить и с какими параметрами процедуру, чтобы она ловила теже сообщения о закрытии окна, но чтобы она была размещаена просто в exe файле.
    Вот как выглядит функция в dll

    function SysMsgProc(code: Integer; wParam: word; lParam: longint):Longint; stdcall;
    const
     CAPTION = 'Заголовок окна'
    var
     windtext: array[0..255] of char;
     Wnd:HWND;
    begin
     case code of
       HCBT_DESTROYWND:
       begin
         Wnd:=wParam;
         if Wnd<>0 then
           GetWindowText(Wnd, windtext, 255);

         if windtext=CAPTION then
         begin
           Вызываем нужную процедуру
         end;

       end;
     end;

     Result := CallNextHookEx(SysHook, code, wParam, lParam);
    end;


    Заранее спасибо.
  • DVM © (04.10.08 13:58) [11]

    > MasDen ©

    если тебе только Top Level окна нужны, то может проще без dll так :

    program ShellHookDemo;

    uses
     windows, messages, sysutils;

    const
     RSH_DEREGISTER = 0;
     RSH_REGISTER = 1;
     RSH_REGISTER_PROGMAN = 2;
     RSH_REGISTER_TASKMAN = 3;

     HSHELL_ACTIVATESHELLWINDOW = 3;
     HSHELL_WINDOWCREATED = 1;
     HSHELL_WINDOWDESTROYED = 2;
     HSHELL_WINDOWACTIVATED = 4;
     HSHELL_GETMINRECT = 5;
     HSHELL_REDRAW = 6;
     HSHELL_TASKMAN = 7;
     HSHELL_LANGUAGE = 8;

    var
     wc : TWndClassEx;
     MainWnd : HWND;
     Mesg : TMsg;
     WndListBox:hWnd;
     WM_ShellHook:Integer;
     xPos,yPos,nWidth,nHeight : Integer;
     osInfo:OSVERSIONINFO;

    Procedure RegisterShellHook(Wnd:hWnd;n:dword); stdcall;external 'shell32.dll' index 181;

    //------------------------------------------------------------------------------

    function GetTextFromWindow(Wnd: HWND): string;
    var
     TextLength: Integer;
     Text: PChar;
    begin
     TextLength := SendMessage(Wnd, WM_GETTEXTLENGTH, 0, 0);
     if TextLength = 0 then Result := ''
     else
     begin
       GetMem(Text, TextLength + 1);
       SendMessage(Wnd, WM_GETTEXT, TextLength + 1, Integer(Text));
       Result := Text;
       FreeMem(Text);
     end;
    end;

    //------------------------------------------------------------------------------

    function ListBox_AddString(lb : THandle; txt : String) : integer;
    begin
     Result := SendMessage(lb, lb_addString, 0, integer(pchar(@txt[1])));
    end;

    //------------------------------------------------------------------------------

    function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall;
    begin
     if msg=wm_shellhook then
       begin
         case wparam of
           HSHELL_WINDOWCREATED: ListBox_AddString(WndListBox,'Создано окно: HWND='
                        +inttostr(lparam)+' Text=\"'+GetTextFromWindow(lparam)+'\"');
           HSHELL_WINDOWDESTROYED: ListBox_AddString(WndListBox,
                                        'Уничтожено окно: HWND='+inttostr(lparam));
           HSHELL_WINDOWACTIVATED: ListBox_AddString(WndListBox,
                              'Активируется окно: HWND='+inttostr(lparam)+' Text=\"'
                                                   +GetTextFromWindow(lparam)+'\"');
         end;
       end;
     case msg of
       wm_destroy :
         Begin
           postquitmessage(0);
           Result:=0;
           exit;
         End;
     else Result:=DefWindowProc(wnd,msg,wparam,lparam);
     end;
    End;

    //------------------------------------------------------------------------------

    begin
     wc.cbSize:=sizeof(wc);
     wc.style:=cs_hredraw or cs_vredraw;
     wc.lpfnWndProc:=@WindowProc;
     wc.cbClsExtra:=0;
     wc.cbWndExtra:=0;
     wc.hInstance:=HInstance;
     wc.hIcon:=LoadIcon(0,idi_application);
     wc.hCursor:=LoadCursor(0,idc_arrow);
     wc.hbrBackground:=COLOR_BTNFACE+1;
     wc.lpszMenuName:=nil;
     wc.lpszClassName:='ShellHookDemo';
     if RegisterClassEx (wc) = 0 then
       MessageBox (0, 'Invalid class registration', 'Error', MB_OK)
     else
       begin
         xPos:=100; yPos:=150;
         nWidth:=430; nHeight:=250;
         MainWnd:=CreateWindowEx(
           0,
           'ShellHookDemo',
           'ShellHookDemo',
           ws_overlappedwindow,
           xPos,
           yPos,
           nWidth,
           nHeight,
           0,
           0,
           Hinstance,
           nil
           );
         if MainWnd = 0 then
           MessageBox (0, 'Window not created', 'Error', MB_OK)
         else
           begin
             ShowWindow(MainWnd,CmdShow);
             WM_ShellHook := RegisterWindowMessage('SHELLHOOK');
             if WM_ShellHook<>0 then
               begin
                 osInfo.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);
                 GetVersionEx(osInfo);
                 RegisterShellHook(0, 1);
                 if(osInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) then
                   RegisterShellHook(MainWnd, RSH_REGISTER)
                 else
                  RegisterShellHook(MainWnd, RSH_REGISTER_TASKMAN);
               end;
             SendMessage(GetDesktopWindow, $400, 0, 0);
             WndListbox:=CreateWindowEx(
                                        ws_ex_clientedge,
                                        'listbox',
                                        '',
                                        lbs_notify
                                        or ws_visible
                                        or ws_child
                                        or ws_vscroll,
                                        10,
                                        10,
                                        400,
                                        200,
                                        MainWnd,
                                        0,
                                        hInstance,
                                        nil
                                        );
             SendMessage(WndListBox,wm_setfont,GetStockObject(ansi_var_font),0);
           end;
       end;

     While GetMessage(Mesg,0,0,0) do
       begin
         TranslateMessage(Mesg);
         DispatchMessage(Mesg);
       end;
    end.

  • MasDen © (04.10.08 14:18) [12]
    У меня есть Windows программа и в неё просто нужно встроить возможность словить сообщение закрытия дочернего окна с определенной надписью.
 
Конференция "WinAPI" » зависание при установке ловушки [D7, WinXP]
Есть новые Нет новых   [134435   +33][b:0][p:0.008]