library hookany;
{$W-,K+}
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$D Allgemeine Hook-Funktion zur Verfgung 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; {nchster 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 fr Messages}
stackl: Word; {Lnge Stapelrahmen fr Rcksprung}
p_code: Pointer; {Zeiger auf "gehookte" Prozedur}
p_data: Pointer; {Data-Alias fr p_code}
n_code: Pointer; {Ansprung-Adresse}
origby: array[0..7] of Byte; {weggepatchte Original-Bytes fr}
{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 fr "PUSH nnnn"}
stosb
mov ax,bx {nnnn}
stosw
mov al,$EA {Code fr "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 fr "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 zurckspielen}
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 {Wrter}
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 auer 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 prfendes 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 {nchstes Element}
@@e:
end;
function Unhook(h: THandle):Bool; export; assembler;
asm mov bx,[h]
call Check_Handle
jcxz @@f {Fehler: kein gltiges Handle!}
test THookRec[bx].hooked,2 {Bit InService da?}
jnz @@f {Kann aktiven Hook nicht lschen}
{Breakpoint abschalten}
push ds
pop es
call SetBytes
{Listenelement aushngen}
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 aushngen; 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 {fr 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.
Vorgefundene Kodierung: UTF-8 | 0
|