-
Добрый день написал dll в которой отлавливаются события создания и закрытия окна и вот проблема при запуске программы виснет компьютер или происходит ошибка. Помогите разобраться, чв чем роблема..вот код dll - библиотеки
library hook;
uses
windows, messages, dialogs;
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;
-
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;
-
var
windtext: array[0..255] of char;
Wnd:HWND;
-
Спасибо, попробовал..все-равно загрузка по максимум, пробовал и а компе и на ноутбуке, эффект один и тот же=((
-
library hook;
uses
windows, messages;
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);
MessageBox(0,'Wnd is created!!','Alarm',MB_OK);
end;
HCBT_DESTROYWND:
begin
Wnd:=wParam;
if Wnd<>0 then
GetWindowText(Wnd, windtext, 255);
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;
-
и алярмы разгребать.
-
вызывать функции, создающие окна из HCBT_CREATEWND - грамотно придумано, ничего не скажешь.
-
Мдя... я раньше плакал - теперь привык... Да кто-ж вас учил то WParam в виде WORD-а делать, да еще к тому-же ShowMessage на обработчике WH_CBT поднимать? Фленов что-ли? :)
-
Ошибка в этой строчке
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.
Окна пока нет, здесь только уведомление о его создании.
-
> Rouse_ © (03.10.08 22:05) [7] > > Мдя... я раньше плакал - теперь привык... > Да кто-ж вас учил то WParam в виде WORD-а делать, да еще > к тому-же ShowMessage на обработчике WH_CBT поднимать? > Фленов что-ли? :)
Ну глобальный хук ставить в этой ситуации я ему посетовал ставить, но не думал что его использовать будут ТАК.
-
Спасибо всем кто откликнулся, да для вас всех этот код оказался туп до невозможности, но что сделать если этот код писал человек, который занимается разработкай 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;
Заранее спасибо.
-
> 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.
-
У меня есть Windows программа и в неё просто нужно встроить возможность словить сообщение закрытия дочернего окна с определенной надписью.
|