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. |