Source file: /~heha/hs/hookany.zip/HOOKANY.PAS

library hookany;
{$W-,K+}
{$C MOVEABLE PRELOAD PERMANENT}	{gleiche Attribute wie Unit SYSTEM}
{$D Allgemeine Hook-Funktion zur Verfügung stellen}
uses WinProcs,WinTypes,Win31,ToolHelp;

const
  WM_HookEnd=WM_User+201;
  SH_MessageWindow	=$01;
  SH_MessageTask	=$02;
  SH_NoResetHook	=$04;

type
 PtrRec=record
  ofs,sel:Word;
 end;
 LongRec=record
  lo,hi:Word;
 end;

 PHookRec=Word;		{hier: NEAR-Zeiger}
 THookRec=record	{Interne Struktur zur Hook-Verwaltung}
  next: Word;		{nächster Hook in EVL}
  flags:  Byte;		{Bit 0: msgtgt ist Window, nicht Task}
  hooked: Boolean;	{Bit0 TRUE wenn 8 Bytes gepatcht, Bit1=HookExecing}
  hooker: THandle;	{Besitzer-Task}
  hookee: THandle;	{nur diese Task wird "debugt" wenn <>0}
  msgtgt: THandle;	{Besitzer-Task oder Window für Messages}
  stackl: Word;         {Länge Stapelrahmen für Rücksprung}
  p_code: Pointer;	{Zeiger auf "gehookte" Prozedur}
  p_data: Pointer;	{Data-Alias für p_code}
  n_code: Pointer;	{Ansprung-Adresse}
  origby: array[0..7] of Byte;	{weggepatchte Original-Bytes für}
				{3 Byte MOV, 5 Byte JMP}
 end;

procedure HookProc; far; forward;

procedure UpdateSel; assembler;
{PE: ES:BX=THookRec}
 asm	push	es
	push	bx
	 push	es:PtrRec(THookRec[bx].p_code).sel
	 push	es:PtrRec(THookRec[bx].p_data).sel
	 call	PrestoChangoSelector
	pop	bx
	pop	es
	mov	es:PtrRec(THookRec[bx].p_data).sel,ax
 end;

procedure SetBreak; assembler;
{PE: ES:BX=THookRec}
 asm	or	es:THookRec[bx].hooked,1
	push	es
	push	di
	push	ax
	 cld
	 test	es:THookRec[bx].flags,SH_NoResetHook
	 jnz	@@direct
	 les	di,es:THookRec[bx].p_data
	 mov	al,068h		{Code für "PUSH nnnn"}
	 stosb
	 mov	ax,bx		{nnnn}
	 stosw
	 mov	al,$EA		{Code für "Far Jump"}
	 stosb
	 mov	ax,offset HookProc
	 stosw
	 mov	ax,cs		{eigenes Codesegment}
	 stosw
	 jmp	@@e
@@direct:
	 push	PtrRec(es:THookRec[bx].n_code).sel
	 push	PtrRec(es:THookRec[bx].n_code).ofs
	 les	di,es:THookRec[bx].p_data
	 mov	al,$EA		{Code für "Far Jump"}
	 stosb
	 pop	ax		{Offset}
	 stosw
	 pop	ax		{Segment}
	 stosw
@@e:	pop	ax
	pop	di
	pop	es
 end;

procedure SetBytes; assembler;	{gleichzeitig: Uninstall}
{PE: ES:BX=THookRec}
 asm	push	es
	push	di
	push	ds
	push	si
	push	cx
	 push	es
	 pop	ds
	 lea	si,THookRec[bx].origby
	 les	di,es:THookRec[bx].p_data
	 cld
	 mov	cx,4
	 rep	movsw		{Original-Bytes zurückspielen}
	pop	cx
	pop	si
	pop	ds
	pop	di
	pop	es
	and	es:THookRec[bx].hooked,not 1
 end;

var
 CallNow: Pointer;

procedure HookProc; {far;} assembler;
{PE: THookRec auf Stack}
 asm	push	seg @data
	pop	es
	pusha
	 mov	bp,sp
	 mov	bx,[bp+16]	{gepushtes PHookRec holen}
	 call	UpdateSel
	 call	SetBytes
	 or     es:THookRec[bx].hooked,2	{InService}
	 mov	ax,es:PtrRec(THookRec[bx].n_code).ofs
	 mov	dx,es:PtrRec(THookRec[bx].n_code).sel
	 mov	es:PtrRec[CallNow].ofs,ax
	 mov	es:PtrRec[CallNow].sel,dx
{Argumente auf Stack umstapeln}
	 cld
	 push	es
	  mov ax,[bp+16+4]; push ax	{Ret.sel}
	  mov ax,[bp+16+2]; push ax	{Ret.ofs}
	   lea	di,[bp+16]	{PHookRec}
	   lea	si,[bp+16+6]	{letztes Argument}
	   mov	cx,es:THookRec[bx].stackl
	   shr	cx,1		{Wörter}
	   push	ss
	   pop	es
	   segss
	   rep	movsw		{Argumente "nach unten" verschieben}
	   mov	ax,bx		{PHookRec}
	   stosw
	  pop	ax		{Ret.ofs}
	  stosw
	  pop	ax		{Ret.seg}
	  stosw
	 pop	es
	popa
	call	es:[CallNow]	{mit Übergabe aller Register außer ES und SP}
	push	seg @data
	pop	es
	pusha
	 mov	bp,sp
	 mov	bx,[bp+16]	{gepushtes PHookRec holen}
	 and    es:THookRec[bx].hooked,not 2	{nicht InService}
	 call	SetBreak
	popa
	add	sp,2
 end;

