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:
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 pCWPR: PCWPRetStruct; PID: DWORD; begin Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
if (nCode < HC_ACTION) then Exit;
pCWPR := PCWPRetStruct(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
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)