フックしたキーコードをAppで受け取るには？

解決

RITSU 2007-05-25 02:12:43 No: 26253

DLLを用いたグローバルフックで、特定のキーを無効にすることは出来たのですが
そのキーコードを、DLLを呼び出したプログラムへ送る方法が上手くいきません。

コールバック関数を使い、DLLの方からUnit1の関数を使えるようにし、そこに
キーコードを乗っけて送ってやれば良いと思ったのですが、どうも、DLLの中の
キーフックをしているフィルタ関数の中にそれを書く（つまりコールバックの
二階建て）とするとそれが作動してくれないようです。
そのフィルタ関数の外に書けば、普通にそのコールバック関数は作動してくれます。

以下、プログラムの抜粋です。

(DLL側)

Type
TTestSound = procedure;stdcall;
var
TestSound:TTestSound;

function CallbackSomeFunc(Addr:Pointer):boolean;stdcall;
begin
  result := false;
  if Addr = NIL then exit;
  @TestSound := Addr;
  result := true;
end;

//Tabボタンを効かなくさせる
Function KeyWndProc(nCode:Integer; wParam:WPARAM;
lParam:LPARAM):LRESULT;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
      Case Wparam of
        VK_TAB:
          begin
            Result:=-1;
            TestSound; //★ここにコールバック関数を記述
          end;
      End;
    End;
  End;
End;

Function InstallCallWndProcHook:Boolean;
var
  Ret:Integer;
begin
  Result:=False;
  Ret:=SetWindowsHookEx(WH_KEYBOARD,@KeyWndProc,HInstance,0);
  if Ret=0 then Exit else hHookCallWndProc:=ret;
  Result:=True;
end;

(App側)

//音を鳴らすだけのコールバック関数
procedure TSound;stdcall;
begin
beep;
end;

//DLLへ登録
procedure TForm1.Button1Click(Sender: TObject);
var
  hDLL: THandle;
  CallbackSomeFunc:function(Addr:Pointer):boolean;stdcall;
begin
  hDLL := LoadLibrary('KeyHook.dll');
  if hDLL <> 0 then
  begin
    @CallbackSomeFunc := GetProcAddress(hDLL,'CallbackSomeFunc');
    if @CallbackSomeFunc <> nil then
    begin
      CallbackSomeFunc(@TSound);
    end
    else
    begin
      showmessage('コールバック関数の登録に失敗しました');
    end;
    FreeLibrary(hDLL);
  end
  else
  begin
    showmessage('DLLがありません');
  end;
end;

このように記述すると、★の行がなければちゃんとTabが効かなくなるのですが、
★を追加することでbeepも鳴らなければTabまでフックされずにスルーされるように
なってしまうようです。

まだHookは勉強したてで、色々調べたのですがここで詰まってしまいました。
どなたかご存知の方、ご教授のほどお願い致します。

Mr.XRAY URL 2007-05-25 06:13:40 No: 26254

申し訳ありませんが，コードそのものについてはよくわかりませんが，
ウィンドウズのアプリはハンドルで判別できます．
そこで，キーフックを開始する時(フック関数のインストールですか?)に，
ハンドル値を渡して，DLL内で該当キーをフックした時に
PostMessageで，そのハンドル値(App)にキーの値を送るという方法は考える
ことができるのではないかと思います．
Case Wparam of
VK_TAB:

となっていますから，WparamにそのままKeyの値を渡せます．

http://homepage2.nifty.com/Mr_XRAY/Delphi/plSamples/T_NumLockControlSelf.htm
ではWinProcでPostMessageのメッセージを受取っていますが，

procedure WMApp100(var Message: TMessage); message WM_APP+100;
というメソッドを定義して単独で受取ることも考えられます．

もっといい方法があるかも知れませんが，例ということで...

RITSU 2007-05-25 22:04:51 No: 26255

Mr.XRAY様

