Hook?

Hvad vil du lave en hook på ?

http://delphi.about.com/sitesearch.htm?terms=hook

Stoney

lad os bare sige nå der bliver klikket med musen...

har kigget der inde.. men vil gerne have et eksempel hvis det var muligt kun i en fil osv osv som skrevet i starten

jeg laver et ekspempel til dig her om lidt ud fra deplhi.about.com  eksempel..

Det er IKKE muligt at lave et globalt Mouse Hook i een fil. Det kræver både en exe fil og en DLL fil !

Jens B

hmmm det var også keyboard jeg ville have lavet...

OK OK .. Det gør ingen forskel .. Et globalt hook ligger ALTID i en DLL fil ...

Jens B

ja men jeg har ikke snakket noget om et globalt hook...

nåååee .. Skal man også læse spørgsmålet ? Det kunne du bare have sagt ! :-)

INstaler de her komponenter og veend til bage når du har gjort det ...

unit hooks;

interface

Uses Windows,SysUtils,Classes,Controls;



Type
  THookMsg = Packed record
              Code  : integer;
              WParam : WPARAM;
              LParam : LPARAM;
              Result : LResult
            end;

Type
  THook = Class;
  THookMethod = procedure (var HookMsg: THookMsg) of object;
  THookNotify = procedure (Hook : THook; var Hookmsg: THookMsg) of object;

  THook = Class(TComponent)
  Private
    fHook              : hHook;
    fHookProc          : Pointer;
    fOnPreExecute      : THookNotify;
    fOnPostExecute      : THookNotify;
    fActive            : Boolean;
    fLoadedActive      : Boolean;
    fThreadID          : Integer;

    Procedure SetActive(NewState : Boolean);
    Procedure SetThreadID(NewID : INteger);
    Procedure HookProc(Var HookMsg : THookMsg);
  Protected
    Procedure PreExecute(Var HookMsg : THookMsg; Var Handled : Boolean); Virtual;
    Procedure PostExecute(Var HookMsg : THookMsg); Virtual;
    Function AllocateHook : hHook; Virtual; Abstract;
    Procedure Loaded; Override;
  Public
    Constructor Create(Owner : TComponent); Override;
    Destructor Destroy; Override;
    Property ThreadID : Integer Read fThreadID Write SetThreadID Stored False;
    Property Active : Boolean Read fActive Write SetActive;
    Property OnPreExecute : THookNotify  Read fOnPreExecute Write fOnPreExecute;
    Property OnPostExecute : THookNotify  Read fOnPostExecute Write fOnPostExecute;
  Published
  End;

Type
  TCallWndProcHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TCallWndProcRetHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TCBTHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TDebugHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TGetMessageHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TJournalPlaybackHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TJournalRecordHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TKeyboardHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TMouseHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TMsgHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TShellHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

Type
  TSysMsgHook = Class(THook)
  Private
  Protected
  Public
    Function AllocateHook : hHook; Override;
  Published
    Property Active;
    Property OnPreExecute;
    Property OnPostExecute;
  End;

function  MakeHookInstance (Method: THookMethod): pointer;
procedure FreeHookInstance (ObjectInstance: pointer);

Procedure Register;

implementation

const
  InstanceCount = 313;  // set so that sizeof (TInstanceBlock) < PageSize

type
  PObjectInstance = ^TObjectInstance;
  TObjectInstance = packed record
                      Code: Byte;
                      Offset: Integer;
                    case Integer of
                      0: (Next: PObjectInstance);
                      1: (Method: THookMethod);
                    end;
Type
  PInstanceBlock = ^TInstanceBlock;
  TInstanceBlock = packed record
                    Next: PInstanceBlock;
                    Code: array[1..2] of Byte;
                    WndProcPtr: Pointer;
                    Instances: array[0..InstanceCount] of TObjectInstance;
                  end;
var
  InstBlockList : PInstanceBlock  = nil;
  InstFreeList  : PObjectInstance = nil;

function StdHookProc (Code, WParam: WPARAM; LParam: LPARAM): LResult; stdcall; assembler;
asm
  XOR    EAX,EAX
  PUSH    EAX
  PUSH    LParam
  PUSH    WParam
  PUSH    Code
  MOV    EDX,ESP
  MOV    EAX,[ECX].Longint[4]
  CALL    [ECX].Pointer
  ADD    ESP,12
  POP    EAX
