In fremdem OpenGL Grafikkontext zeichnen

[idontwantaname]

Hi!

Ich habe mir jetzt OpenGL Hooks angeschaut und es funktioniert auch so halbwegs. Also ich kann schon in der fremden Anwendung etwas zeichnen, nur leider ist es nicht immer vollständig da und flackert auch - leider weiß ich nicht wieso.

Hier mein Code (ich verwende die uallCollection für den API Hook):

Hook-Installation und -Entfernung in meiner Anwendung:

Delphi-Quellcode:

procedure TControlForm.ButtonInstallHookClick(Sender: TObject);
var
  PID: Integer;
begin
  if TryStrToInt(EditProcessID.Text, PID) then
  begin
    if InjectLibrary(PID, PChar(DllFileName)) then
      MessageBox(Handle, 'Hook installation was successful!', 'Information', MB_OK or MB_ICONINFORMATION)
    else
      MessageBox(Handle, 'Hook installation was not successful!', 'Error', MB_OK or MB_ICONERROR);
  end
  else
    MessageBox(Handle, 'The entered process id is not a valid number!', 'Error', MB_OK or MB_ICONERROR);
end;

procedure TControlForm.ButtonRemoveHookClick(Sender: TObject);
var
  PID: Integer;
begin
  if TryStrToInt(EditProcessID.Text, PID) then
  begin
    if UnloadLibrary(PID, PChar(DllFileName)) then
      MessageBox(Handle, 'Hook uninstallation was successful!', 'Information', MB_OK or MB_ICONINFORMATION)
    else
      MessageBox(Handle, 'Hook uninstallation was not successful!', 'Error', MB_OK or MB_ICONERROR);
  end
  else
    MessageBox(Handle, 'The entered process id is not a valid number!', 'Error', MB_OK or MB_ICONERROR);
end;

Die einzige Unit der injizierten DLL:

Delphi-Quellcode:

unit Overlay;

interface

uses
  Windows, SysUtils, uallHook, Graphics;

type
  TSwapBuffersFunction = function(DC: HDC) : BOOL; stdcall;

implementation

var
  NewSwapBuffersFunction: TSwapBuffersFunction;

function MySwapBuffersFunction(DC: HDC): BOOL; stdcall;
var
  Canvas: TCanvas;
  Rect: TRect;
begin
  Rect.Left := 0;
  Rect.Right := 100;
  Rect.Top := 0;
  Rect.Bottom := 100;

  Canvas := TCanvas.Create;
  Canvas.Handle := DC;
  Canvas.Brush.Color := clRed;
  Canvas.FillRect(Rect);
  Canvas.Free;

  Result := NewSwapBuffersFunction(DC);
end;

procedure InstallHook;
var
  module: HMODULE;
  SwapBuffersFunction: Pointer;
begin
  module := GetModuleHandle(gdi32);
  if module <> INVALID_HANDLE_VALUE then
  begin
     SwapBuffersFunction := GetProcAddress(module, 'SwapBuffers');
     if SwapBuffersFunction <> nil then
     begin
       if not HookCode(SwapBuffersFunction, @MySwapBuffersFunction, @NewSwapBuffersFunction) then
         MessageBox(0, 'Hooking code has failed.', 'Error', MB_OK or MB_ICONERROR);
     end
     else
       MessageBox(0, 'Invalid function address!', 'Error', MB_OK or MB_ICONERROR);
  end
  else
    MessageBox(0, PChar('Invalid module handle!', 'Error', MB_OK or MB_ICONERROR);
end;

procedure RemoveHook;
begin
  if not UnhookCode(@NewSwapBuffersFunction) then
    MessageBox(0, 'Unhooking code has failed', 'Error', MB_OK or MB_ICONERROR);
end;

initialization

InstallHook;

finalization

RemoveHook;

end.

Habt ihr Ideen, woran es scheitert?

Lg oli