求键盘钩子函数（需完整代码）

Question

功能如下：
BUTTON中用shellExecuteEx启动一个进程（test.exe）
钩子函数能记录test.exe的所有键盘操作，并能发送键盘消息给test.exe贴完整代码的哥们50分，up有分

Answer 1

unit HookKey_Unit;interface
 uses windows,messages;
const
  WM_HOOKKEY = WM_USER + $1000;
  procedure HookOn; stdcall;
  procedure HookOff;  stdcall;
implementation
var
  HookDeTeclado     : HHook;
  FileMapHandle     : THandle;
  PViewInteger      : ^Integer;function CallBackDelHook( Code    : Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;begin
   if code=HC_ACTION then
   begin
    FileMapHandle:=OpenFileMapping(FILE_MAP_READ,False,'TestHook');
    if FileMapHandle<>0 then
    begin
      PViewInteger:=MapViewOfFile(FileMapHandle,FILE_MAP_READ,0,0,0);
      PostMessage(PViewInteger^,WM_HOOKKEY,wParam,lParam);
      UnmapViewOfFile(PViewInteger);
      CloseHandle(FileMapHandle);
    end;
  end;
  Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;procedure HookOn; stdcall;
begin
  HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, CallBackDelHook, HInstance , 0);
end;procedure HookOff;  stdcall;
begin
  UnhookWindowsHookEx(HookDeTeclado);
end;
end.       

Answer 2

unit TestHookKey_Unit;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;const
  WM_HOOKKEY= WM_USER + $1000;
  HookDLL       = 'Key.dll';
type
  THookProcedure=procedure; stdcall;
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FileMapHandle  : THandle;
    PMem     : ^Integer;
    HandleDLL      : THandle;
    HookOn,
    HookOff        : THookProcedure;
    procedure HookKey(var message: TMessage); message  WM_HOOKKEY;  public
    { Public declarations }
  end;
var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.ReadOnly:=TRUE;
  Memo1.Clear;
  HandleDLL:=LoadLibrary( PChar(ExtractFilePath(Application.Exename)+
                                HookDll) );
  if HandleDLL = 0 then raise Exception.Create('未发现键盘钩子DLL');
  @HookOn :=GetProcAddress(HandleDLL, 'HookOn');
  @HookOff:=GetProcAddress(HandleDLL, 'HookOff');
  IF not assigned(HookOn) or
     not assigned(HookOff)  then
     raise Exception.Create('在给定的 DLL中'+#13+
                            '未发现所需的函数');  FileMapHandle:=CreateFileMapping( $FFFFFFFF,
                              nil,
                              PAGE_READWRITE,
                              0,
                              SizeOf(Integer),
                              'TestHook');   if FileMapHandle=0 then
     raise Exception.Create( '创建内存映射文件时出错');
   PMem:=MapViewOfFile(FileMapHandle,FILE_MAP_WRITE,0,0,0);
   PMem^:=Handle;
   HookOn;
end;
procedure TForm1.HookKey(var message: TMessage);
var
   KeyName : array[0..100] of char;
   Accion      : string;
begin
  GetKeyNameText(Message.LParam,@KeyName,100);
  if ((Message.lParam shr 31) and 1)=1
      then Accion:='Key Up'
  else
  if ((Message.lParam shr 30) and 1)=1
      then Accion:='ReKeyDown'
      else Accion:='KeyDown';
  Memo1.Lines.add( Accion+
                      ': '+
                      String(KeyName)) ;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
 if Assigned(HookOff) then
     HookOff;
 if HandleDLL<>0 then
  FreeLibrary(HandleDLL);
  if FileMapHandle<>0 then
  begin
    UnmapViewOfFile(PMem);
    CloseHandle(FileMapHandle);
  end;end;end.

Answer 3

挂系统hook如
……
function KeyboardHookCallBack(Code: integer; Msg: WPARAM;
                              KeyboardHook: LPARAM): LRESULT; stdcall;
begin
  ...//你的代码放在这里
  Result := CallNextHookEx(whKeyboard,Code,Msg,KeyboardHook);
end;
……
whKeyboard := SetWindowsHookEx(WH_KEYBOARD,KeyboardHookCallBack,
                               GetModuleHandleFromInstance,
                               GetCurrentThreadID);
……