unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); function GetExplorId:Cardinal; private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
var AsmBuf:Array [0..20] of Byte = ($B8,$00,$00,$00,$00,$68,$00,$00,$00,$00,$FF,$D0,$B8,$00,$00,$00,00,$6A,$00,$FF,$D0);
function EnabledDebugPrivilege(const bEnabled: Boolean):Boolean;var hToken: THandle; tp: TOKEN_PRIVILEGES; a: DWORD;const SE_DEBUG_NAME = 'SeDebugPrivilege';begin Result:=False; if (OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken)) then begin tp.PrivilegeCount :=1; LookupPrivilegeValue(nil,SE_DEBUG_NAME ,tp.Privileges[0].Luid); if bEnabled then tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED else tp.Privileges[0].Attributes := 0; a:=0; AdjustTokenPrivileges(hToken,False,tp,SizeOf(tp),nil,a); Result:= GetLastError = ERROR_SUCCESS; CloseHandle(hToken); end;end;
function InjectDll(pid:cardinal;Dll:string):Cardinal;var hProc:Cardinal; wDllPath:PwideChar; pRemote:Pointer; cbSize:cardinal; TempVar:Cardinal;begin result:=0; if pid=0 then exit; EnabledDebugPrivilege(true); cbSize:= length(Dll)*2+21; GetMem(wDllPath,cbSize); StringToWideChar(Dll,wDllPath,cbSize); hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,pid); try pRemote:=VirtualAllocEx( hProc, nil, cbSize, MEM_COMMIT, PAGE_READWRITE); if WriteProcessMemory(hProc,pRemote, wDllPath, cbSize, TempVar) then begin TempVar:=0; Result := CreateRemoteThread(hProc, nil, 0, GetProcAddress(GetModuleHandle('Kernel32'), 'LoadLibraryW'), pRemote, 0, TempVar); end; finally CloseHandle(hProc); FreeMem(wDllPath); end;end;
function EjectDll(pid:cardinal;Dll:string):Cardinal;type PDebugModule = ^TDebugModule; TDebugModule = packed record Reserved: array [0..1] of Cardinal; Base: Cardinal; Size: Cardinal; Flags: Cardinal; Index: Word; Unknown: Word; LoadCount: Word; ModuleNameOffset: Word; ImageName: array [0..$FF] of Char; end; type PDebugModuleInformation = ^TDebugModuleInformation; TDebugModuleInformation = record Count: Cardinal; Modules: array [0..0] of TDebugModule; end; type PDebugBuffer = ^TDebugBuffer; TDebugBuffer = record SectionHandle: THandle; SectionBase: Pointer; RemoteSectionBase: Pointer; SectionBaseDelta: Cardinal; EventPairHandle: THandle; Unknown: array [0..1] of Cardinal; RemoteThreadHandle: THandle; InfoClassMask: Cardinal; SizeOfInfo: Cardinal; AllocatedSize: Cardinal; SectionSize: Cardinal; ModuleInformation: PDebugModuleInformation; BackTraceInformation: Pointer; HeapInformation: Pointer; LockInformation: Pointer; Reserved: array [0..7] of Pointer; end;const PDI_MODULES = $01; ntdll = 'ntdll.dll';var HNtDll: HMODULE;type TFNRtlCreateQueryDebugBuffer = function(Size: Cardinal;EventPair: Boolean): PDebugBuffer;stdcall; TFNRtlQueryProcessDebugInformation = function(ProcessId, DebugInfoClassMask: Cardinal; var DebugBuffer: TDebugBuffer): Integer;stdcall; TFNRtlDestroyQueryDebugBuffer = function(DebugBuffer: PDebugBuffer): Integer;stdcall;var RtlCreateQueryDebugBuffer: TFNRtlCreateQueryDebugBuffer; RtlQueryProcessDebugInformation: TFNRtlQueryProcessDebugInformation; RtlDestroyQueryDebugBuffer: TFNRtlDestroyQueryDebugBuffer;
function LoadRtlQueryDebug: LongBool; begin HNtDll := LoadLibrary(ntdll); if HNtDll <> 0 then begin RtlCreateQueryDebugBuffer := GetProcAddress(HNtDll, 'RtlCreateQueryDebugBuffer'); RtlQueryProcessDebugInformation := GetProcAddress(HNtDll, 'RtlQueryProcessDebugInformation'); RtlDestroyQueryDebugBuffer := GetProcAddress(HNtDll, 'RtlDestroyQueryDebugBuffer'); end; Result := Assigned(RtlCreateQueryDebugBuffer) and Assigned(RtlQueryProcessDebugInformation) and Assigned(RtlQueryProcessDebugInformation); end;
function ReleaseRtlQueryDebug: LongBool; begin result:=FreeLibrary(HNtDll); end;
var hProc:Cardinal; hMod:cardinal; TempVar:Cardinal; DbgBuffer: PDebugBuffer; i,j:integer; pd:PDWORD; pRemoteFunc:pointer;begin result:=0; if pid=0 then exit; EnabledDebugPrivilege(true); LoadRtlQueryDebug; DbgBuffer := RtlCreateQueryDebugBuffer(0, False); if Assigned(DbgBuffer) then try if RtlQueryProcessDebugInformation(pid, PDI_MODULES, DbgBuffer^) >= 0 then for i:=0 to DbgBuffer.ModuleInformation.Count-1 do if UpperCase(DbgBuffer.ModuleInformation.Modules[i].ImageName)= UpperCase(Dll) then begin hMod:=DbgBuffer.ModuleInformation.Modules[i].Base; j:=DbgBuffer.ModuleInformation.Modules[i].LoadCount; Break; end; finally RtlDestroyQueryDebugBuffer(DbgBuffer); ReleaseRtlQueryDebug; end; hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,pid); try TempVar:=DWORD(GetProcAddress(GetModuleHandle('Kernel32'),'FreeLibrary')); pd:=@AsmBuf[1]; pd^:=TempVar; pd:=@AsmBuf[6]; pd^:=hMod; TempVar:=DWORD(GetProcAddress(GetModuleHandle('Kernel32'),'ExitThread')); pd:=@AsmBuf[13]; pd^:=TempVar; pRemoteFunc:=VirtualAllocEx( hProc, nil, 21, MEM_COMMIT, PAGE_EXECUTE_READWRITE); if WriteProcessMemory(hProc, pRemoteFunc, @AsmBuf[0], 21, TempVar) then for i:=0 to j-1 do begin TempVar:=0; Result := CreateRemoteThread(hProc, nil, 0, pRemoteFunc, nil, 0, TempVar); end; finally CloseHandle(hProc); end;end; function TForm1.GetExplorId:Cardinal;begin GetWindowThreadProcessId(GetWindow(Handle,GW_HWNDLAST),@result);end;
procedure TForm1.Button1Click(Sender: TObject);begin InjectDll(GetExplorId,'c:/ExHook.Dll');end;
procedure TForm1.Button2Click(Sender: TObject);begin EjectDll(GetExplorId,'c:/ExHook.Dll');end;
end.
