type
PHookData = ^THookData;
THookData =
packed record
WndProc:
array[0..255]
of Byte;
ThreadProc:
array[0..255]
of Byte;
GetWindowLong:
function(Wnd: hWnd;
Index: Integer): Pointer;
stdcall;
SetWindowLong:
function(Wnd: hWnd;
Index: Integer; Value: Pointer): Pointer;
stdcall;
ExitThread:
procedure(ExitCode: DWord);
stdcall;
CallWindowProc:
function(PrevFunc: Pointer; Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
VirtualFree:
function(Address: Pointer; Size,FreeType: DWord): Bool;
stdcall;
MessageBox:
function(Wnd: hWnd; Text,Caption: PChar; Flag: DWord): Integer;
stdcall;
SaveWindowProc: Pointer;
Wnd: hWnd;
MsgText,MsgTitle:
array[0..127]
of Char;
end;
function GetProcAddr(Module: hModule;
Name: PChar): Pointer;
asm
XOR ECX,ECX
// except frame
PUSH OFFSET @@6
PUSH DWord Ptr FS:[ECX]
MOV FS:[ECX],ESP
PUSH EBP
PUSH EBX
MOV EBP,EDX
AND EAX,
not 3
PUSH EDI
MOV EDX,[EAX + 03Ch]
PUSH ESI
TEST EBP,EBP
JZ @@5
CMP Word Ptr [EAX + EDX],'
EP'
MOV EDX,[EAX + EDX + 078h]
JNZ @@5
ADD EDX,EAX
TEST EBP,0FFFF0000h
MOV EBX,EAX
JZ @@3
// import by ordinal ??
MOV EAX,[EDX + 018h]
MOV ECX,[EDX + 020h]
NOT EAX
@@1: INC EAX
MOV ESI,EBP
JZ @@4
MOV EDI,[EBX + ECX]
ADD ECX,4
ADD EDI,EBX
@@2: CMPSB
JNE @@1
CMP Byte Ptr [ESI - 1],0
JNE @@2
ADD EAX,[EDX + 018h]
MOV ECX,[EDX + 024h]
ADD ECX,EBX
MOVZX EBP,Word Ptr [ECX + EAX * 2]
INC EBP
@@3: MOV ECX,[EDX + 01Ch]
DEC EBP
ADD ECX,EBX
MOV EAX,[ECX + EBP * 4]
ADD EAX,EBX
@@4: POP ESI
POP EDI
POP EBX
POP EBP
POP DWord Ptr FS:[0]
POP ECX
RET
@@5:
XOR EAX,EAX
JMP @@4
@@6: MOV EAX,[ESP + 00Ch]
// except handler
PUSH OFFSET @@5
POP DWord Ptr [EAX + 0B8h]
SUB EAX,EAX
end;
function MyWndProc(Memory: PHookData; Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
forward;
procedure WndProcDispatcher;
asm
CALL @@1
@@1: POP EAX
SUB EAX,5
POP EDX
PUSH EAX
PUSH EDX
JMP MyWndProc
end;
function MyWndProc(Memory: PHookData; Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
const
MemorySize = SizeOf(THookData);
begin
if Msg = wm_Destroy
then
begin
Result := Memory.CallWindowProc(Memory.SaveWindowProc, Wnd, Msg, wParam, lParam);
asm
MOV EAX,Memory
POP EBX
// Delphi push it
POP EBP
// Delphi stackframe
POP EDX
// Return address caller
POP ECX
// 5 paramters Memory,Wnd,Msg,wParam,lParam
POP ECX
POP ECX
POP ECX
POP ECX
PUSH EAX
// VirtualFree() params
PUSH MemorySize
PUSH 0
PUSH EDX
// VirtualFree() returns back to our caller
JMP [EAX].THookData.VirtualFree
end;
end else
if (Msg = wm_Close)
or (Msg = wm_Quit)
then
begin
Result := 0;
Memory.MessageBox(0, Memory.MsgText, Memory.MsgTitle, 0);
end else
Result := Memory.CallWindowProc(Memory.SaveWindowProc, Wnd, Msg, wParam, lParam);
end;
function ThreadProc(Memory: PHookData): DWord;
stdcall;
const
MemorySize = SizeOf(THookData);
begin
Memory.SaveWindowProc := Memory.GetWindowLong(Memory.Wnd, gwl_WndProc);
if Memory.SaveWindowProc <>
nil then // hier eventuell Param für ExitThread setzen
Memory.SetWindowLong(Memory.Wnd, gwl_WndProc, Memory);
Memory.ExitThread(0);
end;
procedure SubClass(Wnd: hWnd);
var
CodeSize: Integer;
Process: THandle;
ProcessID: DWord;
Thread: THandle;
ThreadID: DWord;
Memory: PHookData;
DLL: hModule;
Temp: THookData;
Bytes: DWord;
begin
if not IsWindow(Wnd)
then Exit;
GetWindowThreadProcessID(Wnd, @ProcessID);
if ProcessID = 0
then Exit;
Process := OpenProcess(PROCESS_VM_OPERATION
or PROCESS_VM_WRITE
or PROCESS_CREATE_THREAD, False, ProcessID);
if Process <> 0
then
begin
Memory := VirtualAllocEx(Process,
nil, SizeOf(THookData), MEM_COMMIT, PAGE_READWRITE);
if Memory <>
nil then
begin
CodeSize := PChar(@ThreadProc) - PChar(@WndProcDispatcher);
Move(WndProcDispatcher, Temp.WndProc, CodeSize);
CodeSize := PChar(@SubClass) - PChar(@ThreadProc);
Move(ThreadProc, Temp.ThreadProc, CodeSize);
DLL := GetModuleHandle('
user32.dll');
Temp.GetWindowLong := GetProcAddr(
DLL, '
GetWindowLongA');
Temp.SetWindowLong := GetProcAddr(
DLL, '
SetWindowLongA');
Temp.CallWindowProc := GetProcAddr(
DLL, '
CallWindowProcA');
Temp.MessageBox := GetProcAddr(
DLL, '
MessageBoxA');
DLL := GetModuleHandle('
kernel32.dll');
Temp.ExitThread := GetProcAddr(
DLL, '
ExitThread');
Temp.VirtualFree := GetProcAddr(
DLL, '
VirtualFree');
Temp.Wnd := Wnd;
Temp.MsgText := '
Want close';
Temp.MsgTitle := '
Test';
if WriteProcessMemory(Process, Memory, @Temp, SizeOf(THookData), Bytes)
then
begin
Thread := CreateRemoteThread(Process,
nil, 0, @Memory.ThreadProc, Memory, 0, ThreadID);
if Thread <> 0
then
begin
WaitForSingleObject(Thread, INFINITE);
// hier eventuell ExitCode vom Thread auswerten
MessageBox(Application.Handle, '
Hooked successfull', '
SubClass()', 0);
CloseHandle(Thread);
end;
end else
begin
VirtualFreeEx(Process, Memory, SizeOf(THookData), 0);
end;
end;
CloseHandle(Process);
end;
end;
procedure TestSubClass;
function MyEnum(Wnd: hWnd; Return: PInteger): Bool;
stdcall;
var
ClassName:
String;
ProcessID: DWord;
begin
Result := True;
SetLength(ClassName, MAX_PATH);
SetLength(ClassName, GetClassname(Wnd, PChar(ClassName), Length(ClassName)));
if ClassName = '
TConsoleMainForm'
then
begin
GetWindowThreadProcessID(Wnd, @ProcessID);
if GetCurrentProcessID <> ProcessID
then
begin
Return^ := Wnd;
Result := False;
end;
end;
end;
var
Wnd: Integer;
begin
Wnd := 0;
EnumWindows(@MyEnum, Integer(@Wnd));
SubClass(Wnd);
end;