var
 Hooks: PHookRec;		{Listen-Anker}

function SetHook(adr, newadr: Pointer; stackframelen: Word;
  filtertask: THandle; MsgWindow: HWnd; flags:Word): THandle;
  export; assembler;
{filtertask ist 0, wenn alle Tasks betroffen sein sollen,
 MsgWindow bekommt Nachricht über das Ableben von filtertask}
 asm	push	LMEM_Fixed or LMEM_ZeroInit
	push	TYPE THookRec
	call	LocalAlloc
	or	ax,ax
	jz	@@f		{Versager!}
	xchg	bx,ax
{adr kopieren und Alias beschaffen}
	les	si,[adr]
	mov	PtrRec(THookRec[bx].p_code).sel,es
	mov	PtrRec(THookRec[bx].p_code).ofs,si
	mov	PtrRec(THookRec[bx].p_data).ofs,si
	push	bx
	 push	es
	 call	AllocSelector
	pop	bx
	mov	PtrRec(THookRec[bx].p_data).sel,ax
	push ds; pop es
	call	UpdateSel
{newadr und Tasks kopieren}
	les	si,[newadr]
	mov	PtrRec(THookRec[bx].n_code).sel,es
	mov	PtrRec(THookRec[bx].n_code).ofs,si
	mov	ax,[flags]
	mov	THookRec[bx].flags,al
	mov	ax,[stackframelen]
	mov	THookRec[bx].stackl,ax
	mov	ax,[filtertask]
	mov	THookRec[bx].hookee,ax
	push	es
	push	bx
	 mov	cx,[MsgWindow]
	 mov	THookRec[bx].msgtgt,cx
	 jcxz	@@taskonly
	 push	cx
	 call	GetWindowTask
	 jmp	@@hadwindow
@@taskonly:
	 call	GetCurrentTask
@@hadwindow:
	pop	bx
	pop	es
	mov	THookRec[bx].hooker,ax
	test	THookRec[bx].flags,SH_MessageWindow
	jnz	@@taskonly2
	mov	THookRec[bx].msgtgt,ax
@@taskonly2:
{origbytes holen}
	push	ds
	pop	es		{ES nun Datensegment}
	push	ds
	 lds	si,THookRec[bx].p_data
	 lea	di,THookRec[bx].origby
	 cld
	 mov	cx,4
	 rep	movsw
	pop	ds
{THookRec in verkettete Liste (vorn) einsetzen}
	mov	ax,bx
	xchg	ax,[Hooks]
	mov	THookRec[bx].next,ax
{Breakpoint aktivieren, aber nur wenn global oder eigene Task}
	mov	ax,THookRec[bx].hookee
	or	ax,ax
	jz	@@set
	cmp	ax,THookRec[bx].hooker
	jnz	@@e
@@set:
	call	SetBreak	{Breakpoint setzen, ES steht noch}
@@e:	xchg	bx,ax
@@f:
 end;

procedure Check_Handle; assembler;
{PE: BX: zu prüfendes Handle
 PA: SI: Adr. vorhergehender Knoten oder Anker
     CX=0 wenn BX nicht OK}
 asm	mov	si,offset Hooks
@@l:	mov	cx,[si]
	jcxz	@@e		{Ende der Liste}
	cmp	cx,bx
	je	@@e		{OK, gefunden}
	mov	si,cx
	jmp	@@l		{nächstes Element}
@@e:
 end;

function Unhook(h: THandle):Bool; export; assembler;
 asm	mov	bx,[h]
	call	Check_Handle
	jcxz	@@f		{Fehler: kein gültiges Handle!}
	test	THookRec[bx].hooked,2	{Bit InService da?}
	jnz	@@f		{Kann aktiven Hook nicht löschen}
{Breakpoint abschalten}
	push	ds
	pop	es
	call	SetBytes
{Listenelement aushängen}
	mov	ax,THookRec[bx].next
	mov	THookRec[si].next,ax
{Freigeben: Speicher und Alias-Selektor}
	push	PtrRec(THookRec[bx].p_data).sel
	 push	bx
	 call	LocalFree
	call	FreeSelector	{Alias-Selektor freigeben}
	mov	cx,TRUE