解答ありがとうございます。
なるほど、そのような簡単な方法があるのですね。HPも大変参考になりました。
さて、それでやってみたのですが、キーコードが送られてこないようです。
フックは問題無くされるのですが、Formの方には何も反応がありません。
どこかメッセージの受け渡しが上手く行っていないのだと思うのですが、見ていた
だけないでしょうか？
以下、それらの箇所の抜粋です。

（DLL側）

var
hHookCallWndProc:integer;
MainFormHandle: THandle;

Function KeyWndProc(nCode:Integer; wParam:WPARAM;lParam:LPARAM):LRESULT;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
      Case Wparam of
         VK_TAB:
            begin
              Result:=-1;
              PostMessage(MainFormHandle,WM_APP+100,Wparam,0); //★キーコードを送信★
            end;
      End;
    End;
  End;
End;

Function InstallCallWndProcHook(AppHandle:THandle):Boolean;stdcall;
var
  Ret:Integer;
begin
  Result:=False;
  Ret:=SetWindowsHookEx(WH_KEYBOARD,@KeyWndProc,HInstance,0);
  if Ret=0 then Exit else hHookCallWndProc:=ret;
  Result:=True;
  MainFormHandle := AppHandle; //★Form1のハンドルを受け取る★
end;

（APP側）

procedure TForm1.Button1Click(Sender: TObject);
begin
InstallCallWndProcHook(Form1.Handle);
end;

procedure TForm1.WndProc(var msg: TMessage);
begin
  if msg.Msg=WM_APP+100 then
    showmessage(inttostr(msg.wParam) +' キーはフックされています');
  inherited WndProc(msg);
end;

Mr.XRAY URL 2007-05-26 08:05:26 No: 26256

>見ていただけないでしょうか？

やれっ!! ということですね。

https://www.petitmonte.com/bbs/answers?question_id=4760
にあるように、
>この様な問題が発生した場合は，単純なコードで確認するのが定石です．
>つまり，問題の切り分けが必要です．
>ただ，この場合，必ず「新規作成」のプロジェクトで実験するのが常道です．

ということで、RITSU さんのコードをコピペして実行しました。
「9 キーはフックされています」
と表示されました。

実行確認環境(これも示すのが常識ですね)は先に紹介したサンプルプログラム
と同じです。

>以下、それらの箇所の抜粋です。

私は神様ではないので、RITSU さんがこの他にどんなコードを同時に実行して
いるかはわかりませんので、これ以上のアドバイスはできません。
抜粋しなければないない程のコード(長さ)ではないと思いますけどね。

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

//====================================================================
// キーフック用DLLの雛型
//====================================================================
library TabKeyHook;

uses
Windows,Messages;

var
hHookCallWndProc:integer; //好みの命名ではないけど...
MainFormHandle: THandle;

//====================================================================
//  フックのコールバック関数
//  このDLLを使用したアプリにキーコードを送る．
//  メッセージIDはWM_APP+100固定としているが，StartKeyHookの引数で外
//  部で決めてもよい．
//====================================================================
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
         case Wparam of
           VK_TAB:
           begin
             Result:=-1;
             PostMessage(MainFormHandle,WM_APP+100,Wparam,0); //★キーコードを送信★
           end;
         end;
       end;
     end;
end;
//====================================================================
//  フック関数の登録
//  登録するフック関数はKeyBoardProc
//  内部または外部とのやり取りに必要なら引数を追加して使用する
//====================================================================
function  InstallCallWndProcHook(AppHandle:THandle): Boolean; stdcall;
var
  Ret:Integer;
begin
  Result:=False;
  Ret:=SetWindowsHookEx(WH_KEYBOARD,@KeyWndProc,HInstance,0);
  if Ret=0 then Exit else hHookCallWndProc:=ret;
  Result:=True;
  MainFormHandle := AppHandle; //★Form1のハンドルを受け取る★
