Einzelnen Beitrag anzeigen

Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#9

AW: API Hook funktioniert nicht global

  Alt 18. Jan 2011, 15:22
Ja doch.. Oder nicht?!

DLL:
Delphi-Quellcode:
library HookDLL;

uses
  Windows,
  SysUtils,
  Classes,
  HookUtils in 'HookUtils.pas';

{$R *.res}

var
  FHook: HHOOK = 0;
  FHooked: Boolean = false;

function NewIsClipboardFormatAvailable(AFormat: Cardinal): BOOL; stdcall;
begin
  Result := true;
end;

function HookIsClipboardFormatAvailable: Boolean;
var func: Pointer;
    hProc: THandle;
    jmp: TJump;
    bw: Cardinal;
begin
  func := GetProcPtr('user32.dll','IsClipboardFormatAvailable');

  hProc := GetCurrentProcess;
  try
    jmp := Jump(@NewIsClipboardFormatAvailable);
    WriteProcessMemory(hProc,func,@jmp,SizeOf(TJump),bw);
    Result := bw = SizeOf(TJump);
  finally
    CloseHandle(hProc);
  end;
end;

function HookProc(code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if FHook <> 0 then
  begin
    if code < HC_ACTION then
      Result := CallNextHookEx(FHook,code,wParam,lParam)
    else
    begin
      if (not FHooked) and (code >= HC_ACTION) then
      begin
        FHooked := true;
        HookIsClipboardFormatAvailable;
      end;
      Result := CallNextHookEx(FHook,code,wParam,lParam);
    end;
  end
  else
    Result := 0;
end;

procedure InstallHook; stdcall;
begin
  FHook := SetWindowsHookEx(WH_GETMESSAGE,HookProc,hInstance,0);
end;

procedure UnInstallHook; stdcall;
begin
  if FHook <> 0 then
    UnhookWindowsHookEx(FHook);
end;

exports
  InstallHook,
  UnInstallHook,
  HookProc;

begin

end.

HookUtils:

Delphi-Quellcode:
unit HookUtils;

interface

uses
  Windows;

type
  TJump = packed record
    Push: Byte;
    Dest: Pointer;
    Retn: Byte;
    Nops: Array[0..3] of Byte;
  end;

  function Jump(ADest: Pointer): TJump;
  function GetProcPtr(ADll: String; AProc: String): Pointer;

implementation

function Jump(ADest: Pointer): TJump;
begin
  Result.Push := $68;
  Result.Dest := ADest;
  Result.Retn := $C3;
  FillChar(Result.Nops[0],SizeOf(Result.Nops),$90);
end;

function GetProcPtr(ADll: String; AProc: String): Pointer;
var hLib: HModule;
begin
  hLib := LoadLibrary(PChar(ADll));
  if hLib <> 0 then
  begin
    try
      Result := GetProcAddress(hLib,PChar(AProc));
    finally
      FreeLibrary(hLib);
    end;
  end
  else
    Result := nil;
end;

end.
Oder hab ich da tatsächlich grundlegend etwas nicht verstanden?!
Jetzt bin ich verwirrt.
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat