Add(MainForm,1839434,371,175)
{
 Width=520
 Height=355
 Caption="Hook IC demo"
 Point(Handle)
}
Add(InlineCode,2108213,371,238)
{
 WorkPoints=#11:doStartHook|10:doStopHook|
 EventPoints=#7:onEvent|
 DataPoints=#4:hwnd|
 Code=#15:unit HiAsmUnit;|0:|9:interface|0:|59:uses Windows, Kol, Share, Debug, Messages{, CallbackThunk};|0:|4:type|33:  TCallbackThunk = class(TObject)|9:  private|26:    FCallAddress: Pointer;|22:    FProcPtr: Pointer;|25:    FSavedFlag: LongWord;|22:    FSelfPtr: Pointer;|37:    function GetCallAddress: Pointer;|8:  public|46:    constructor Create(pSelf, pProc: Pointer);|33:    destructor Destroy; override;|20:    procedure Clear;|54:    property CallAddress: Pointer read GetCallAddress;|8:  end;  |2:  |4:type|29:  THiAsmClass = class(TDebug)|9:  private|27:    FThunk: TCallbackThunk;|8:  public|34:    hwnd, onEvent: THI_Event;     |16:    Child: Hwnd;|25:    NewAddress: Pointer; |24:    OldAddress: LongInt;|23:    constructor Create;|55:    procedure doStartHook(var _Data:TData; Index:word);|54:    procedure doStopHook(var _Data:TData; Index:word);|59:    function ChildCallback(HWnd: THandle; Msg: Cardinal;   |64:               WParam, LParam: Integer): Cardinal; Stdcall;     |6:  end;|2:  |0:|14:implementation|0:|67:function THiAsmClass.ChildCallback(HWnd: THandle; Msg: Cardinal;   |61:             WParam, LParam: Integer): Cardinal; Stdcall;    |8:begin   |15:  case Msg of  |59:    WM_LBUTTONDOWN:   _hi_onEvent(onEvent,'onMouse_LDown');|59:    WM_RBUTTONDOWN:   _hi_onEvent(onEvent,'onMouse_RDown');|58:    WM_LBUTTONUP:     _hi_onEvent(onEvent,'onMouse_LUp'); |60:    WM_RBUTTONUP:     _hi_onEvent(onEvent,'onMouse_RUp');   |71:    WM_LBUTTONDBLCLK: _hi_onEvent(onEvent,'onDblClick');               |72:    WM_MOUSEMOVE:     _hi_onEvent(onEvent,'onMouseMove');               |73:    WM_MOUSEWHEEL:    _hi_onEvent(onEvent,'onMouseWheel');               |6:      |53:    WM_KEYUP:         _hi_onEvent(onEvent,'onKeyUp');|55:    WM_KEYDOWN:       _hi_onEvent(onEvent,'onKeyDown');|53:    WM_PAINT:         _hi_onEvent(onEvent,'onPaint');|54:    WM_SIZE:          _hi_onEvent(onEvent,'onResize');|56:    WM_SETFOCUS:      _hi_onEvent(onEvent,'onSetFocus');|57:    WM_KILLFOCUS:     _hi_onEvent(onEvent,'onKillFocus');|106:    WM_SHOWWINDOW:    _hi_onEvent(onEvent,'onShowWINDOW');                                                |6:  end;|7:       |73:  Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),   |65:                Hwnd, Msg, WParam, LParam);                      |5:end; |11:           |31:constructor THiAsmClass.Create;|5:begin|32:  Child := 0; NewAddress := nil;|52:  // создаём переходник на THiAsmClass.ChildCallback|68:  FThunk := TCallbackThunk.Create(Self, @THiAsmClass.ChildCallback);|4:end;|0:|34:procedure THiAsmClass.doStartHook;|5:begin|26:  if Child <> 0 then Exit;|32:  Child := 0; NewAddress := nil;|35:  Child := ReadInteger(_Data,hwnd);|50:  OldAddress := GetWindowLong(Child, GWL_WNDPROC);|79:  // получаем адрес на процедуру или функцию сласса с произвольными параметрами|35:  NewAddress := FThunk.CallAddress;|32:  if NewAddress = nil then Exit;|20:  // ставим ловушку |39:  SetWindowLong(Child, GWL_USERDATA,   |63:    SetWindowLong(Child, GWL_WNDPROC, LongInt(NewAddress)));   |4:end;|0:|33:procedure THiAsmClass.doStopHook;|5:begin|25:  if Child = 0 then Exit;|42:  // вернём родную калбэк функцию на место|39:  SetWindowLong(Child, GWL_USERDATA,   |51:    SetWindowLong(Child, GWL_WNDPROC, OldAddress));|24:  // почистим за собой  |15:  FThunk.Clear;|32:  Child := 0; NewAddress := nil;|4:end;|0:|80://------------------------------------------------------------------------------|69:// сам переходник вынес сюда из CallbackThunk.pas  (работает и в FPC)|4:type|19:  PThunk = ^TThunk;|24:  TThunk = packed record|17:    POPEDX: Byte;|17:    MOVEAX: Byte;|21:    SelfPtr: Pointer;|18:    PUSHEAX: Byte;|18:    PUSHEDX: Byte;|14:    JMP: Byte;|23:    JmpOffset: Integer;|6:  end;|0:|57:constructor TCallbackThunk.Create(pSelf, pProc: Pointer);|5:begin|22:  FCallAddress := nil;|20:  FSelfPtr := pSelf;|20:  FProcPtr := pProc;|4:end;|0:|34:destructor TCallbackThunk.Destroy;|5:begin|8:  Clear;|20:  inherited Destroy;|4:end;|0:|31:procedure TCallbackThunk.Clear;|3:var|18:  SaveFlag: DWORD;|5:begin|36:  if @FCallAddress <> nil then begin|57:    VirtualProtect(PThunk(@FCallAddress), SizeOf(TThunk),|29:      FSavedFlag, @SaveFlag);|46:    VirtualFree(FCallAddress, 0, MEM_RELEASE);|24:    FCallAddress := nil;|20:    FSavedFlag := 0;|6:  end;|4:end;|0:|48:function TCallbackThunk.GetCallAddress: Pointer;|5:begin|34:  if FCallAddress = nil then begin|82:    FCallAddress := VirtualAlloc(nil, SizeOf(TThunk), MEM_COMMIT, PAGE_READWRITE);|39:    with PThunk(FCallAddress)^ do begin|20:      POPEDX := $5A;|20:      MOVEAX := $B8;|26:      SelfPtr := FSelfPtr;|21:      PUSHEAX := $50;|21:      PUSHEDX := $52;|17:      JMP := $E9;|57:      JmpOffset := Integer(FProcPtr) - Integer(@JMP) - 5;|8:    end;|74:    if not VirtualProtect(FCallAddress, SizeOf(TThunk), PAGE_EXECUTE_READ,|30:       @FSavedFlag) then begin|26:      FCallAddress := nil;|8:    end;|6:  end;|25:  Result := FCallAddress;|4:end;|0:|4:end.|2:  |
 link(onEvent,338180:doEvent,[])
 link(hwnd,1839434:Handle,[])
}
Add(Button,3878981,280,238)
{
 Left=15
 Top=25
 Width=105
 Caption="StartHook"
 link(onClick,2108213:doStartHook,[])
}
Add(Debug,338180,476,238)
{
}
Add(Button,7773153,280,280)
{
 Left=15
 Top=60
 Width=105
 Caption="StopHook"
 link(onClick,2108213:doStopHook,[(339,286)(339,251)])
}