Library HookDLL;

Uses
  Windows, Messages, SysUtils;

Const
  GlobMapID = 'Global Hook Demo {29E254C1-94E6-4D0F-989E-5CBD8DDBAE88}';

Type
  PShareInf = ^TShareInf;
  TShareInf = Record
                AppWndHandle: HWND;
                OldHookHandleMsg: HHOOK;
                OldHookHandleCBT: HHOOK;
                hm:THandle;
              End;

Var
  MapHandle: THandle = 0;
  ShareInf: PShareInf = nil;
  ptr:PByteArray;

Procedure DLLEntryPoint(dwReason: DWORD); stdcall;
Begin
  Case dwReason Of
    DLL_PROCESS_ATTACH:
      Begin
        MapHandle:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TShareInf), GlobMapID);
        ShareInf:=MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TShareInf));
      End;
    DLL_PROCESS_DETACH:
      Begin
        UnMapViewOfFile(ShareInf);
        CloseHandle(MapHandle);
      End
  End;
End;

Function MessageHook(Code: Integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT;stdcall;
var
  pp: ^MSG;

begin
  pp:=pointer(ParamL);
  if (pp.message=274) then pp.message:=0;
  if (pp.message=80) then SendMessage(ShareInf^.AppWndHandle, WM_CHAR, 97, 0);
  Result := CallNextHookEx(ShareInf^.OldHookHandleMsg, Code, ParamW, ParamL)
End;

Function CBTHook(Code: Integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT;stdcall;
var
  pp: ^MSG;
begin
  if Code = HCBT_ACTIVATE then SendMessage(ShareInf^.AppWndHandle, WM_CHAR, 98, 0);
  Result := CallNextHookEx(ShareInf^.OldHookHandleCBT, Code, ParamW, ParamL)
End;

Function SetCBTHook(Wnd: HWND): BOOL; stdcall;
Begin
  If ShareInf<>Nil Then
    Begin
      ShareInf^.AppWndHandle:=Wnd;
      ShareInf^.OldHookHandleCBT:=SetWindowsHookEx(WH_CBt, @CBTHook, HInstance, 0);
      Result:=ShareInf^.OldHookHandleCBT<>0;
    End
  Else Result:=False
End;


Function SetMessageHook(Wnd: HWND): BOOL; stdcall;
Begin
  If ShareInf<>Nil Then
    Begin
      ShareInf^.AppWndHandle:=Wnd;
      ShareInf^.OldHookHandleMsg := SetWindowsHookEx(WH_GETMESSAGE, @MessageHook, HInstance, 0);
      Result:=ShareInf^.OldHookHandleMsg<>0;
    End
  Else Result:=False
End;

Function RemoveMessageHook: BOOL; stdcall;
Begin
  Result := UnhookWindowsHookEx(ShareInf^.OldHookHandleMsg);
  CloseHandle(ShareInf^.hm);
End;

Function RemoveCBTHook: BOOL; stdcall;
Begin
  Result := UnhookWindowsHookEx(ShareInf^.OldHookHandleCBT);
  CloseHandle(ShareInf^.hm);
End;


Exports
  SetMessageHook, RemoveMessageHook, SetCBTHook, RemoveCBTHook;


BEGIN
  If DLLProc = Nil Then DLLProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
END.

//Прога для тестирования
Unit Main;

INTERFACE

Uses
  Windows, Messages, Classes, Controls, Forms, StdCtrls, Buttons,
  dialogs;

Type
  TMainForm = Class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    memo1: TListBox;
    Procedure BitBtn1Click(Sender: TObject);
    Procedure BitBtn2Click(Sender: TObject);
    Private
    Procedure WMChar(Var Message: TMessage); Message WM_CHAR;
    Protected
  End;

Var
 MainForm: TMainForm;

IMPLEMENTATION
Uses SysUtils;
{$R *.DFM}

Function SetMessageHook(Wnd: HWND): BOOL; stdcall; external 'Hook.dll' name 'SetMessageHook';
Function RemoveMessageHook: BOOL; stdcall; external 'Hook.dll' name 'RemoveMessageHook';

Function SetCBTHook(Wnd: HWND): BOOL; stdcall; external 'Hook.dll' name 'SetCBTHook';
Function RemoveCBTHook: BOOL; stdcall; external 'Hook.dll' name 'RemoveCBTHook';


Procedure TMainForm.WMChar(var Message: TMessage);
Begin
  if Message.WParam = 98 then Memo1.items.Add('activate')
  else Memo1.items.Add('Layout changed');
End;

Procedure TMainForm.BitBtn1Click(Sender: TObject);
Begin
    If SetMessageHook(handle) Then
      showmessage('Enabled msg hook');

    If SetCBTHook(handle) Then
      showmessage('Enabled CBT hook');
End;

Procedure TMainForm.BitBtn2Click(Sender: TObject);
Begin
  If NOT RemoveMessageHook Then
    MessageBox(Handle, 'Unable to remove msghook', PChar(Application.Title), MB_OK OR MB_ICONHAND);

  If NOT RemoveCBTHook Then
    MessageBox(Handle, 'Unable to remove cbthook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
End;

End.

• [delphi] Хуки - ASJinx 02.06.03 14:38 [940]
  • а чего это оба твои хука обрабатываются одной и то... - Killer{R} 04.06.03 20:26 [1198]
  • [delphi] Хуки - Cyril 04.06.03 19:42 [1474]
    • Кидаю - ASJinx 05.06.03 12:39 [1377]
      • Кидаю - Cyril 05.06.03 18:02 [1375]
        • Поймал - ASJinx 06.06.03 09:34 [1164]