end;
//====================================================================
//  フックの解除
//====================================================================
procedure StopKeyHook; stdcall;
begin
     UnhookWindowsHookEx(hHookCallWndProc);
end;
//====================================================================
//  外部からDLL内のメソッドを利用可能にするためのオマジナイ
//====================================================================
exports
      InstallCallWndProcHook,
      StopKeyHook;
begin

end.

------------------- DLLを使用するプログラム ---------------------------

function InstallCallWndProcHook(Wnd: HWND): Boolean; stdcall; external 'TabKeyHook.dll';
procedure StopKeyHook; stdcall; external 'TabKeyHook.dll';

var
hHookLib : THANDLE;
HookFlag : Boolean;

//=============================================================================
//  本Fomr破棄の時にはフックを解除
//=============================================================================
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
       showmessage(inttostr(msg.wParam) +' キーはフックされています');
     end;
     inherited WndProc(msg);
end;
//=============================================================================
//  キーフックを有効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
     HookFlag :=False;
     try
       if hHookLib=0 then hHookLib := LoadLibrary('TabKeyHook.dll');
       InstallCallWndProcHook(Form1.Handle);
     except
     end;
end;
//=============================================================================
//  キーフックを無効にする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
     StopKeyHook;
end;

RITSU 2007-05-31 07:26:19 No: 26257

>Mr.XRAY様

丁寧な解説ありがとうございました。
返事が大変遅くなって申し訳ありません。

それで、どうもうちの環境（Delphi6pro + WinXPsp2）では、そのコードでは
どうしてもキーコードが送られてこないようでした。
それで原因を模索したところ、どうやらDLL内のグローバル変数MainFormHandle
が、フック関数（KeyWndProc）内では設定した値が空っぽ（=0）になって
しまうようです。

おそらく、Windowsからその関数が最初に呼び出されるのでDLL内の変数を
読んでくれないとかそんな感じなんだと思いますが・・
仕方ないので、その関数内でもう一度代入をしなおしてやったら上手く
受け渡すことが出来ました。

フックやハンドル操作自体良く知らなかったので、コードが悪いんだと
ばかり思い、これに気づくのに死ぬほど悩みました^^;

Mr.XRAY URL 2007-05-31 08:51:51 No: 26258

>それで、どうもうちの環境（Delphi6pro + WinXPsp2）では、そのコードでは
>どうしてもキーコードが送られてこないようでした。

これはとても重要な情報です．後で同様の疑問を持った方の参考になります．
私の示したコードは，私のテストした環境(WindowsXP(SP2)+ Delphi7 Pro)では
動作するが，Delphi6 Pro + WindowsXP(SP2)では，MainFormHandleをDLLに送っ
た時に0になってしまうということですね．

>おそらく、Windowsからその関数が最初に呼び出されるの

Form1(ハンドル)が確実に生成されてから，つまり，DLLの動作が正常かを確
認するために，わさわざBotton1Clickで行っているハズなんですが...

RITSU 2007-06-01 02:28:18 No: 26259

あ、正確にはDLLへのハンドルの受け渡しは出来ているのですが、それが
途中で消えてしまうという状況です。つまり、具体的には

① function InstallCallWndProcHook(AppHandle:THandle): Boolean; stdcall;

には、確かにForm1のハンドルを渡せているようで、その中では確かに
AppHandleに値が来ており、上のコードではグローバル変数MainFormHandleに
代入してますが、そこにちゃんと値が入っているのが確認されます。ですが

② function KeyWndProc(nCode:integer;wParam:integer;lParam:integer):
integer; stdcall;

の中では、MainFormHandleの値が消えてしまう、という状況です。
そこで、単純にintegerのグローバル変数をDLL内に作ってみて適当な値を
入れたところ、
同様に、①や他の場所では代入した値をちゃんと持っているのですが、
②の中でその変数を覗くと０になっている、というのが確認されました。
（上でも書きましたが、この関数②内でもう一度グローバル変数に値を代入
しなおしてやれば、その値を持ちます。）

