{---------------------------------------------------------------------------
  KeyBoardメッセージをフックするためのDLL雛形サンプル
  for Delphi2.01J
  1997.09.08 Gen.Y.Sakai(mailto:ysakai@mars.dtinet.or.jp)

  Windowsから送られるWH_KEYBOARDメッセージを監視して呼び出しアプリへ
  フックした旨のメッセージおよびキーの仮想キーコードを送るためのDLLです。

  呼び出し方はTestKbdHook.DPR,TestKbdHookMain.pasを参照して下さい。

  コメント内でMMFはメモリマップドファイルの事です。
---------------------------------------------------------------------------}
unit KHMain;

interface

uses WinTypes, WinProcs, Messages, Classes, SysUtils;

type
  PHookInfo = ^THookInfo;    //共有メモリの内容にする構造体
  THookInfo = record
    hndHook  : HHook;
    HostWnd  : HWnd;
    MsgID    : Word;
  end;

var
  whileHooking : boolean;     //フック中フラグ
  hFileMapObj  : THandle;     //MMFのハンドル

const
  strRegKeyHook = 'This is Keyboard hook test'; //Hostへの通知メッセージ
  FMObjName     = 'KeyboardHookObjectName';     //MMFのファイル名
  DLLName       = 'KHDLL.DLL';                  //DLLの名前

//フックをインストール、アンインストール
function  SetHook(Wnd: HWnd): Boolean; export; stdcall;
procedure RemoveHook; export; stdcall;

//Windowsがコールバックできるように
function HookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM):
  LRESULT;stdcall;

//Application側にメッセージ通知用文字列を返す
function  GetHookMsgString:PChar; export; stdcall;


implementation

//--------------------------------------------------------------------
//Application側にメッセージ通知用文字列を返す
//--------------------------------------------------------------------
function GetHookMsgString:PChar; export; stdcall;
begin
  result := strRegKeyHook;
end;


//--------------------------------------------------------------------
//共有メモリアクセスのための準備と後始末
//--------------------------------------------------------------------
function GetFMObj(var h:THandle; var p:pointer):integer;
begin
  //MMFを開く
  h := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, FMObjName);
  if h = 0 then begin
    result := -1;
    Exit;
  end;

  //MMFの割り当て
  p := MapViewOfFile(h, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if p = nil then begin
    result := -2;
    CloseHandle(h);
    Exit;
  end;
  Result := 0;
end;

procedure ReleaseFMObj(h:THandle; p:Pointer);
begin
  if p <> NIL then    //MMFのビューを解除
    UnmapViewOfFile(p);
  if h <> 0 then      //MMFのハンドルを閉じる
    CloseHandle(h);
end;


//--------------------------------------------------------------------
//フック関数本体
//この関数の中にフック処理を記述します。下手をするとWindowsの再起動が
//必要になりますから、細心の注意を払って下さい。
//--------------------------------------------------------------------
function HookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
var
  _hFMObject: THandle;
  p         : Pointer;
  RS        : integer;
  LP        : LongInt;
begin
  RS := GetFMObj(_hFMObject, p);
  if RS <> 0 then begin
    //*** RSによってエラーハンドリングする場合はここに記述 ***
    exit;
  end;


  //フック情報(共有メモリ)へアクセス
  //-------------------------------------------------------------
  //フック関数の核の部分〜ここではキーボードの遷移状態が放される時
  //のみApplication側に仮想キーコードを送っている。キーを入れ替える
  //ような処理をするなら下の部分に書く。
  //ここから-----------------------------------------------------
  LP := lParam;
  if Code >=0 then begin
    if (LP shr 31) = 1 then begin
      with pHookInfo(p)^ do
        PostMessage(HostWnd, MsgID, wParam, lParam);
    end;
  end;
  //ここまで-----------------------------------------------------

  Result := CallNextHookEx(pHookInfo(p)^.hndHook, Code, wParam, lParam);

  //MMFマッピング解除、MMFハンドルクローズ
  ReleaseFMObj(_hFMObject, p);
end;


//--------------------------------------------------------------------
//フック関数の登録
//--------------------------------------------------------------------
function SetHook(Wnd: HWnd): Boolean;
var
  _hFMObject:  THandle;
  p:pointer;
  RS:integer;
begin
  Result := False;

  //MMF使用準備処理
  RS := GetFMObj(_hFMObject,p);
  if p = nil then begin
    _hFMObject := 0;
    Exit;
  end;

  //フック情報構造体初期化とフック関数の登録
  with pHookInfo(p)^ do begin
    HostWnd := Wnd;
    
    //キーボードフックをインストール
    hndHook := SetWindowsHookEx(WH_KEYBOARD, @HookProc, HInstance, 0);
  end;

  //アプリケーションへ通知するメッセージを登録
  pHookInfo(p)^.MsgID := RegisterWindowMessage(strRegKeyHook);
  if pHookInfo(p)^.MsgID = 0 then begin
    MessageBox(0 ,'Failed Creating Message!','KeyHookDLL',
               MB_OK or MB_ICONEXCLAMATION or MB_SETFOREGROUND) ;
    Exit;
  end;

    { ここのコメント部分をはずせばフックをインストールした時に
      Application側のウィンドウハンドルと、インストールしたフィ
      ルタ関数のハンドルを表示する。
    MessageBox(0 ,PChar(
              'Host Wnd : '+IntToStr(HostWnd)+#13#10+
              'hndHook  : '+IntToStr(hndHook)+#13#10)
              ,'KeyHookDLL',
               MB_OK or MB_ICONEXCLAMATION or MB_SETFOREGROUND) ;
    }

  //フック成功(フラグを立てておく)
  if pHookInfo(p)^.hndHook > 0 then begin
    whileHooking := true;
    Result := True;
  end;
  
  //MMF使用終了処理
  ReleaseFMObj(_hFMObject, p);
end;

//--------------------------------------------------------------------
//フックの開放
//--------------------------------------------------------------------
procedure RemoveHook;
var
  pMF: pHookInfo;
  _hFMObject:  THandle;
  p:pointer;
  RS:integer;
begin
  //MMF使用準備処理
  RS := GetFMObj(_hFMObject, p);
  if p = nil then begin
    _hFMObject := 0;
    Exit;
  end;

  //フック解除
  if whileHooking then
    UnhookWindowsHookEx(pHookInfo(p)^.hndHook);

  //MMF使用終了処理
  ReleaseFMObj(_hFMObject, p);
end;

//--------------------------------------------------------------------
//ユニット初期化部、終了処理部 〜 MMFの作成と破棄
//--------------------------------------------------------------------
initialization
begin
  whileHooking := false;
  //MMF作成
  hFileMapObj := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
                                   0, SizeOf(THookInfo), FMObjName);
  if hFileMapObj = 0 then begin
    MessageBox(0 ,'Failed FileMapping!','KeyHookDLL',
               MB_OK or MB_ICONEXCLAMATION or MB_SETFOREGROUND) ;
    Exit;
  end;
end;

finalization
begin
  //MMF開放
  if hFileMapObj = 0 then Exit;
  CloseHandle(hFileMapObj);
end;

end.