end;

{ Allocate a hook method instance }
function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeHookInstance(Method: THookMethod): Pointer;

const
  BlockCode: array [1..2] of Byte = ($59, $E9);
  PageSize = 4096;

var
  Block: PInstanceBlock;
  Instance: PObjectInstance;

begin
  if InstFreeList = nil then
  begin
    Block := VirtualAlloc (nil, PageSize, MEM_COMMIT,PAGE_EXECUTE_READWRITE);
    Block^.Next := InstBlockList;
    Move(BlockCode, Block^.Code, SizeOf(BlockCode));
    Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2],@StdHookProc));
    Instance := @Block^.Instances;
    repeat
      Instance^.Code := $E8;
      Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
      Instance^.Next := InstFreeList;
      InstFreeList := Instance;
      Inc(Longint(Instance), SizeOf(TObjectInstance));
    until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
    InstBlockList := Block
  end;
  Result := InstFreeList;
  Instance := InstFreeList;
  InstFreeList := Instance^.Next;
  Instance^.Method := Method
end;

{ Free a hook method instance }
procedure FreeHookInstance (ObjectInstance: Pointer);

Begin
  if ObjectInstance <> nil then
  Begin
    PObjectInstance(ObjectInstance)^.Next := InstFreeList;
    InstFreeList := ObjectInstance
  End
End;

Constructor THook.Create(Owner : TComponent);

Begin
  Inherited Create(Owner);
  fHookProc := MakeHookInstance(HookProc);
  fActive := false;
  fLoadedActive := False;
  fHook := 0;
  ThreadID := GetCurrentThreadID;
End;

Destructor THook.Destroy;

Begin
  Active := False;
  FreeHookInstance(fHookProc);
  Inherited;
End;

Procedure THook.SetActive(NewState : Boolean);

Begin
  If (csLoading in componentState) Then
  Begin
    fLoadedActive := NewState;
  End Else If (fActive<>NewState) Then
  Begin
    fActive := NewState;
    Case (Active And (Not (csDesigning In ComponentState))) Of
      True : Begin
              fHook := AllocateHook;
              If (fHook=0) Then
              Begin
                fActive := False;
                Raise Exception.Create(Classname+' CREATION FAILED!');
              End;
            End;
      False : Begin
                If (FHook<>0) Then UnhookWindowsHookEx(fHook);
                fHook := 0;
              End;
    End;
  End;
End;

Procedure THook.SetThreadID(NewID : INteger);

Var
  IsActive              : Boolean;

Begin
  IsActive := fActive;
  Active := False;
  fThreadID := NewID;
  Active := IsActive;
End;

Procedure THook.Loaded;

Begin
  Inherited;
  Active := fLoadedActive;
End;

Procedure THook.HookProc(Var HookMsg : THookMsg);

Var
  Handled              : Boolean;

Begin
  Handled := False;
  PreExecute(HookMsg,Handled);
  If Not Handled Then
  Begin
    with HookMsg do Result := CallNextHookEx (fHook, Code, wParam, lParam);
    PostExecute(HookMsg);
  End;
End;

Procedure THook.PreExecute(Var HookMsg : THookMsg; Var Handled : Boolean);

Begin
  If Assigned(fOnPreExecute) then
  Begin
    fOnPreExecute(Self,HookMsg);
  End;
End;

Procedure THook.PostExecute(Var HookMsg : THookMsg);

Begin
  If Assigned(fOnPostExecute) then
  Begin
    fOnPostExecute(Self,HookMsg);
  End;
End;

Function TCallWndProcHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx (WH_CALLWNDPROC, fHookProc, HInstance, ThreadID);
End;

Function TCallWndProcRetHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_CALLWNDPROCRET,fHookProc,hInstance,ThreadID);
End;

Function TCBTHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_CBT,fHookProc,hInstance,ThreadID);
End;

Function TDebugHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_DEBUG,fHookProc,hInstance,ThreadID);
End;

Function TGetMessageHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_GETMESSAGE,fHookProc,hInstance,ThreadID);
End;

Function TJournalPlaybackHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_JOURNALPLAYBACK,fHookProc,hInstance,ThreadID);
End;

Function TJournalRecordHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_JOURNALRECORD,fHookProc,hInstance,ThreadID);
End;

