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

var 
  TickCountOffset : DWord;

function MyGetTickCount : DWord;
begin
  result := GetTickCount - TickCountOffset;
end;

procedure ResetTickCount;
begin
  TickCountOffset := GetTickCount;
end;					

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:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:

program DllInjector;
{
Dieses Delphi-Programm ist ein kleiner Launcher für das Programm ExeFileName und injiziert
dabei die DLL DllFileName in den Speicher des Programms. Die DLL bekommt damit die Möglichkeit
allerlei Dinge anzustellen, z.B. Windows-Funktionsaufrufe des Programms abzufangen / umzuleiten.
Autor: SMO
}

{$R *.res}

uses
  Winapi.Windows;


const
  ExeFileName = 'GAME.EXE';
  DllFileName = 'mydll.dll';


// existiert die angegebene Datei?
function FileExists(FileName: string): Boolean;
var
  Flags: Cardinal;
begin
  Flags := GetFileAttributes(PChar(FileName));
  Result := (Flags <> INVALID_FILE_ATTRIBUTES) and (Flags and FILE_ATTRIBUTE_DIRECTORY = 0);
end;


procedure ShowMessage(const Msg: string);
begin
  MessageBox(0, PChar(Msg), nil, MB_ICONERROR or MB_OK);
end;


// lade Programm AppName in den Speicher, aber starte es noch nicht
function MyCreateProcess(AppName, CmdLine: string; out PI: TProcessInformation): Boolean;
var
  SI: TStartupInfo;
begin
  FillChar(PI, SizeOf(PI), 0);
  FillChar(SI, SizeOf(SI), 0);
  Result := CreateProcess(PChar(AppName), PChar(CmdLine), nil, nil, False, CREATE_SUSPENDED,
    nil, nil, SI, PI);
end;


function InjectDll(const PI: TProcessInformation; LibName: string): Boolean;
const
  ProcName = {$IFDEF UNICODE} 'LoadLibraryW' {$ELSE} 'LoadLibraryA' {$ENDIF};
var
  TID: DWORD;
  hProcess, hThread: THandle;
  ByteSize: SIZE_T;
  Parameters: Pointer;
  PThreadStartAddr: Pointer;
  MustCloseHandle: Boolean;
