Subclassing einer fremden Application, warum funzt das net ?

[negaH]

Keine Garantien meinerseits, bei mir funktionierts prächtig.

Gruß Hagen

Delphi-Quellcode:

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;