| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

зависание при установке ловушки [D7, WinXP]

MasDen ©   (2008-10-03 18:16:00) 

Добрый день написал 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;


---

MasDen   (2008-10-04 14:18:00) [1]

У меня есть Windows программа и в неё просто нужно встроить возможность словить сообщение закрытия дочернего окна с определенной надписью.

---

DVM   (2008-10-04 13:58:00) [2]

> 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   (2008-10-04 11:52:00) [3]

Спасибо всем кто откликнулся, да для вас всех этот код оказался туп до невозможности, но что сделать если этот код писал человек, который занимается разработкай 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;

Заранее спасибо.

---

Городской Шаман   (2008-10-03 22:30:00) [4]

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


Ну глобальный хук ставить в этой ситуации я ему посетовал ставить, но не думал что его использовать будут ТАК.

---

Городской Шаман   (2008-10-03 22:28:00) [5]

Ошибка в этой строчке

HCBT_CREATEWND
A window is about to be created. The system calls the hook procedure before sending theWM_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.

Окна пока нет, здесь только уведомление о его создании.

---

Rouse_   (2008-10-03 22:05:00) [6]

Мдя... я раньше плакал - теперь привык...
Да кто-ж вас учил то WParam в виде WORD-а делать, да еще к тому-же ShowMessage на обработчике WH_CBT поднимать?
Фленов что-ли? :)

---

DVM   (2008-10-03 21:55:00) [7]

вызывать функции, создающие окна из HCBT_CREATEWND - грамотно придумано, ничего не скажешь.

---

easy   (2008-10-03 19:06:00) [8]

и алярмы разгребать.

---

easy   (2008-10-03 19:04:00) [9]

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;

---

MasDen   (2008-10-03 18:59:00) [10]

Спасибо, попробовал..все-равно загрузка по максимум, пробовал и а компе и на ноутбуке, эффект один и тот же=((

---

easy   (2008-10-03 18:40:00) [11]

var
  windtext: array[0..255] of char;
  Wnd:HWND;

---

easy   (2008-10-03 18:29:00) [12]

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;

---

Наверх