キーフックについて再度質問 (ID:26519)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

キーフックについて、再度質問させていただきます。

やりたいことは、グローバルキーフックを行い、例えばメモ帳で何かキーが押されたら「あいうえお」と入力させる、などをしたいのです。
そこで、それを実現するため次のようなコードを書いてみました。
雛形として以前ここで質問にお答え頂いたMr.XRAYさんのコードを元とさせて
いただいていますm(_)m

------------------------------DLLのコード----------------------------

library KeyHook;

uses
  Windows,SysUtils,
  Messages;

var
   hHookCallWndProc:integer;
   MainFormHandle: THandle;

//===================================================================
//  フックのコールバック関数
//  このDLLを使用したアプリにキーコードを送る。
//  メッセージIDはWM_APP+100を使用。
//===================================================================
function KeyWndProc(nCode:integer;wParam:integer;lParam:integer):
         integer; stdcall;
begin
     if nCode < 0 then begin
       Result := CallNextHookEx(hHookCallWndProc, nCode, wParam, lParam);
     end else begin;
       Result := CallNextHookEx(hHookCallWndProc, nCode, wParam, lParam);
       if nCode=HC_ACTION then begin
          Result:=-1;
          MainFormHandle := FindWindow('TForm1',nil); //（念のため）
          if lParam > 0 then //キーを押したとき
            PostMessage(MainFormHandle,WM_APP+100,Wparam,0); 
       end;
     end;
end;
//===================================================================
//  フック関数の登録
//  登録するフック関数はKeyBoardProc
//===================================================================
function  StartKeyHook(AppHandle:THandle): Boolean; stdcall;
var
  Ret:Integer;
begin
  MainFormHandle := AppHandle;
  Result:=False;
  Ret:=SetWindowsHookEx(WH_KEYBOARD,@KeyWndProc,HInstance,0);
  if Ret=0 then Exit else hHookCallWndProc:=ret;
  Result:=True;

end;
//===================================================================
//  フックの解除
//===================================================================
procedure StopKeyHook; stdcall;
begin
     UnhookWindowsHookEx(hHookCallWndProc);
end;
//===================================================================
//  外部からDLL内のメソッドを利用可能にするためのオマジナイ
//===================================================================
exports
      StartKeyHook,
      StopKeyHook;
begin

end.

--------------------------プログラムのコード-------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WndProc(var msg: TMessage);override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

function StartKeyHook(Wnd: HWND): Boolean; stdcall; external 'KeyHook.dll';
procedure StopKeyHook; stdcall; external 'KeyHook.dll';

var
   hHookLib    : THANDLE;
   HookFlag    : Boolean;

{$R *.DFM}

//===================================================================
//  本Form破棄の時にはフックを解除
//===================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
     StopKeyHook;
     FreeLibrary(hHookLib);
end;
//===================================================================
//  Application側でメッセージ通知を受取る
//  ここではフォームのWndProcメソッドを使用
//  キーを感知したらアクティブウィンドウに「あいうえお」を送る。
//===================================================================
procedure TForm1.WndProc(var msg: TMessage);
begin
     if (msg.Msg=WM_APP+100) then begin

//★★★★★
      StopKeyHook;
      Keybd_event(Byte('A'),0,0,0);
      Keybd_event(Byte('A'),0,KEYEVENTF_KEYUP,0);
      Keybd_event(Byte('I'),0,0,0);
      Keybd_event(Byte('I'),0,KEYEVENTF_KEYUP,0);
      Keybd_event(Byte('U'),0,0,0);
      Keybd_event(Byte('U'),0,KEYEVENTF_KEYUP,0);
      Keybd_event(Byte('E'),0,0,0);
      Keybd_event(Byte('E'),0,KEYEVENTF_KEYUP,0);
      Keybd_event(Byte('O'),0,0,0);
      Keybd_event(Byte('O'),0,KEYEVENTF_KEYUP,0);
      StartKeyHook(Form1.Handle);
      //★★★★★

end;
     inherited WndProc(msg);
end;
//===================================================================
//  キーフックを有効にする
//===================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
     HookFlag :=False;
     try
       if hHookLib=0 then hHookLib := LoadLibrary('TabKeyHook.dll');
       StartKeyHook(Form1.Handle);
     except
     end;
end;
//===================================================================//  キーフックを無効にする
//===================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
     StopKeyHook;
end;

end.

以上、これで実行しメモ帳でキーを押すとどうもprocedure TForm1.WndProc(var msg: TMessage);
がループされているかのようにキャレットが固まってフリーズするような感じに
なってしまいます。

★★★で囲まれた部分を、beepとかshowmessageに変えてやれば、キーボードを押した時に
普通に一回それらが出て終わりなので、その部分以外は特に問題無いようです。
また、★の中で、StartKeyHook(Form1.Handle);を除いてそこで止めてしまえば
一回きりですが変換は上手く行くようです。

色々考えたのですが、どうしても分からずここで手が詰まっています。。
どなたかお分かりの方、宜しくお願いします。

←解決時は質問者本人がここをチェックしてください。

戻る