@@f:	xchg	cx,ax
 end;

procedure UnhookAll; assembler;
{Alle Hooks aushängen; Speicher NICHT freigeben (wird vom System erledigt)}
 asm	push	ds
	pop	es
	mov	bx,offset Hooks
@@l:	mov	bx,[bx]
	or	bx,bx
	jz	@@e
	call	SetBytes
	push	PtrRec(THookRec[bx].p_data).sel
	call	FreeSelector	{Alias-Selektor freigeben}
	jmp	@@l
@@e:
 end;

var
 RetCode: Word;

procedure UnhookTaskSpecific; assembler;
 asm
@@l1: 	call	GetCurrentTask
	mov	bx,offset Hooks
@@l2:	mov	bx,[bx]
	or	bx,bx
	jz	@@e
	cmp	THookRec[bx].hooker,ax
	jz	@@this
	cmp	THookRec[bx].hookee,ax
	jnz	@@l2
	test	THookRec[bx].flags,(SH_MessageWindow or SH_MessageTask)
	push	bx		{Benachrichtigung an App}
	 push	THookRec[bx].hooker
	 push	WM_HookEnd	{ist: ExitTask-Nachricht}
	 push	ax		{wParam=Task-Handle}
	 push	bx		{HIWORD(lParam)=Hook-Handle}
	 push	[RetCode]	{LOWORD(lParam)=Return-Code}
	 test	THookRec[bx].flags,SH_MessageWindow
	 jnz	@@postwindow
	 call	PostAppMessage	{für jeden Hook 1x}
	 jmp	@@postapp
@@postwindow:
	 call	PostMessage
@@postapp:
	pop	bx
@@this:
	push	bx
	call	Unhook
	jmp	@@l1		{noch mal von vorn}
@@e:
 end;

procedure OnLoadSeg; assembler;	{PE: AX=Selektor (Codesegment)}
 asm	push	ds
	pop	es
	mov	bx,offset Hooks
@@l:	mov	bx,[bx]
	or	bx,bx
	jz	@@e
	cmp	PtrRec(THookRec[bx].p_code).sel,ax
	jnz	@@l		{nicht hier}
	call	UpdateSel
	call	SetBreak
	jmp	@@l
@@e:
 end;

procedure OnTaskIn; assembler;
 asm	call	GetCurrentTask
	mov	bx,offset Hooks
@@l:	mov	bx,[bx]
	or	bx,bx
	jz	@@e
	cmp	THookRec[bx].hookee,ax	{passend?}
	jne	@@l
	push ds; pop es
	call	UpdateSel
	call	SetBreak
	jmp	@@l
@@e:
 end;

procedure OnTaskOut; assembler;
 asm	call	GetCurrentTask
	mov	bx,offset Hooks
@@l:	mov	bx,[bx]
	or	bx,bx
	jz	@@e
	cmp	THookRec[bx].hookee,ax	{passend?}
	jne	@@l
	push ds; pop es
	call	UpdateSel
	call	SetBytes
	jmp	@@l
@@e:
 end;

function NotifyCallback(wID:Word; dwData:LongInt):Bool; export; assembler;
 asm	mov	ax,[wID]
	cmp	ax,NFY_ExitTask
	jne	@@1
	mov	ax,LongRec[dwData].lo
	mov	[RetCode],ax
	call	UnhookTaskSpecific
	jmp	@@e
@@1:	cmp	ax,NFY_LoadSeg
	jne	@@2
	les	si,[dwData]
	test	es:TNFYLoadSeg[si].wType,1
	jnz	@@e		{Datensegment nicht beachten}
	mov	ax,es:TNFYLoadSeg[si].wSelector
	call	OnLoadSeg
	jmp	@@e
@@2:	cmp	ax,NFY_TaskIn
	jne	@@3
	call	OnTaskIn
	jmp	@@e
@@3:	cmp	ax,NFY_TaskOut
	jne	@@4
	call	OnTaskOut
{	jmp	@@e}
@@4:
@@e:	xor	ax,ax
 end;

exports
 SetHook index 2,
 Unhook  index 3;

var
 OldExit: Pointer;
procedure NewExit;
 begin
  ExitProc:=OldExit;
  UnhookAll;
  NotifyUnregister(0);
 end;

begin
 NotifyRegister(0,NotifyCallback,NF_Normal or NF_TaskSwitch);
 OldExit:=ExitProc;
 ExitProc:=@NewExit;
end.
Detected encoding: OEM (CP437)1
Wrong umlauts? - Assume file is ANSI (CP1252) encoded