最初は、上のコードの①内で
MainFormHandle := AppHandle; //★Form1のハンドルを受け取る★
の行が
Ret:=SetWindowsHookEx(WH_KEYBOARD,@KeyWndProc,HInstance,0);
の行より下にあるからかとも思ったのですが、それは関係ないようでした。

ちなみに、Delphi2007Pro+VistaHomeBasicでも同様の現象が見られました。
以上、こんな感じです。

TS 2007-06-01 02:51:11 No: 26260

やってみましたDelphi6 Pro  Delphi7 Pro  WindowsXP(SP2)
の環境です
追加したコードは下記のみです
private
    { Private 宣言 }
    procedure WndProc(var msg: TMessage);override;
いずれも「9 キーはフックされています」が表示されます。

TS 2007-06-01 03:09:55 No: 26261

RITSU さんの(1)と(2)にshowmessageを入れて表示させて見ましたが
私の環境ではどちらも同じMainFormHandleの値が出ます。
>②の中でその変数を覗くと０になっている、というのが確認されました。
どう言う方法で変数を覗かれるのでしょうか。

Mr.XRAY URL 2007-06-01 07:29:43 No: 26262

TSさん確認ありがとうございます．

>関数内でもう一度代入をしなおしてやったら上手く
ということですので，私の方は後で，どのような状況でRITSUさんと同じ動作
をするのかテストしてみるつもりです．
結果はサイトのサンプルプログラムのどこかに書く予定です．
いつになるかはわかりませんが．

RITSU 2007-06-01 09:20:10 No: 26263

お二方ともありがとうございます。

>どう言う方法で変数を覗かれるのでしょうか。

単純に、メッセージボックスに表示させて目で見てみました。
MessageBox(0, PChar(IntToStr(MainFormHandle)), PChar('ハンドル番号'), MB_OK);

また、補足ですが、上の②へとハンドルの受け渡しが出来ないので
どうやって解決させたかと言いますと、
MainFormHandle := FindWindow('TFormReceive',nil);
と②内でクラス名で直接指定しました。
とりあえず、私の目的では、呼び出し元は固定だったのでこれでも問題は
特にないです。

原因はいまだに良く分かりませんが・・
とりあえず私の方は問題は回避出来たので満足しています。
もし何か分かったらまた書きますね。
ご参考になれば幸いです。

Mr.XRAY URL 2007-06-11 08:06:54 No: 26264

その後、いろいろ考えてみましたが、どうもわかりません。
私の WindowsXP(SP2) + Delphi6 Pro では期待通りに動作します。

WindowsXP(SP2) + Delphi5 でも期待通り動作していますね。
私の場合。
この掲示板をご覧になる方の参考のため、一応報告しておきます。

Mr.XRAY URL 2007-06-11 08:09:44 No: 26265

>私の WindowsXP(SP2) + Delphi6 Pro では期待通りに動作します。

私のDelphi6 Pro は UP2 です。

RITSU 2007-06-12 08:54:03 No: 26266

他のスレでSHIMAPEEさんに教えて頂いた方法ですが、メモリマップドファイル
を使えばDLL内で変数の受け渡しが可能とのことです。

実際にやってみたらそれでハンドルの受け渡しが上手く行きました。

グローバル変数一行書くのに比べ、かなり長々と書かないと使えないですが
これが正式な方法のようです。参考にさせて頂いたサイトを以下に貼ってお
きます。

http://www2.biglobe.ne.jp/~sakai/usehook.htm

TS 2007-06-12 16:55:08 No: 26267

誤解があるといけませんので書きますが
プログラムの途中で勝手にグローバル変数が変われば
普通プログラムは成立しません。
どこかでこの変数を書き換えている可能性が有ると云うことです。
もしそれが無いなら特殊な環境と云うしか有りません。