begin
  // Öffne ein Handle zum Prozess, damit wir seinen Speicher manipulieren können
  MustCloseHandle := False;
  hProcess := PI.hProcess;
  if hProcess = 0 then
  begin
    hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, PI.dwProcessId);
    MustCloseHandle := True;
  end;
  // Reserviere neuen Speicher im Prozess und kopiere den String LibName dort rein
  // Windows erwartet 0-terminierte Strings, Delphi-Strings haben praktischerweise immer diesen
  // 0-Char implizit am Ende, deshalb kopieren wir Length(LibName) + 1 Chars.
  ByteSize := (Length(LibName) + 1) * SizeOf(Char);
  Parameters := VirtualAllocEx(hProcess, nil, ByteSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  Result := WriteProcessMemory(hProcess, Parameters, PChar(LibName), ByteSize, ByteSize);
  // Jetzt starten wir einen neuen Thread im geöffneten Prozess. Der Thread startet mit der
  // Ausführung direkt am Beginn der Funktion "LoadLibrary" von kernel32.dll
  // kernel32.dll als Kernkomponente von Windows existiert in JEDEM Prozess.
  // Der Thread führt also LoadLibrary(LibName) aus und lädt/injiziert damit die DLL
  PThreadStartAddr := GetProcAddress(GetModuleHandle('kernel32.dll'), ProcName);
  hThread := CreateRemoteThread(hProcess, nil, 0, PThreadStartAddr, Parameters, 0, TID);
  // Warten, bis der Thread seine Arbeit gemacht hat
  WaitForSingleObject(hThread, INFINITE);
  // Aufräumen: reservierten Speicher wieder freigeben, Thread schließen
  Result := VirtualFreeEx(hProcess, Parameters, 0, MEM_RELEASE) and Result;
  Result := CloseHandle(hThread) and Result;
  // Prozess-Handle schließen, falls wir es geöffnet haben
  if MustCloseHandle then Result := CloseHandle(hProcess) and Result;
end;


function CloseHandles(var PI: TProcessInformation): Boolean;
begin
  Result := CloseHandle(PI.hProcess);
  Result := CloseHandle(PI.hThread) and Result;
  PI.hProcess := 0;
  PI.hThread := 0;
end;


var
  PI: TProcessInformation;

begin
  if not FileExists(ExeFileName) then
  begin
    ShowMessage('Kann das Programm "' + ExeFileName + '" nicht finden!'#10
      + 'Dieser Launcher sollte im selben Verzeichnis wie "' + ExeFileName + ' gestartet werden".'#10);
    Exit;
  end;
  if not FileExists(DllFileName) then
  begin
    ShowMessage('Kann die DLL "' + DllFileName + '" nicht finden!'#10
      + 'Diese DLL sollte sich im selben Verzeichnis wie dieser Launcher und "' + ExeFileName + ' befinden".'#10);
    Exit;
  end;

  // Zielprogramm laden
  if MyCreateProcess(ExeFileName, '', PI) then
  begin
    // DLL injizieren und Hauptthread des Programms starten
    if InjectDll(PI, DllFileName) then
      ResumeThread(PI.hThread)
    else
      ShowMessage('Konnte DLL "' + DllFileName + '" nicht in "' + ExeFileName + '" injizieren!');
    CloseHandles(PI);
  end
  else
    ShowMessage('Konnte "' + ExeFileName + '" nicht starten!');
end.					

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:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:

library mydll;
{
Delphi Windows-DLL, die Winapi-Hooking demonstriert.
Als Beispiel wird GetTickCount (kernel32.dll) auf eine eigene Version umgeleitet, die den
TickCount ab Programmstart bei 0 beginnen lässt.
Autor: SMO
}

uses
  System.AnsiStrings,  // für SameText
  Winapi.Windows;

{$R *.res}

// Diese Funktion liefert einen Pointer in die Import-Tabelle des angegebenen Moduls.
// Der Pointer zeigt auf die Funktion "ProcName", die aus der DLL "LibName" importiert wird.
// Kann also benutzt werden, um beliebige DLL-Funktionen zu hooken, die im aktuellen
// Prozess geladen sind, sofern die DLL implizit ("statisch") geladen wurde und nicht
// explizit per LoadLibrary (denn dann gibt es in der Import-Tabelle keinen Eintrag dafür).
function GetImportTablePointer(Module: HMODULE; const LibName, ProcName: string): Pointer;
var
  LibNameA, ProcNameA: AnsiString;
  DosHeader: PImageDosHeader;
  NtHeaders: PImageNtHeaders;
  ImportDesc: PImageImportDescriptor;
  PName: PAnsiChar;
  Thunk, OrigThunk: PImageThunkData32;
  ImportName: PImageImportByName;
begin
  // Der folgende Code ist etwas kompliziert, wenn man die Datenstrukturen nicht kennt.
  // Details siehe z.B.:
  // http://www.ntcore.com/files/inject2it.htm
  // http://sandsprite.com/CodeStuff/Understanding_imports.html

  // ein HMODULE ist die Start-Speicheradresse eines Programms, dort stehen Header
  DosHeader := PImageDosHeader(Module);
  // Navigiere durch die diversen PE-Header (EXE,DLL...) und prüfe die Signaturen
  if DosHeader.e_magic <> IMAGE_DOS_SIGNATURE then Exit(nil);
  NtHeaders := PImageNtHeaders(IntPtr(Module) + DosHeader._lfanew);
  if (NtHeaders.Signature <> IMAGE_NT_SIGNATURE) or
    (NtHeaders.OptionalHeader.Magic <> IMAGE_NT_OPTIONAL_HDR32_MAGIC) then Exit(nil);

  with NtHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT] do
    UIntPtr(ImportDesc) := VirtualAddress + UIntPtr(Module);

  // Die Import-Tabelle benutzt AnsiString, nicht Unicode
  LibNameA := AnsiString(LibName);
  ProcNameA := AnsiString(ProcName);
  // Jetzt Schleife über alle Import-Descriptoren, jede DLL hat einen.
  // Ende der Liste wird durch OriginalFirstThunk = 0 angezeigt
  while ImportDesc.OriginalFirstThunk > 0 do
  begin
    PName := PAnsiChar(ImportDesc.Name + UIntPtr(Module));
    // OriginalFirstThunk zeigt auf eine Liste von Pointern auf ImportByName Records
    // FirstThunk zeigt auf eine Liste von Pointern auf die tatsächlichen Funktionen
    UIntPtr(OrigThunk) := ImportDesc.OriginalFirstThunk + UIntPtr(Module);
    UIntPtr(Thunk) := ImportDesc.FirstThunk + UIntPtr(Module);
    // SameText: Stringvergleich, ignoriert Unterschiede in Groß/Kleinschreibung
    if SameText(PName, LibNameA) then
    // Jetzt Schleife über die Namen aller Prozeduren, die aus der aktuellen DLL importiert werden
    // Ende der Liste wird durch AddressOfData = 0 angezeigt
    while OrigThunk.AddressOfData > 0 do
    begin
      // Wenn ungerade (=Bit 0 gesetzt), dann ist es ein "ordinaler Import" ohne Name -> überspringen
      if not Odd(OrigThunk.Ordinal) then
      begin
        UIntPtr(ImportName) := OrigThunk.AddressOfData + UIntPtr(Module);
        PName := PAnsiChar(UIntPtr(ImportName) + SizeOf(ImportName.Hint));
        if SameText(PName, ProcNameA) then
          Exit(Thunk);
      end;
      Inc(OrigThunk);
      Inc(Thunk);
    end;
    Inc(ImportDesc);
  end;
  Result := nil;
end;


// Diese Funktion "hookt" einen Import im angegebenen Modul
function InstallImportHook(Module: HMODULE; const LibName, ProcName: string; NewProc: Pointer;
  out OrigProc: Pointer): Boolean;
var
  P: PPointer;
  OldProtect: DWORD;
begin
  P := GetImportTablePointer(Module, LibName, ProcName);
  if Assigned(P) and Assigned(NewProc) then
  begin
    // Speicherbereich der Import-Tabelle beschreibbar machen, in dem sich der Pointer befindet
    OldProtect := PAGE_EXECUTE_WRITECOPY;
    Result := VirtualProtect(P, SizeOf(P^), OldProtect, OldProtect);
    if Result then
    begin
      // alten Import-Pointer sichern und durch neuen ersetzen
      OrigProc := P^;
      P^ := NewProc;
    end;
    // vorige Zugriffseinstellung des Speicherbereichs wiederherstellen
    VirtualProtect(P, SizeOf(P^), OldProtect, OldProtect);
  end
  else Result := False;
end;


var
  // HMODULE des Hauptprogramms (der EXE, die diese DLL lädt)
  HMainModule: HMODULE;
  PreviousDLLProcEx: TDLLProcEx;
  OrigGetTickCount: function: DWORD; stdcall;
  InitialTickCountValue: DWORD;


function MyGetTickCount: DWORD; stdcall;
begin
  Result := OrigGetTickCount - InitialTickCountValue
end;

procedure InstallGetTickCountHook;
begin
  // Jetzt biegen wir für HMainModule den GetTickCount Importeintrag auf unsere eigene
  // Funktion um.
  // Konstante kernel32 = 'kernel32.dll', definiert in Winapi.Windows
  if InstallImportHook(HMainModule, kernel32, 'GetTickCount', @MyGetTickCount, @OrigGetTickCount) then
    // Hook wurde installiert! Jetzt den initialen TickCount merken.
    InitialTickCountValue := OrigGetTickCount;
end;

procedure UninstallGetTickCountHook;
var
  Dummy: Pointer;
begin
  // Ursprünglichen Pointer wiederherstellen.
  InstallImportHook(HMainModule, kernel32, 'GetTickCount', @OrigGetTickCount, Dummy);
end;


procedure DllMainEx(Reason: Integer; Reserved: Pointer);
begin
  case Reason of
    // DLL wurde geladen, Initialisierungsaufgaben können jetzt durchgeführt werden
    DLL_PROCESS_ATTACH:
      InstallGetTickCountHook;
    // DLL wird entladen, Aufräumarbeiten können jetzt durchgeführt werden
    DLL_PROCESS_DETACH:
      UninstallGetTickCountHook;
  end;
  // die Meldung an den vorigen Handler weiterleiten, falls er existiert
  if Assigned(PreviousDLLProcEx) then PreviousDLLProcEx(Reason, Reserved);
end;


// Hauptprogrammblock:
begin
  HMainModule := GetModuleHandle(nil);
  DisableThreadLibraryCalls(HInstance);
  // DllProc initialisieren
  PreviousDLLProcEx := DllProcEx;
  DllProcEx := @DllMainEx;
  DllProcEx(DLL_PROCESS_ATTACH, nil);
end.					

1:
2:
3:
4:

function MyGetTickCount: DWORD; stdcall;
begin
  Result := (OrigGetTickCount - InitialTickCountValue) and $7FFFFFFF;
end;