Легенда:
новое сообщение
закрытая нитка
новое сообщение
в закрытой нитке
старое сообщение
|
- Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
- Новичкам также крайне полезно ознакомиться с данным документом.
| | | |
Поймал 06.06.03 09:34 Число просмотров: 1194
Автор: ASJinx Статус: Незарегистрированный пользователь
|
Прикольно.
Спасибо, попробую подобным образом.
|
<programming>
|
[delphi] Хуки 02.06.03 14:38
Автор: ASJinx Статус: Незарегистрированный пользователь
|
var
h,h1:hhook;
libhandle:HINST;
hkprc: TFNHookProc;
....
libhandle:=LoadLibrary('hook.dll');
hkprc:=GetProcAddress(libhandle, 'GetMsgProc');
h:=SetWindowsHookEX(WH_GETMESSAGE,hkprckeyboard,libhandle,0);
hkprc:=GetProcAddress(libhandle, 'CBTProc');
h1:=SetWindowsHookEX(WH_CBT,hkprckeyboard,libhandle,0);
....
UnhookWindowsHookEx(h);
UnhookWindowsHookEx(h1);
....
Можно ли делать так? Т.е. обрабатывать два хука из одной dll. Когда я так делаю у меня винды начинают заниматься своим любимым занятием, а именно delphi32 выполнела недопустимую error и будет того, rundll32 тожесамое и т.д. Оставляю один WH_GETMESSAGE, все работает.
С dll все в норме. Я трассировал, ругаться начинает после выхода из процедуры которая вкл. хук.
|
|
а чего это оба твои хука обрабатываются одной и той же функцией? 04.06.03 20:26
Автор: Killer{R} <Dmitry> Статус: Elderman Отредактировано 05.06.03 15:40 Количество правок: 2
|
libhandle:=LoadLibrary('hook.dll');
hkprc:=GetProcAddress(libhandle, 'GetMsgProc');
h:=SetWindowsHookEX(WH_GETMESSAGE,hkprckeyboard,libhandle,0);
hkprc:=GetProcAddress(libhandle, 'CBTProc');
h1:=SetWindowsHookEX(WH_CBT,hkprckeyboard,libhandle,0);
почему присваиваешь hkprc а в SetWindowsHookEX( ставишь hkprckeyboard? или это ты опечатался когда постил мессагу?
это во первых. Во вторых они должны вызывать CallNextHookEx в конце, а ты этого не делаешь.
|
|
[delphi] Хуки 04.06.03 19:42
Автор: Cyril <sc> Статус: Member
|
> var > h,h1:hhook; > libhandle:HINST; > hkprc: TFNHookProc; > .... > > libhandle:=LoadLibrary('hook.dll'); > hkprc:=GetProcAddress(libhandle, 'GetMsgProc'); > почему hkprc, а хук ставиться на hkprckeyboard ???
> h:=SetWindowsHookEX(WH_GETMESSAGE,hkprckeyboard,libhandle,0
> ); > hkprc:=GetProcAddress(libhandle, 'CBTProc'); аналогично
> h1:=SetWindowsHookEX(WH_CBT,hkprckeyboard,libhandle,0); > > .... > UnhookWindowsHookEx(h); > UnhookWindowsHookEx(h1); > .... > > Можно ли делать так? Т.е. обрабатывать два хука из одной > dll. Когда я так делаю у меня винды начинают заниматься > своим любимым занятием, а именно delphi32 выполнела > недопустимую error и будет того, rundll32 тожесамое и т.д. > Оставляю один WH_GETMESSAGE, все работает. > С dll все в норме. Я трассировал, ругаться начинает после > выхода из процедуры которая вкл. хук. Я думаю что обрабатывать два хука в одной длл можно легко и непринужденно, правда это мое личное ничем не доказанное мнение. Лучше кинь сюда исходник библиотеки и проги, а я тебе напишу о результатах
|
| |
Кидаю 05.06.03 12:39
Автор: ASJinx Статус: Незарегистрированный пользователь
|
dll - ка
library hook;
uses
SysUtils,
Windows,
Messages;
function CBTProc(code: integer; wparam: integer;lparam: integer):LRESULT; stdcall
begin
//пока ничего нету так как неработает с двумя
end;
function GetMsgProc(code: integer; wparam: integer;lparam: integer):LRESULT; stdcall
var pp: ^MSG;
begin
pp:=pointer(lparam);
if (pp.message=274) then pp.message:=0;
if (pp.message=80) then begin
SendMessage(FindWindow('TForm1','Form1'),WM_CHAR,97,0);
end;
Result:=0;
end;
exports
CBTProc,
GetMsgProc;
begin
end.
Фрагмент проги
type
TForm1 = class(TForm)
SLV: TShellListView;
PM1: TPopupMenu;
View1: TMenuItem;
Icons1: TMenuItem;
List1: TMenuItem;
SmallIcons1: TMenuItem;
Bevel1: TBevel;
BB1: TBitBtn;
Timer1: TTimer;
BB2: TBitBtn;
Exit1: TMenuItem;
Color1: TMenuItem;
CD1: TColorDialog;
Folder1: TMenuItem;
OD1: TOpenDialog;
Password1: TMenuItem;
CB1: TComboBox;
L1: TLabel;
BB3: TButton;
Button2: TButton;
Close1: TMenuItem;
Timer2: TTimer;
procedure FormCreate(Sender: TObject);
procedure Icons1Click(Sender: TObject);
procedure List1Click(Sender: TObject);
procedure SmallIcons1Click(Sender: TObject);
procedure BB1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BB2Click(Sender: TObject);
procedure SLVContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure Color1Click(Sender: TObject);
procedure Folder1Click(Sender: TObject);
procedure Password1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
function ChangeLayout(LANG: Integer): Boolean;
procedure BB3Click(Sender: TObject);
procedure CB1Select(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure MyPanelClk(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
start: boolean;
procedure ChrHook(var Mes: TWMChar); message WM_CHAR;
procedure WM_MouseActivateEvent(var Mes : TWMMouseActivate); message WM_MouseActivate;
procedure AddPanel(var i: byte; hi: hicon; Activ: boolean);
public
root: boolean;
reg: tregistry;
psw: string;
rus: boolean;
end;
var
Form1: TForm1;
h, h1:hhook;
libhandle:HINST;
hkprcKeyboard: TFNHookProc;
MPanel: array of TPanel;
PanelCount: byte;
implementation
procedure TForm1.FormCreate(Sender: TObject);
const
RSP_SIMPLE_SERVICE=1;
var tmp: string;
i: integer;
hInstKernel: LongWord;
AdrRegSerProc: function (dwProcessId: dword; dwType: dword): dword; stdcall;
begin
// это я из панели задач убираю
hInstKernel := LoadLibrary ('KERNEL32.DLL');
if (hInstKernel<>0) then begin
@AdrRegSerProc:=GetProcAddress(hInstKernel, 'RegisterServiceProcess');
if (@AdrRegSerProc<>nil) then
AdrRegSerProc(0,RSP_SIMPLE_SERVICE);
FreeLibrary (hInstKernel);
end;
// тут вешаю хуки. все отлично, пока не дойдет до конца процедуры и тогда глюки. Если ProcCBT или GetMsgProc оставить один, то работает
libhandle:=LoadLibrary('hook.dll');
hkprckeyboard:=GetProcAddress(libhandle, 'GetMsgProc');
h:=SetWindowsHookEX(WH_GETMESSAGE,hkprckeyboard,libhandle,0);
hkprckeyboard:=GetProcAddress(libhandle, 'CBTProc');
h1:=SetWindowsHookEX(WH_CBT,hkprckeyboard,libhandle,0);
start:=true;
Exit1Click(sender);
start:=false;
// Дальше чтение из реестра исходных параметров и установка
формы и всякой билиберды, я это пропущу
PanelCount:=0;
end;
// Эта фигня для обратной связи хука проц GetMsgProc с формой
procedure TForm1.ChrHook(var Mes: TWMChar);
begin
if mes.CharCode=97 then
if CB1.ItemIndex=0 then begin
cb1.ItemIndex:=1;
rus:=false;
end else begin
cb1.ItemIndex:=0;
rus:=true;
end;
end;
// Там еще много всякой фигни которая к хукам не имеет отношения
|
| | |
Кидаю 05.06.03 18:02
Автор: Cyril <sc> Статус: Member
|
Посмотрел я на твою DLL и не понравилась она мне
ни в одном обработчике не вызывается CallNextHookEx, что ни есть хорошо
Попробуй так(сделал из шаблона библиотеки для перехвата сообщений от клавиатуры, которую когда то нашел в бескрайних просторах инета)
//Библиотека
Library HookDLL;
Uses
Windows, Messages, SysUtils;
Const
GlobMapID = 'Global Hook Demo {29E254C1-94E6-4D0F-989E-5CBD8DDBAE88}';
Type
PShareInf = ^TShareInf;
TShareInf = Record
AppWndHandle: HWND;
OldHookHandleMsg: HHOOK;
OldHookHandleCBT: HHOOK;
hm:THandle;
End;
Var
MapHandle: THandle = 0;
ShareInf: PShareInf = nil;
ptr:PByteArray;
Procedure DLLEntryPoint(dwReason: DWORD); stdcall;
Begin
Case dwReason Of
DLL_PROCESS_ATTACH:
Begin
MapHandle:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TShareInf), GlobMapID);
ShareInf:=MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TShareInf));
End;
DLL_PROCESS_DETACH:
Begin
UnMapViewOfFile(ShareInf);
CloseHandle(MapHandle);
End
End;
End;
Function MessageHook(Code: Integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT;stdcall;
var
pp: ^MSG;
begin
pp:=pointer(ParamL);
if (pp.message=274) then pp.message:=0;
if (pp.message=80) then SendMessage(ShareInf^.AppWndHandle, WM_CHAR, 97, 0);
Result := CallNextHookEx(ShareInf^.OldHookHandleMsg, Code, ParamW, ParamL)
End;
Function CBTHook(Code: Integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT;stdcall;
var
pp: ^MSG;
begin
if Code = HCBT_ACTIVATE then SendMessage(ShareInf^.AppWndHandle, WM_CHAR, 98, 0);
Result := CallNextHookEx(ShareInf^.OldHookHandleCBT, Code, ParamW, ParamL)
End;
Function SetCBTHook(Wnd: HWND): BOOL; stdcall;
Begin
If ShareInf<>Nil Then
Begin
ShareInf^.AppWndHandle:=Wnd;
ShareInf^.OldHookHandleCBT:=SetWindowsHookEx(WH_CBt, @CBTHook, HInstance, 0);
Result:=ShareInf^.OldHookHandleCBT<>0;
End
Else Result:=False
End;
Function SetMessageHook(Wnd: HWND): BOOL; stdcall;
Begin
If ShareInf<>Nil Then
Begin
ShareInf^.AppWndHandle:=Wnd;
ShareInf^.OldHookHandleMsg := SetWindowsHookEx(WH_GETMESSAGE, @MessageHook, HInstance, 0);
Result:=ShareInf^.OldHookHandleMsg<>0;
End
Else Result:=False
End;
Function RemoveMessageHook: BOOL; stdcall;
Begin
Result := UnhookWindowsHookEx(ShareInf^.OldHookHandleMsg);
CloseHandle(ShareInf^.hm);
End;
Function RemoveCBTHook: BOOL; stdcall;
Begin
Result := UnhookWindowsHookEx(ShareInf^.OldHookHandleCBT);
CloseHandle(ShareInf^.hm);
End;
Exports
SetMessageHook, RemoveMessageHook, SetCBTHook, RemoveCBTHook;
BEGIN
If DLLProc = Nil Then DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
END.
//Прога для тестирования
Unit Main;
INTERFACE
Uses
Windows, Messages, Classes, Controls, Forms, StdCtrls, Buttons,
dialogs;
Type
TMainForm = Class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
memo1: TListBox;
Procedure BitBtn1Click(Sender: TObject);
Procedure BitBtn2Click(Sender: TObject);
Private
Procedure WMChar(Var Message: TMessage); Message WM_CHAR;
Protected
End;
Var
MainForm: TMainForm;
IMPLEMENTATION
Uses SysUtils;
{$R *.DFM}
Function SetMessageHook(Wnd: HWND): BOOL; stdcall; external 'Hook.dll' name 'SetMessageHook';
Function RemoveMessageHook: BOOL; stdcall; external 'Hook.dll' name 'RemoveMessageHook';
Function SetCBTHook(Wnd: HWND): BOOL; stdcall; external 'Hook.dll' name 'SetCBTHook';
Function RemoveCBTHook: BOOL; stdcall; external 'Hook.dll' name 'RemoveCBTHook';
Procedure TMainForm.WMChar(var Message: TMessage);
Begin
if Message.WParam = 98 then Memo1.items.Add('activate')
else Memo1.items.Add('Layout changed');
End;
Procedure TMainForm.BitBtn1Click(Sender: TObject);
Begin
If SetMessageHook(handle) Then
showmessage('Enabled msg hook');
If SetCBTHook(handle) Then
showmessage('Enabled CBT hook');
End;
Procedure TMainForm.BitBtn2Click(Sender: TObject);
Begin
If NOT RemoveMessageHook Then
MessageBox(Handle, 'Unable to remove msghook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
If NOT RemoveCBTHook Then
MessageBox(Handle, 'Unable to remove cbthook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
End;
End.
---
|
| | | |
Поймал 06.06.03 09:34
Автор: ASJinx Статус: Незарегистрированный пользователь
|
Прикольно.
Спасибо, попробую подобным образом.
|
|
|