Umleiten von Funktionsaufrufen

[CalganX]

User shmia hat ein Stück SourceCode veröffentlicht, das es ermöglicht eine Funktion auf eine andere umzuleiten:

Delphi-Quellcode:

procedure RedirectProcedureCall(oldfunc, newfunc: Pointer);
type
  ba = array[0..4] of Byte;
  Pba = ^ba;
var
  oldprotect: DWORD;
  mbi: TMemoryBasicInformation;
  i : Integer;
begin
  if oldfunc = newfunc then
    exit;
  if (oldfunc=nil) or (newfunc=nil) then
    exit;

  // the JMP instruction needs 5 bytes
  for i := 0 to 4 do
  begin
    if Pba(oldfunc)[i] = $C3 then   // C3 = RET instruction
      raise Exception.Create('RedirectProcedureCall: procedure or function is too short !');
  end;

  VirtualQuery(oldfunc, mbi, sizeof(mbi));

  // program code memory is write protected
  VirtualProtect(mbi.BaseAddress, mbi.RegionSize, PAGE_EXECUTE_READWRITE, oldProtect);

  // patch the old procedure/function
  asm
    push ebx
    mov eax, oldfunc        // oldfunc points to handler being replaced
    mov ebx, newfunc        // newfunc points to a new handler
    mov byte ptr [eax], $E9 //JMP instruction
    sub ebx, eax
    sub ebx, 5              // sizeof(JMP xxx)
    mov dword ptr [eax + 1], ebx
    pop ebx
  end;


  FlushInstructionCache(GetCurrentProcess, oldfunc, 6);

  VirtualProtect(mbi.BaseAddress, mbi.RegionSize, OldProtect, OldProtect);
end;

Anwendungsbeispiel:

Delphi-Quellcode:

procedure NewShowMessage(const s:string);
begin
  MessageDlg('Hinweis: '+s, mtWarning, [mbYes, mbNo, mbOK, mbCancel], 0)
end;

{...}

begin
  // neue Procedure installieren
  RedirectProcedureCall(@ShowMessage, @NewShowMessage);
  // und ausprobieren
  ShowMessage('Hello World !');
end;

Ein Beispiel, wo dies nützlich sein kann, stammt ebenfalls von shmia:

Beispiel

In meiner Anwendung hatte ich öfters mal die Fehlermeldung "Klasse nicht registriert.";
natürlich nur bei Kunden, die von Computern keine Ahnung haben und mir bei der Fehlersuche nicht helfen konnten.
Na super, welche Klasse????

Also habe ich die Funktion ProgIDToClassID selbst geschrieben:

Delphi-Quellcode:

function ProgIDToClassID(const ProgID: string): TGUID;
var
  ErrorCode : HRESULT;
begin
  ErrorCode := CLSIDFromProgID(PWideChar(WideString(ProgID)), Result);
  if not Succeeded(ErrorCode) then
    raise EOleSysError.Create('ProgID: '+ProgID+#13#10+HResultToErrorMessage(ErrorCode), ErrorCode, 0);
end;

Und jetzt wäre es natürlich gut, wenn jeder Aufruf auf ComObj.ProgIDToClassID
auf meiner neuen Funktion landen würde. (Denn ProgIDToClassID wird von der Funktion CreateOleObject benützt)

[edit=Matze]Code formatiert. Mfg, Matze[/edit]