1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (not FileExists(ExtractFilePath(ParamStr(0)) + 'Project1.dll')) then
  begin
    showmessage('die datei ist nicht vorhanden');
  end
  else
    InjectDLL(ExtractFilePath(ParamStr(0)) + 'Project1.dll',
      strtoint(Edit1.Text));
end;

function GetDebugPrivilege: boolean; stdcall;
var
  hToken: THandle;
  rel: Cardinal;
  tkp: TOKEN_PRIVILEGES;
  luid: int64;
begin
  result := false;
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
    TOKEN_QUERY, hToken) then
  begin
    if LookupPrivilegeValue(nil, 'SeDebugPrivilege', luid) then
    begin
      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      tkp.Privileges[0].luid := luid;
      result := AdjustTokenPrivileges(hToken, false, tkp, sizeof(tkp),
        nil, rel);
    end;
    CloseHandle(hToken);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if (not GetDebugPrivilege) then
    raise Exception.Create('Keine debugprivilegien');
end;

procedure TForm1.InjectDLL(const ADLLName: String; targetproc: Cardinal);
var
  dllname: String;
  pDLLname, pStartAddr: Pointer;
  bw, hProzess, hRemoteThread: THandle;
  TID: Cardinal;
begin
  hRemoteThread := 0;
  bw := 0;
  pDLLname := nil;
  dllname := '';
  dllname := ADLLName;
  hProzess := 0;
  pStartAddr := nil;

  hProzess := OpenProcess(PROCESS_ALL_ACCESS, false, targetproc);
  pDLLname := VirtualAllocEx(hProzess, 0, length(dllname),
    MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);

  WriteProcessMemory(hProzess, pDLLname, PChar(dllname), length(dllname), bw);

  pStartAddr := GetProcAddress(GetModuleHandle('kernel32.dll'), 'LoadLibraryA');
  hRemoteThread := CreateRemoteThread(hProzess, nil, 0, pStartAddr,
    pDLLname, 0, TID);
  WaitForSingleObject(TID, INFINITE);
  showmessage('Fehler ' + IntToStr(GetLastError) + ': ' +
    SysErrorMessage(GetLastError));
  CloseHandle(hProzess);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

uses
  Windows;

{$R *.res}

var
  s: String;

begin
  s := ParamStr(0);
  MessageBox(HWND_DESKTOP, PChar('Ja es klappt!' + #13 + s),
    'Injection Message', MB_ICONINFORMATION);

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure InjectDll(PID: dword;  DLL: pChar);      {kompletter pfad benötigt}
var
  BytesWritten, hProcess, hThread, TID: Cardinal;
  Parameters: pointer;
  pThreadStartRoutine: Pointer;
begin
  hProcess := OpenProcess(PROCESS_ALL_ACCESS,  False,  PID);
  Parameters := VirtualAllocEx( hProcess, nil, Length(DLL)+1, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  WriteProcessMemory(hProcess,Parameters,Pointer(DLL),Length(DLL)+1,BytesWritten);
  pThreadStartRoutine := GetProcAddress(GetModuleHandle('KERNEL32.DLL'), 'LoadLibraryA');
  hThread := CreateRemoteThread(hProcess,  nil,  0,  pThreadStartRoutine,  Parameters,  0,  TID);
  CloseHandle(hProcess);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

var
  AnsiDllName: AnsiString;
  // ...
begin
  // ...
  AnsiDllName := AnsiString(dllName); // UnicodeString in AnsiString konvertieren
  pDLLname := VirtualAllocEx(hProzess, 0, Length(AnsiDllName) + 1, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE); // auch Platz für das 0-Zeichen am Ende
  WriteProcessMemory(hProzess, pDLLname, PChar(AnsiDllName), Length(AnsiDllName) + 1, bw); // auch das 0-Zeichen am Ende kopieren
  // ...
end;