Entwickler-Ecke

Windows API - WH_CALLWNDPROCRET - Nicht global und falsche Messages :-/


GTA-Place - Sa 06.01.07 17:43
Titel: WH_CALLWNDPROCRET - Nicht global und falsche Messages :-/
Hallo!

Ich bin jetzt schon seit Stunden am rumprobieren, hab alle möglichen russischen Seiten bei Google abgegrasst, MSDN durchgewählzt und was weiß ich, aber es funktioniert nicht wie es soll (es soll die Messages loggen).

Meine DLL:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
library WinLogDll;

uses
  SysUtils,
  Classes,
  Windows,
  Messages,
  DateUtils,
  Dialogs;

{$R *.res}

type
  TEntry = record
    ID:    UINT;
    aTime: TDateTime;
    PID:   DWORD;
  end;

  TCBack = procedure(MsgId: UINT; PID: DWORD); stdcall;

var
  Delay:   Integer;
  Entries: Array of TEntry;
  CBack:   TCBack;
  OwnPID:  DWord;

  HookHandle: Cardinal = 0;


procedure SetDelay(Val: Integer);
begin
  Delay := Val;
end;

function LastEntry(Msg: UINT; PID: DWORD): Integer;
var
  X: Integer;
begin
  Result := Delay;

  for X := 0 to Length(Entries) - 1 do
    if (Entries[X].ID = Msg) AND (Entries[X].PID = PID) then
      Result := SecondsBetween(Now, Entries[X].aTime);
end;

function CallWndRetProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  // pHdr:  PNMHdr;
  pCWPR: PCWPRetStruct;
  // pTest: PEventMsg;
  PID:   DWORD;
begin
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);

  if (nCode < HC_ACTION) then
    Exit;

  // pTest := PEventMsg(lParam);

  pCWPR := PCWPRetStruct(lParam);
  // pHdr  := PNMHdr(pCWPR^.lParam);

  GetWindowThreadProcessId(pCWPR^.hwnd, @PID);

  if (OwnPID = PID) then
    Exit;

  if (LastEntry(pCWPR^.message, PID) >= Delay) then
  begin
    if Assigned(CBack) then
      CBack(pCWPR^.message, PID);

    SetLength(Entries, Length(Entries) + 1);

    Entries[High(Entries)].ID    := pCWPR^.message;
    Entries[High(Entries)].aTime := Now;
    Entries[High(Entries)].PID   := PID;
  end;
end;

function InitHook(aCBack: TCBack; PID: DWord): Boolean; stdcall;
begin
  Result := False;

  if HookHandle = 0 then
  begin
    CBack  := aCBack;
    Delay  := 300;
    OwnPID := PID;

    HookHandle := SetWindowsHookEx(WH_CALLWNDPROCRET, @CallWndRetProc, HInstance, 0);

    Result := True;
  end;
end;

function UnInitHook: Boolean; stdcall;
begin
  Result := False;

  if HookHandle <> 0 then
  begin
    UnhookWindowsHookEx(HookHandle);
    HookHandle := 0;

    Result := True;
  end;
end;

procedure ResetEntries;
begin
  SetLength(Entries, 0);
end;

exports
  SetDelay, InitHook, UnInitHook, ResetEntries;

end.

Ich hab hier mal pTest stehen lassen, weil bei einem WH_JOURNALRECORD-Hook alles wunderbar läuft. Absolut keine Probleme. Er ruft CBack nur auf, wenn die Message an ein fremdes Programm gerichtet ist und die übergebene PID stimmt dann auch.

Aber sobald ich WH_CALLWNDPROCRET verwende, läuft gar nichts mehr. Entweder hängt sich das Programm auf oder es passiert gar nix (immer wenn ich diese "if PID = OwnPID then"-Prüfung habe, passiert gar nichts mehr -> nicht global?!). Wenn mal was aufgelistet wird, sind auch Messages mit unbekanntet Message-ID dabei, usw.

Das ist zum Verzweifeln. Vielleicht weiß hier einer von euch Rat.

Grüße
GTA-Place


GTA-Place - So 07.01.07 21:14

Na, wo sind die Pros wie uall@ocg, BenBe oder auch delfiphan - Tino natürlich auch ;-).


GTA-Place - Fr 02.02.07 15:54

Push nach 25 Tagen.