I saw that some brothers said that Hook under delphi didn't do it, so I didn't do every hook in Delphi. I didn't have any problems, and the way to deal with it is more novel. Let's let the brothers discuss, about hook problems, I don't understand, I will do it, but I have only made a framework, there is no specific practical role, the brothers who have to do have perfected, huh, huh, the code is here, since it is awkward ........ .. ------------------------------------------ My contact method: OiCQ; 10772919 e-mail: njhck@21cn.com Homepage: Hotsky.363.net --------------------------------------------------------------------------------------------------------------------------------------------------- ------------- ---------- This is the unit in * .dll --------------- Unit hookProc; Interface uses windows, messages, sysutils; const HTName: array [1..13] of pchar = ( 'CALLWNDPROC', 'CALLWNDPROCRET', 'CBT', 'DEBUG', 'GETMESSAGE', 'JOURNALPLAYBACK', 'JOURNALRECORD', ' KEYBOARD ',' MOUSE ',' MSGFILTER ',' SHELL ',' SYSMSGFILTER ',' FOREGROUNDIDLE '); function CallWndProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function CallWndRetProc (nCode: integer ; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function CBTProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function DebugProc (nCode: integer; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall; function GetMsgProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function JournalPlaybackProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function JournalRecordProc (nCode : integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function KeyboardProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function MouseProc (nCode: integer; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall; function MessageProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function ShellProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function SysMsgProc (nCode : integer;
wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; function ForegroundIdleProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; implementation procedure SaveInfo (k: integer; str: string); stdcall; var f : textfile; WorkPath: string; begin WorkPath: = ExtractFilePath (ParamStr (0)); assignfile (f, WorkPath 'Records.txt'); if fileexists (WorkPath 'Records.txt') = false then rewrite (f) else append (f); // if strcomp (PCHAR (STR), PCHAR ('# 13 # 10')) = 0 THEN WRITELN (f, '') // Else Write (f, str); Writeln (f, htname " K] '----' Str); Closefile (f); end; function callwndproc (ncode: integer; wparam: wparam; lparam: lparam): LRESULT; stdcall; var pcs: tcwstruct; begin pcs: = tcwstruct (PCWPStruct (LPARAM) ^; if ncode> = 0 Then Begin if pcs.Message = WM_LButtonup Then SaveInfo (1, Format ('hwnd =% x', [pcs.hwnd])); End; Result: = CallNexthookex 0, NCODE, WPARAM, LPARAM; end; // function callwndretproc (ncode: integer; wparam: wparam; lparam: lparam): Lresult; StdCall; Begin Result: = CallNexthookex (0, ncode, wparam, lparam); // fu nction CBTProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function DebugProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function GetMsgProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var pcs : TMSG; Begin PCS: = TMSG (PMSG (LPARAM) ^); if ncode> = 0 THEN BEGIN IF PCS.MESSAGE = WM_LBUTTONUP THEN SaveInfo (5, Format ('hWnd =% x', [pcs.hwnd])) End; Result: = CallNexthookex (0, Ncode, WPARAM, LPARAM);
// function JournalPlaybackProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function JournalRecordProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function KeyboardProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function MouseProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam , lParam); end; // function MessageProc (nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function ShellProc ( nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin Result: = CallNextHookEx (0, nCode, wParam, lParam); end; // function SysMsgProc (nCode: integer; wParam: WPARAM; lParam: LPARAM : LRESULT; STDCALL; Begin Result: = CallNexthookex (0, Ncode, WPARAM, LPA RAM); end; // function foregroundidiProc (ncode: integer; wparam: wparam; lparam: lparam): LRESULT; stdcall; begin Result: = CallNexthooKex (0, ncode, wparam, lparam); end; end; ---- This is the * .dll master ------------------ Library DemoHOK; Uses Windows, Messages, Sysutils, HookProc in 'hookproc.pas'; {$ R * .res} const HookMemFileName = 'DllHookMemFile.DTA'; HTName: array [1..13] of pchar = ( 'CALLWNDPROC', 'CALLWNDPROCRET', 'CBT', 'DEBUG', 'GETMESSAGE', 'JOURNALPLAYBACK', 'JournalRecord', 'Keyboard', 'Mouse', 'Msgfilter', 'Shell', 'Sysmsgfilter', 'ForegroundIdle'); Type ThookProc = Function (Ncode: Integer;
wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; PShared = ^ TShared; THook = record HookHand: HHook; HookType: integer; HookProc: THookProc; end; TShared = record Hook: array [0..16] of THook; Father, Self: Integer; hinst: integer; end; twin = record msg: tmsg; wclass: twwndclass; hmain: integer; end; var mefile: THANDE; shared: pshaed; win: twin; wmhook; cinte; procedure SaveInfo (k: integer; str: string); stdcall; var f: textfile; WorkPath: string; begin WorkPath: = ExtractFilePath (ParamStr (0)); assignfile (f, WorkPath 'Records.txt'); if fileexists ( Workpath 'Records.txt') = false The Rewrite (f) else append (f); // if strcomp (pchar (str), pchar ('# 13 # 10')) = 0 Then Writeln (f, '') // else Write (F, Str); Writeln (f, HTName [K] "--- ' str); Closefile (f); end; procedure IITHOOKDATA; VAR K: Integer; begin with shared ^ do Begin Fork: = 0 to 14 do hook [k] .hook: = 0; // hook [0] .hookType: = wh_callwndproc; hook [0] .hookProc: = @ CallWndProc; // hook [1]. HookType: = wh_callwndprocret; hook [1] .hookProc: = @ CallwndretProc; // hook [2] .hookType: = wh_cbt; hook [2] .hookProc: = @ CBTProc; // hook [3] .hookType: = wh_debug Hook [3] .hookProc: = @ DebugProc; // hook [4] .hookType: = wh_getMessage; hook [4] .hookProc: = @ getmsgproc; // hook [5] .hookType: = wh_journalplayback; hook [5 ] .HookProc: = @ JournalPlaybackProc; // Hook [6] .HookType: = WH_JOURNALRECORD; Hook [6] .HookProc: = @ JournalRecordProc; // Hook [7] .HookType: = WH_KEYBOARD; Hook [7] .HookProc: @ @ KeyboardProc; // hook [8] .hookType: =
WH_Mouse; hook [8] .hookProc: = @ mouseproc; // hook [9] .hookType: = wh_msgfilter; hook [9] .hookProc: = @ MessageProc; // hook [10] .hookType: = wh_shell; hook [ 10] .hookProc: = @ shellproc; // hook [11] .hookType: = wh_sysmsgfilter; hook [11] .hookProc: = @ sysmsgproc; // hook [12] .hookType: = wh_ForeGroundIdle; hook [12] .hookproc : = @ ForegroundIdleProc; end; end; function SetHook (fSet: boolean; HookId: integer): bool; stdcall; begin with shared ^ do if fSet = true then begin if Hook [HookId] .HookHand = 0 then begin Hook [HookId ] .HookHand: = SetWindowsHookEx (Hook [HookId] .HookType, Hook [HookId] .HookProc, hinstance, 0); if Hook [HookId] .HookHand <> 0 then Result: = true else Result: = false; end else Result : = true; end else begin if Hook [HookId] .HookHand <> 0 then begin if UnhookWindowsHookEx (Hook [HookId] .HookHand) = true then begin Hook [HookId] .HookHand: = 0; Result: = true; end else Result: = false; end else result: = true; end; end; procedure ex tro; begin UnmapViewOfFile (Shared); CloseHandle (MemFile); end; function WindowProc (hWnd, Msg, wParam, lParam: longint): LRESULT; stdcall; var k: integer; begin Result: = DefWindowProc (hWnd, Msg, wParam, LPARAM); Case MSG of WM_DESTROY: Begin for K: = 0 to 12 do selected (False, K); PostMessage (FindWindow ('WinHook', NIL), WM_DESTROY, 0, 0); EXITTHREAD (0); end; ; If msg = wmhook kilnness ing wparam> 0 THEN BEGIN IF STHOOK (TRUE, WPARAM-1) = True Then PostMessage (FindWindow ('WinHook', NIL), WMHOK, WPARAM, 0); Else Begin IF STHOOK (False , -wparam-1) =
True Then PostMessage (Findwindow ('WinHook', NIL), WMHOK, WPARAM, 0); End; End; End; Procedure Run; stdcall; // var k: integer; begin win.wclass.lpfnwndproc: = @windowproc; win .wClass.hInstance: = hInstance; win.wClass.lpszClassName: = 'WideHook'; RegisterClass (win.wClass); win.hmain: = CreateWindowEx (ws_ex_toolwindow, win.wClass.lpszClassName, 'WideHook', WS_CAPTION, 0,0 , 1, 1, 0, 10, hinstance, nil); Fillchar (Shared ^, Sizeof (Tshared), 0); Shared ^ .self: = win.hmain; Shared ^ .hinst: = Hinstance; INITHOKDATA; WMHOOK: = RegisterWindowMessage (Pchar ('WM_HOOK')); While (GetMsg, Win.hmain, 0, 0)) DO Begin TranslateMessage (Win.MSG); DispatchMessage (win.msg); end; end; procedure dllenTryPoint fdwReason: DWORD); begin case fdwReason of DLL_PROCESS_DETACH: Extro; end; end; exports run; begin // establish a memory image file used to save the global variable memFile: = CreateFileMapping ($ FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf ( Tshared), hookmemfilename; shared: = mappviewoffile (Memfile, File_Map_Write, 0, 0, 0); DLLPROC: = @ DLLENTRYPOINT; END. -------- This is * .exe main program --------------------------- Program Winhook; Uses Windows, Messages, Sysutils; {$ r * .res} // Use resource file const htname: array [1..13] of pchar = ('CallWndProc', 'CallWndProcret', 'CBT', 'Debug', 'GetMessage', 'Journalplayback ',' JOURNALRECORD ',' KEYBOARD ',' MOUSE ',' MSGFILTER ',' SHELL ',' SYSMSGFILTER ',' FOREGROUNDIDLE '); type TWin = record Msg: TMsg; wClass: TWndClass; hMain: integer; hbut, hlab : array [1..16] of integer; hlib: integer; hookstat: array [1..16] of bool; end; var win: twin; // Structural Variable WMHOOK: INTEGER;
WorkPath: string; hRun: procedure; stdcall; // procedure runhookfun; begin win.hlib: = loadlibrary (pchar (WorkPath 'DemoHook.dll')); if win.hlib = 0 then messagebox (win.hmain, 'error' , '', 0); hrun: = getProcaddress (win.hlib, 'run'); if @hrun <> nil dam; end; procedure runhook; var Tid: integer; begin createthread (nil, 0, @ runhookfun, nil, 0, tid); end; function WindowProc (hWnd, Msg, wParam, lParam: longint): LRESULT; stdcall; var k: integer; begin case Msg of WM_SYSCOMMAND: begin case wparam of SC_CLOSE: begin if findwindow ( 'WideHook ',' Widehook ') <> 0 THEN PostMessage (FindWindow (' Widehook ',' Widehook "), WM_DESTROY, 0, 0); End; // ShowWindow (HWND, SW_HIDE); SC_MINIMIZE:; // ShowWindow (hwnd, SW_HIDE); SC_Maximize :; SC_Default :; SC_MOVE :; SC_SIZE:: // Else // Result: = DefWindowProc (HWND, UMSG, WPARAM, LPARAM); END; EXIT; End; WM_Command: Begin fork: = 1 To 13 Do Begin IF (LParam = Win.HBUT [K]) AND ((k = 6) OR (k = 7)) Then Break; if lparam = win.hbut [k] the beginning "), WMHOOK, K, 0) Else PostMessage (FindWindow ('Widehook" (FindWindow) ',' Widehook '), WMHOK, -K, 0); end; end; end; wm_destroy: Begin Freelibrary (win.hlib); Halt; End; End; IF msg = wmhook kilinc ing wparam> 0 THEN BEGIN SETWINDOWTEXT (win.hbut [wparam], pchar ('stop')); win.hookstat [wparam]: = true; end else begin setWindowText (win.hbut [-wparam], pchar ('start'));
