Handle einer geladenen DLL in einem anderen Process finden

[NicoDE]

Test-DLL:

Delphi-Quellcode:

library foo;

uses
  Windows;

{$IFNDEF CONDITIONALDEFINE}
// type def for Delphi 2-5
type
  TDLLProc = procedure(Reason: Integer);
{$ENDIF}

var
  DllProcNext: TDLLProc;  // nil

procedure LibraryProc(Reason: Integer);
var
  Filename: array [0..MAX_PATH] of Char;
begin
  Filename[0] := #0;
  GetModuleFileName(0, Filename, MAX_PATH);
  case Reason of
    DLL_PROCESS_ATTACH:
      begin
        DisableThreadLibraryCalls(HInstance);
        MessageBox(0, 'Attach', Filename, MB_OK or MB_SETFOREGROUND);
      end;
    DLL_PROCESS_DETACH:
      begin
        MessageBox(0, 'Detach', Filename, MB_OK or MB_SETFOREGROUND);
      end;
  end;
  if Assigned(DllProcNext) then
    DllProcNext(Reason);
end;

begin
  DllProcNext := TDLLProc(DllProc);
  TDLLProc(DllProc) := LibraryProc;
  LibraryProc(DLL_PROCESS_ATTACH);
end.

Beispiel-Code:

Delphi-Quellcode:

function LoadRemoteLibrary(Process: THandle; FileName: LPCTSTR): HMODULE;
var
  Size: DWORD;
  Buffer: Pointer;
  Written: DWORD;
  Thread: THandle;
  ThreadId: DWORD;
begin
  Result := 0;
  Size := (lstrlen(FileName) + 1) * SizeOf(FileName[0]);
  Buffer := VirtualAllocEx(Process, nil, Size, MEM_COMMIT, PAGE_READWRITE);
  if Assigned(Buffer) then
  try
    if WriteProcessMemory(Process, Buffer, Addr(FileName[0]), Size, Written) and
      (Written >= Size) then
    begin
      Thread := CreateRemoteThread(Process, nil, 0, TFNThreadStartRoutine(
{$IFDEF UNICODE}
        GetProcAddress(GetModuleHandle(kernel32), 'LoadLibraryW')
{$ELSE}
        GetProcAddress(GetModuleHandle(kernel32), 'LoadLibraryA')
{$ENDIF}
        ), Buffer, 0, ThreadId);
      if Thread <> 0 then
      try
        WaitForSingleObject(Thread, INFINITE);
        GetExitCodeThread(Thread, Result);
      finally
        CloseHandle(Thread);
      end;
    end;
  finally
    VirtualFreeEx(Process, Buffer, Size, MEM_RELEASE);
  end;
end;

function FreeRemoteLibrary(Process: THandle; Module: HMODULE): BOOL;
var
  Thread: THandle;
  ThreadId: DWORD;
begin
  Result := False;
  Thread := CreateRemoteThread(Process, nil, 0, TFNThreadStartRoutine(
    GetProcAddress(GetModuleHandle(kernel32), 'FreeLibrary')
    ), Pointer(Module), 0, ThreadId);
  if Thread <> 0 then
  try
    WaitForSingleObject(Thread, INFINITE);
    GetExitCodeThread(Thread, DWORD(Result));
  finally
    CloseHandle(Thread);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

function OpenTarget: THandle;
const
  DesiredAccess = PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or
    PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ;
var
  Wnd: HWND;
  ProcessId: DWORD;
begin
  Result := 0;
  Wnd := FindWindow(nil, 'Unbenannt - Editor');
  if Wnd <> 0 then
  begin
    ProcessId := 0;
    GetWindowThreadProcessId(Wnd, ProcessId);
    if ProcessId <> 0 then
      Result := OpenProcess(DesiredAccess, False, ProcessId);
  end;
end;

var
  RemoteLibrary: HMODULE = 0;

procedure TForm1.Button1Click(Sender: TObject);
var
  Process: THandle;
begin
  Process := OpenTarget;
  if Process <> 0 then
  try
    RemoteLibrary := LoadRemoteLibrary(Process, 'C:\Temp\foo.dll');
    ShowMessage(IntToHex(RemoteLibrary, 8));
  finally
    CloseHandle(Process);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Process: THandle;
begin
  Process := OpenTarget;
  if Process <> 0 then
  try
    if FreeRemoteLibrary(Process, RemoteLibrary) then
      ShowMessage('TRUE')
    else
      ShowMessage('FALSE');
  finally
    CloseHandle(Process);
  end;
end;