Function TKeyboardHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_KEYBOARD,fHookProc,hInstance,ThreadID);
End;

Function TMouseHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_MOUSE,fHookProc,hInstance,ThreadID);
End;

Function TMsgHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_MSGFILTER,fHookProc,hInstance,ThreadID);
End;

Function TShellHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_SHELL,fHookProc,hInstance,ThreadID);
End;
Function TSysMsgHook.AllocateHook : hHook;

Begin
  Result := SetWindowsHookEx(WH_SYSMSGFILTER,fHookProc,hInstance,ThreadID);
End;

Procedure Register;

Begin
  RegisterComponents('Hooks',[TCallWndProcHook,TCallWndProcRetHook,TCBTHook,TDebugHook,TGetMessageHook,
                            TJournalPlaybackHook,TJournalRecordHook,TKeyboardHook,TMouseHook,TMsgHook,
                            TShellHook,TSysMsgHook]);
End;

end.
 
 

Jens B

wow....

hvad er det lige den gør?

:)

og hvordan fyrer jeg det ind i delphi

Du gemmer unit'en i en pas fil, og gemmer den i dit lib biblotek. Så instalerer du den som et ganske almindeligt komponent !

Jens B

Den var lige avanceret nok til mig... :). Her er lidt kode, mere er ikke nødvendigt, selvom Jens' er virklig smart at have liggende til genbrug... men hvis det ikke er mere end at holde styr på end f.eks. musen, så er det her nok. Lav en form og smid to knapper på, kald dem for btnHook og btnUnhook.
Functionen MYMsgHook
er den der bliver kaldet når der kommer en message, her skal du smide ind hvad den skal holde styr på.
MYHook := SetWindowsHookEx(WH_JOURNALRECORD, @MyMsgHook, 0, 0);
bestemmer hvilken type hook du vil have, WH_JOURNALRECORD tager vistnok bare alt hvad der ryger ind i message-que'en... se hjælpen for "SetWindowsHookEx" for nærmere oplysninger..

----------------------------------------
              Kode Start
----------------------------------------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    btnHook: TButton;
    btnUnhook: TButton;
    procedure btnHookClick(Sender: TObject);
    procedure btnUnhookClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  WM_MOUSEMOVE = $0200;

var
  Form1: TForm1;
  MYHook: HHook;

implementation

function MYMsgHook(Code: Integer; WParam: Longint; var EvMsg: TEventMsg): Longint; stdcall;
begin
  if code = HC_ACTION then
  begin
    case EvMsg.Message of
      WM_MOUSEMOVE:
      begin
        Form1.Caption := IntToStr(LOWORD(evmsg.paraml)) + ' ' + inttostr(LOWORD(evmsg.paramh));
      end;
      WM_KEYDOWN:
      begin
        Form1.Caption := 'Du trykker altå på en tast... :)';
      end;
    else
      Form1.Caption := 'Ukendt: ' + IntToStr(EvMsg.Message);
    end;
  end;
  Result := CallNextHookEx(MyHook, Code, WParam, Longint(@EvMsg));
end;

{$R *.DFM}

procedure TForm1.btnHookClick(Sender: TObject);
begin
  if MyHook = 0 then
  begin
    MYHook := SetWindowsHookEx(WH_JOURNALRECORD, @MyMsgHook, 0, 0);
    BtnHook.Enabled := False;
    BtnUnHook.Enabled := True;
  end;
end;

procedure TForm1.btnUnhookClick(Sender: TObject);
begin
  if MyHook <> 0 then
  begin
    UnHookWindowsHookEx(MyHook);
    MyHook := 0;
    BtnHook.Enabled := True;
    BtnUnHook.Enabled := False;
  end;
end;

end.


----------------------------------------
              Kode Slut
----------------------------------------

MVH Elv

Det der er det snedige ved min løsning er at det er komponeneter ...

Jens B

Yes, og jeg mener også at det er ret sejt, men der er nogen gange nogle der er imod komponenter... synes også at din løsning er pænere :)

elv>> tror du vi hører fra ham i gen ?

Jens B

Hehe, det må vi da håbe på... men husk nu, at ikke alle har adsl :))

MVH Elv

omvendt er det længe siden vi havde marts :-)

Jens B

Det kan man jo sige... :)