// *************************************************************** // madRemote.pas version: 1.2.11 · date: 2021-12-27 // ------------------------------------------------------------- // basic stuff to get into remote processes // ------------------------------------------------------------- // Copyright (C) 1999 - 2021 www.madshi.net, All Rights Reserved // *************************************************************** // 2021-12-27 1.2.11 added GetRemoteModuleHandle/GetRemoteProcAddresses APIs // 2020-07-16 1.2.10 improved multi-threading for PatchCreateRemoteThread // 2018-05-17 1.2.9 (1) added IsElevatedProcess function // (2) added "parentId" field to process enumeration // 2017-12-22 1.2.8 fixed a small AllocMemEx bug // 2016-05-17 1.2.7 fixed: preferred allocation address was sometimes ignored // 2016-03-16 1.2.6 fixed some PAGE_EXECUTE_READWRITE security issues // 2015-09-10 1.2.5 using official GetThread/ProcessId APIs now if available // 2015-04-20 1.2.4 AllocMemEx performance improvement // 2014-10-26 1.2.3 fixed: XP/2003 x64: injection into 32bit processes failed // 2013-10-01 1.2.2 added IsAdminAndElevated function // 2013-03-13 1.2.1 (1) added support for csrss injection in Windows 8 // (2) fixed 64bit injection crash when using Delphi XE2/3 // (3) fixed incompatability with MSVC++ 2012 on Windows 8 // (4) fixed crash when hooking system APIs in x64 MSSQL // 2012-08-02 1.2.0 added support for XE2 x64 // 2011-05-20 1.1j fixed little bug in CopyFunction // 2010-01-07 1.1i improved CreateRemoteThreadEx // 2009-02-09 1.1h Delphi 2009 support // 2007-09-10 1.1g Vista: Process/ThreadHandleToId now work for non-admin users // 2007-01-31 1.1f incompatability with ZoneAlarm AV / Kaspersky fixed // 2006-07-11 1.1e (1) ProcessHandleToId now also works with GetCurrentProcess // (2) ThreadHandleToId added // (3) little bug in CreateRemoteThreadEx fixed // 2006-01-30 1.1d AllocMemEx now allocates <= $716f0000 to avoid fragmentation // 2004-09-26 1.1c (1) AMD64 NX: CreateRemoteThreadEx in other sessions froze // (2) NtQuerySystemInformation reads session info now, too // 2004-01-17 1.1b (1) IsMemoryProtected + ProtectMemory added // (2) AllocMemEx now allocates >= $5f000000 (winNT) // 2003-11-10 1.1a (1) call CloseHandle only for valid handles // (2) error handling improved a bit // 2003-06-09 1.1 (1) CreateRemoteThread -> CreateRemoteThreadEx // (2) CreateRemoteThreadEx ignores sessions (winNT) // (3) stability improvements for win9x remote threads // (4) AllocMemEx now allocates >= $5e000000 (winNT) // (5) RemoteExecute functionality added // (6) TryRead gets rid of unwanted debugger exception warnings // 2002-11-13 1.0d some changes in ProcessHandleToId (winNT branch) // 2002-03-10 1.0c (1) ProcessHandleToId had a bug in win9x // (2) CreateRemoteThread now ignores 16bit processes in win9x // 2002-02-21 1.0b CreateRemoteThread didn't work when CreateThread was hooked // 2002-01-21 1.0a ProcessHandleToId exported // 2001-07-22 1.0 this is a new package, the stuff was formerly in madDisAsm // madDisAsm history: // 2001-07-08 1.2 (1) CreateRemoteThread added (works also in win9x) // (2) Alloc/FreeMemEx added (replaces FreeCopiedFunction) // 2001-05-25 1.1d CopyFunction works better now inside of the IDE in win9x // 2001-04-16 1.1c bug (relocating absolute targets) in CopyFunction fixed // 2001-01-07 1.1a FreeCopiedFunction added // 2000-12-22 1.1 CopyFunction added and some minor changes unit madRemote; {$I mad.inc} interface uses Windows, madDisAsm, madTypes; // *************************************************************** // 64bit specific functions // is the current OS a native 64bit OS? function Is64bitOS : bool; stdcall; // is the specified process a native 64bit process? function Is64bitProcess(processHandle: THandle) : bool; stdcall; // *************************************************************** // memory allocation in the specified processes (shared memory in win9x) // if the processHandle is 0, the memory is allocated or freed in the shared // area (in win9x) or in our own process (in winNT) function AllocMemEx (size : dword; processHandle : THandle = 0 {$ifdef win64}; preferredAddress: pointer = nil {$endif}) : pointer; stdcall; function FreeMemEx (mem : pointer; processHandle : THandle = 0) : bool; stdcall; // *************************************************************** {$ifndef win64} // is the specified memory protected? function IsMemoryProtected (addr: pointer) : boolean; // (un)protect any memory area (works even for win9x shared memory) function UnprotectMemory (addr: pointer; size: dword) : boolean; function ProtectMemory (addr: pointer; size: dword) : boolean; // for internal purposes only, please don't use procedure InitUnprotectMemory; procedure UnprotectMemoryAsm; {$endif} // *************************************************************** // copy (and relocate) any function to a new location in any process // if the processHandle is 0, the function is copied to shared area (in win9x) // or to another memory location in our own process (in winNT) function CopyFunction (func : pointer; processHandle : THandle = 0; acceptUnknownTargets : boolean = false; buffer : TPPointer = nil; fi : TPFunctionInfo = nil ) : pointer; // *************************************************************** // like CreateRemoteThread, but 3 changes: // (1) this one also works perfectly in win9x!! // (2) this one also works on other sessions in winNt // (3) the DACL of the current thread is copied in winNt (if threadAttr = nil) // this one is exported under two different names (madCodeHook 2.x and 3.x) function CreateRemoteThreadEx (processHandle : THandle; threadAttr : PSecurityAttributes; stackSize : integer; startAddr : pointer; params : pointer; creationFlags : dword; var threadId : dword ) : THandle; stdcall; function madCreateRemoteThread (processHandle : THandle; threadAttr : PSecurityAttributes; stackSize : integer; startAddr : pointer; params : pointer; creationFlags : dword; var threadId : dword ) : THandle; stdcall; // *************************************************************** // this is how your remote function must look like type TRemoteExecuteFunction = function (params: pointer) : dword; stdcall; // executes the specified function in the context of another process // this works only if the function follows some specific rules // e.g. it must not use global variables, nor Delphi private functions // only win32 APIs are allowed // don't use Delphi strings, since they end up in local Delphi function calls // if "size" > 0, the "params" block will be copied to the other process // after the remote function is finished, the "params" block is copied back // so you can use the "params" block for both "in" and "out" parameters // if "size" = 0, the "params" value is just given into the remote function function RemoteExecute (processHandle : THandle; func : TRemoteExecuteFunction; var funcResult : dword; params : pointer = nil; size : dword = 0 ) : bool; stdcall; // *************************************************************** // which processID belongs to the specified process handle? // which threadID belongs to the specified thread handle? // undocumented functions, work in all windows 32 bit systems function ProcessHandleToId (processHandle: THandle) : dword; stdcall; function ThreadHandleToId ( threadHandle: THandle) : dword; stdcall; // *************************************************************** // you can easily enumerate processes in most OSs by using the well known // toolhelp functions. unfortunately the toolhelp functions don't work in NT4 // so here's a function which enumerates processes and works well in all OSs type TDAProcess = array of record id : dword; // process id exeFile : UnicodeString; // exe file (9x = full path; nt = name only) session : dword; // session id parentId : dword; // parent process id end; function EnumProcesses : TDAProcess; // *************************************************************** // internal stuff, please ignore type // types for Process32First/Next TProcessEntry32 = record size : dword; usage : dword; processId : dword; // this process (ID) defaultHeap : THandle; // default heap (ID) module : dword; threadCount : dword; parentProcessId : dword; // this process's parent process (ID) basePriority : integer; // Base priority of process's threads flags : dword; exeFile : array [0..MAX_PATH - 1] of AnsiChar; end; // types for Thread32First/Next TThreadEntry32 = record size : dword; usage : dword; threadId : dword; ownerProcessId : dword; basePriority : integer; deltaPriority : integer; flags : dword; end; // types for Module32First/Next TModuleEntry32 = record size : dword; module : dword; // this module (ID) ownerProcessId : dword; // owning process (ID) GlobalUsage : dword; // global usage count on the module ProcessUsage : dword; // module usage count in ownerProcess' context baseAddress : pointer; // base address of module in ownerProcess' context baseSize : dword; // size in bytes of module starting at baseAddress handle : HMODULE; // the handle of this module in ownerProcess' context fileName : array [0..255 ] of AnsiChar; exePath : array [0..MAX_PATH - 1] of AnsiChar; end; var // enumeration of processes/threads/modules in win9x/2k/xp Process32First : function (snap: THandle; var pe: TProcessEntry32) : bool stdcall = nil; Process32Next : function (snap: THandle; var pe: TProcessEntry32) : bool stdcall = nil; Thread32First : function (snap: THandle; var me: TThreadEntry32) : bool stdcall = nil; Thread32Next : function (snap: THandle; var me: TThreadEntry32) : bool stdcall = nil; Module32First : function (snap: THandle; var me: TModuleEntry32) : bool stdcall = nil; Module32Next : function (snap: THandle; var me: TModuleEntry32) : bool stdcall = nil; CreateToolhelp32Snapshot : function (flags, pid: dword) : THandle stdcall = nil; const // constants for CreateToolhelp32Snapshot TH32CS_SnapProcess = 2; TH32CS_SnapThread = 4; TH32CS_SnapModule = 8; procedure InitToolhelp; procedure InitSharedMem9x (alloc, free: TPPointer); function GetKernel32ProcessHandle : THandle; function GetSmssProcessHandle : THandle; function IsAdminAndElevated : boolean; function IsElevatedProcess(processHandle: THandle) : boolean; function HandleLiveForever (handle: THandle) : THandle; procedure UnpatchCreateRemoteThread; function GetRemoteModuleHandle (processHandle: THandle; is32bit: boolean; const dllName: UnicodeString) : HMODULE; function GetRemoteProcAddresses (processHandle: THandle; is32bit: boolean; const dllName: UnicodeString; const apiNames: array of AnsiString; procAddresses: TPAPointer; apiCount: integer) : boolean; {$ifdef win64} function Init32bitKernelAPIs (processHandle: THandle) : boolean; function GetKernelAPI (index: integer) : dword; function GetPeb32 (processHandle: THandle) : dword; {$endif} const CSetErrorMode : AnsiString = (* SetErrorMode *) #$06#$30#$21#$10#$27#$27#$3A#$27#$18#$3A#$31#$30; CGetVersion : AnsiString = (* GetVersion *) #$12#$30#$21#$03#$30#$27#$26#$3C#$3A#$3B; CWaitForSingleObject : AnsiString = (* WaitForSingleObject *) #$02#$34#$3C#$21#$13#$3A#$27#$06#$3C#$3B#$32#$39#$30#$1A#$37#$3F#$30#$36#$21; CCloseHandle : AnsiString = (* CloseHandle *) #$16#$39#$3A#$26#$30#$1D#$34#$3B#$31#$39#$30; CProcessIdToSessionId : AnsiString = (* ProcessIdToSessionId *) #$05#$27#$3A#$36#$30#$26#$26#$1C#$31#$01#$3A#$06#$30#$26#$26#$3C#$3A#$3B#$1C#$31; CNtQueryInformationProcess : AnsiString = (* NtQueryInformationProcess *) #$1B#$21#$04#$20#$30#$27#$2C#$1C#$3B#$33#$3A#$27#$38#$34#$21#$3C#$3A#$3B#$05#$27#$3A#$36#$30#$26#$26; CGetCurrentProcess : AnsiString = (* GetCurrentProcess *) #$12#$30#$21#$16#$20#$27#$27#$30#$3B#$21#$05#$27#$3A#$36#$30#$26#$26; CGetCurrentProcessId : AnsiString = (* GetCurrentProcessId *) #$12#$30#$21#$16#$20#$27#$27#$30#$3B#$21#$05#$27#$3A#$36#$30#$26#$26#$1C#$31; CVirtualProtect : AnsiString = (* VirtualProtect *) #$03#$3C#$27#$21#$20#$34#$39#$05#$27#$3A#$21#$30#$36#$21; CSleep : AnsiString = (* Sleep *) #$06#$39#$30#$30#$25; CNtQuerySystemInformation : AnsiString = (* NtQuerySystemInformation *) #$1B#$21#$04#$20#$30#$27#$2C#$06#$2C#$26#$21#$30#$38#$1C#$3B#$33#$3A#$27#$38#$34#$21#$3C#$3A#$3B; CProcess32Next : AnsiString = (* Process32Next *) #$05#$27#$3A#$36#$30#$26#$26#$66#$67#$1B#$30#$2D#$21; CSmss : AnsiString = (* smss.exe *) #$26#$38#$26#$26#$7B#$30#$2D#$30; CNtOpenThread : AnsiString = (* NtOpenThread *) #$1B#$21#$1A#$25#$30#$3B#$01#$3D#$27#$30#$34#$31; CLoadLibraryW : AnsiString = (* LoadLibraryW *) #$19#$3A#$34#$31#$19#$3C#$37#$27#$34#$27#$2C#$02; CGetLastError : AnsiString = (* GetLastError *) #$12#$30#$21#$19#$34#$26#$21#$10#$27#$27#$3A#$27; CGetModuleHandleW : AnsiString = (* GetModuleHandleW *) #$12#$30#$21#$18#$3A#$31#$20#$39#$30#$1D#$34#$3B#$31#$39#$30#$02; COpenFileMappingA : AnsiString = (* OpenFileMappingA *) #$1A#$25#$30#$3B#$13#$3C#$39#$30#$18#$34#$25#$25#$3C#$3B#$32#$14; CMapViewOfFile : AnsiString = (* MapViewOfFile *) #$18#$34#$25#$03#$3C#$30#$22#$1A#$33#$13#$3C#$39#$30; CUnmapViewOfFile : AnsiString = (* UnmapViewOfFile *) #$00#$3B#$38#$34#$25#$03#$3C#$30#$22#$1A#$33#$13#$3C#$39#$30; CFreeLibrary : AnsiString = (* FreeLibrary *) #$13#$27#$30#$30#$19#$3C#$37#$27#$34#$27#$2C; CRtlEnterCriticalSection : AnsiString = (* RtlEnterCriticalSection *) #$07#$21#$39#$10#$3B#$21#$30#$27#$16#$27#$3C#$21#$3C#$36#$34#$39#$06#$30#$36#$21#$3C#$3A#$3B; CRtlLeaveCriticalSection : AnsiString = (* RtlLeaveCriticalSection *) #$07#$21#$39#$19#$30#$34#$23#$30#$16#$27#$3C#$21#$3C#$36#$34#$39#$06#$30#$36#$21#$3C#$3A#$3B; {$ifdef dynamic} function GetMadCHookApi (const api: AnsiString; var proc: pointer) : boolean; {$endif} var X86AllocationAddress : pointer = pointer($71af0000); implementation uses madTools, madStrings; // *************************************************************** {$ifdef dynamic} var madCHookDll : HMODULE = 0; function GetMadCHookApi(const api: AnsiString; var proc: pointer) : boolean; var pathW : array [0..MAX_PATH] of WideChar; pathA : array [0..MAX_PATH] of AnsiChar; nameW : array [0..12] of WideChar; s1 : AnsiString; i1 : integer; begin result := proc <> nil; if not result then begin if madCHookDll = 0 then begin if GetVersion and $80000000 = 0 then begin GetModuleFileNameW(HInstance, pathW, MAX_PATH); for i1 := lstrlenW(pathW) - 2 downto 0 do if pathW[i1] = '\' then begin pathW[i1 + 1] := #0; break; end; s1 := 'madCHook.dll'; for i1 := 1 to Length(s1) do nameW[i1 - 1] := wideChar(s1[i1]); nameW[12] := #0; lstrcatW(pathW, nameW); madCHookDll := LoadLibraryW(pathW); end else begin GetModuleFileNameA(HInstance, pathA, MAX_PATH); s1 := pathA; for i1 := length(s1) - 1 downto 1 do if s1[i1] = '\' then begin SetLength(s1, i1); break; end; madCHookDll := LoadLibraryA(PAnsiChar(s1 + 'madCHook.dll')); end; if madCHookDll = 0 then begin madCHookDll := LoadLibrary('madCHook.dll'); if madCHookDll = 0 then begin madCHookDll := HMODULE(-1); SetLastError(ERROR_FILE_NOT_FOUND); end; end; end; if (madCHookDll <> 0) and (madCHookDll <> HMODULE(-1)) then begin proc := GetProcAddress(madCHookDll, PAnsiChar(api)); result := proc <> nil; if (not result) and (DebugHook <> 0) then begin MessageBoxA(0, PAnsiChar('madCHook.dll API "' + api + '" not found.'), 'Error', MB_ICONERROR); SetLastError(ERROR_FILE_NOT_FOUND); end; end; end; end; var Is64bitOSProc : function : bool; stdcall; Is64bitProcessProc : function (processHandle : THandle ) : bool; stdcall; AllocMemExProc : function (size : dword; processHandle : THandle = 0 ) : pointer; stdcall; FreeMemExProc : function (mem : pointer; processHandle : THandle = 0 ) : bool; stdcall; CopyFunctionProc : function (func : pointer; processHandle : THandle = 0; acceptUnknownTargets : boolean = false; buffer : TPPointer = nil ) : pointer; stdcall; CreateRemoteThreadExProc : function (processHandle : THandle; threadAttr : PSecurityAttributes; stackSize : integer; startAddr : pointer; params : pointer; creationFlags : dword; var threadId : dword ) : THandle; stdcall; RemoteExecuteProc : function (processHandle : THandle; func : TRemoteExecuteFunction; var funcResult : dword; params : pointer = nil; size : dword = 0 ) : bool; stdcall; ProcessHandleToIdProc : function (processHandle : THandle ) : dword; stdcall; ThreadHandleToIdProc : function (threadHandle : THandle ) : dword; stdcall; {$endif} // *************************************************************** const CComCtl32 : AnsiString = (* comctl32.dll *) #$36#$3A#$38#$36#$21#$39#$66#$67#$7B#$31#$39#$39; CMchRT9x : AnsiString = (* mchRT9x *) #$38#$36#$3D#$07#$01#$6C#$2D; CRtlCreateUserThread : AnsiString = (* RtlCreateUserThread *) #$07#$21#$39#$16#$27#$30#$34#$21#$30#$00#$26#$30#$27#$01#$3D#$27#$30#$34#$31; CNtQueryInformationThread : AnsiString = (* NtQueryInformationThread *) #$1B#$21#$04#$20#$30#$27#$2C#$1C#$3B#$33#$3A#$27#$38#$34#$21#$3C#$3A#$3B#$01#$3D#$27#$30#$34#$31; CCreateToolhelp32Snapshot : AnsiString = (* CreateToolhelp32Snapshot *) #$16#$27#$30#$34#$21#$30#$01#$3A#$3A#$39#$3D#$30#$39#$25#$66#$67#$06#$3B#$34#$25#$26#$3D#$3A#$21; CProcess32First : AnsiString = (* Process32First *) #$05#$27#$3A#$36#$30#$26#$26#$66#$67#$13#$3C#$27#$26#$21; CThread32First : AnsiString = (* Thread32First *) #$01#$3D#$27#$30#$34#$31#$66#$67#$13#$3C#$27#$26#$21; CThread32Next : AnsiString = (* Thread32Next *) #$01#$3D#$27#$30#$34#$31#$66#$67#$1B#$30#$2D#$21; CModule32First : AnsiString = (* Module32First *) #$18#$3A#$31#$20#$39#$30#$66#$67#$13#$3C#$27#$26#$21; CModule32Next : AnsiString = (* Module32Next *) #$18#$3A#$31#$20#$39#$30#$66#$67#$1B#$30#$2D#$21; CVirtualAllocEx : AnsiString = (* VirtualAllocEx *) #$03#$3C#$27#$21#$20#$34#$39#$14#$39#$39#$3A#$36#$10#$2D; CVirtualQueryEx : AnsiString = (* VirtualQueryEx *) #$03#$3C#$27#$21#$20#$34#$39#$04#$20#$30#$27#$2C#$10#$2D; CVirtualFreeEx : AnsiString = (* VirtualFreeEx *) #$03#$3C#$27#$21#$20#$34#$39#$13#$27#$30#$30#$10#$2D; CVirtualFree : AnsiString = (* VirtualFree *) #$03#$3C#$27#$21#$20#$34#$39#$13#$27#$30#$30; CGetThreadContext : AnsiString = (* GetThreadContext *) #$12#$30#$21#$01#$3D#$27#$30#$34#$31#$16#$3A#$3B#$21#$30#$2D#$21; CSetThreadContext : AnsiString = (* SetThreadContext *) #$06#$30#$21#$01#$3D#$27#$30#$34#$31#$16#$3A#$3B#$21#$30#$2D#$21; CCreateRemoteThread : AnsiString = (* CreateRemoteThread *) #$16#$27#$30#$34#$21#$30#$07#$30#$38#$3A#$21#$30#$01#$3D#$27#$30#$34#$31; CCreateRemoteThreadEx : AnsiString = (* CreateRemoteThreadEx *) #$16#$27#$30#$34#$21#$30#$07#$30#$38#$3A#$21#$30#$01#$3D#$27#$30#$34#$31#$10#$2D; CIsBadWritePtr : AnsiString = (* IsBadWritePtr *) #$1C#$26#$17#$34#$31#$02#$27#$3C#$21#$30#$05#$21#$27; CGetCurrentThread : AnsiString = (* GetCurrentThread *) #$12#$30#$21#$16#$20#$27#$27#$30#$3B#$21#$01#$3D#$27#$30#$34#$31; CDuplicateHandle : AnsiString = (* DuplicateHandle *) #$11#$20#$25#$39#$3C#$36#$34#$21#$30#$1D#$34#$3B#$31#$39#$30; CCreateThread : AnsiString = (* CreateThread *) #$16#$27#$30#$34#$21#$30#$01#$3D#$27#$30#$34#$31; CGetExitCodeThread : AnsiString = (* GetExitCodeThread *) #$12#$30#$21#$10#$2D#$3C#$21#$16#$3A#$31#$30#$01#$3D#$27#$30#$34#$31; CExitThread : AnsiString = (* ExitThread *) #$10#$2D#$3C#$21#$01#$3D#$27#$30#$34#$31; CDebugActiveProcess : AnsiString = (* DebugActiveProcess *) #$11#$30#$37#$20#$32#$14#$36#$21#$3C#$23#$30#$05#$27#$3A#$36#$30#$26#$26; CCsrClientCallServer : AnsiString = (* CsrClientCallServer *) #$16#$26#$27#$16#$39#$3C#$30#$3B#$21#$16#$34#$39#$39#$06#$30#$27#$23#$30#$27; CIsWow64Process : AnsiString = (* IsWow64Process *) #$1C#$26#$02#$3A#$22#$63#$61#$05#$27#$3A#$36#$30#$26#$26; CGetNativeSystemInfo : AnsiString = (* GetNativeSystemInfo *) #$12#$30#$21#$1B#$34#$21#$3C#$23#$30#$06#$2C#$26#$21#$30#$38#$1C#$3B#$33#$3A; CWow64GetThreadContext : AnsiString = (* Wow64GetThreadContext *) #$02#$3A#$22#$63#$61#$12#$30#$21#$01#$3D#$27#$30#$34#$31#$16#$3A#$3B#$21#$30#$2D#$21; CWow64GetThreadSelectorEntry : AnsiString = (* Wow64GetThreadSelectorEntry *) #$02#$3A#$22#$63#$61#$12#$30#$21#$01#$3D#$27#$30#$34#$31#$06#$30#$39#$30#$36#$21#$3A#$27#$10#$3B#$21#$27#$2C; CBaseThreadStart : AnsiString = (* BaseThreadStart *) #$17#$34#$26#$30#$01#$3D#$27#$30#$34#$31#$06#$21#$34#$27#$21; CRtlExitUserThread : AnsiString = (* RtlExitUserThread *) #$07#$21#$39#$10#$2D#$3C#$21#$00#$26#$30#$27#$01#$3D#$27#$30#$34#$31; CGetThreadId : AnsiString = (* GetThreadId *) #$12#$30#$21#$01#$3D#$27#$30#$34#$31#$1C#$31; CGetProcessId : AnsiString = (* GetProcessId *) #$12#$30#$21#$05#$27#$3A#$36#$30#$26#$26#$1C#$31; CGetProcessIdOfThread : AnsiString = (* GetProcessIdOfThread *) #$12#$30#$21#$05#$27#$3A#$36#$30#$26#$26#$1C#$31#$1A#$33#$01#$3D#$27#$30#$34#$31; // *************************************************************** {$ifndef dynamic} var IsWow64Process : function (processHandle: THandle; var wow64Process: bool) : bool; stdcall = nil; IsWow64Ready : boolean = false; Am64OS : boolean = false; Am64OSReady : boolean = false; {$endif} function Is64bitOS : bool; stdcall; {$ifndef dynamic} const PROCESSOR_ARCHITECTURE_AMD64 = 9; var gnsi : procedure (var si: TSystemInfo) stdcall; si : TSystemInfo; begin if not Am64OSReady then begin gnsi := KernelProc(CGetNativeSystemInfo); if @gnsi <> nil then begin ZeroMemory(@si, sizeOf(si)); gnsi(si); Am64OS := si.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64; Am64OSReady := true; end; end; result := Am64OS; {$else} begin result := GetMadCHookApi('Is64bitOS', @Is64bitOSProc) and Is64bitOSProc; {$endif} end; function Is64bitProcess(processHandle: THandle) : bool; stdcall; {$ifndef dynamic} var b1 : bool; begin if Is64bitOS then begin if not IsWow64Ready then begin IsWow64Process := KernelProc(CIsWow64Process); IsWow64Ready := true; end; result := (@IsWow64Process <> nil) and ((not IsWow64Process(processHandle, b1)) or (not b1)); end else result := false; {$else} begin result := GetMadCHookApi('Is64bitProcess', @Is64bitProcessProc) and Is64bitProcessProc(processHandle); {$endif} end; // *************************************************************** type // type for NtQuerySystemInformation(5, ...) TNtProcessInfo = packed record offset : dword; numThreads : dword; d1 : array [0..11] of dword; d2 : pointer; name : PWideChar; d3 : pointer; pid : NativeUInt; parentPid : NativeUInt; handleCount : dword; sessionId : dword; d4 : dword; d5 : array [0..11] of pointer; d6 : array [0..5] of dword; d7 : NativeUInt; threads : array [0..maxInt shr 7 - 1] of packed record startAddr_nt4 : pointer; pid_nt4 : dword; tid_nt4 : dword; d8 : array [44..52] of dword; startAddr_nt5 : pointer; pid_nt5 : NativeUInt; tid_nt5 : NativeUInt; d9 : dword; end; end; var {$ifndef dynamic} VirtualAllocEx : function (process: THandle; address: pointer; size: NativeUInt; allocType, flags: dword) : pointer stdcall = nil; VirtualFreeEx : function (process: THandle; address: pointer; size: NativeUInt; freeType : dword) : bool stdcall = nil; VirtualQueryEx : function (process: THandle; address: pointer; var buf: TMemoryBasicInformation; len: NativeUInt) : NativeUInt stdcall = nil; ReadProcessMemory : function (process: THandle; const addr: pointer; buf: pointer; size: NativeUInt; var written: NativeUInt) : bool stdcall = nil; WriteProcessMemory : function (process: THandle; const addr: pointer; buf: pointer; size: NativeUInt; var written: NativeUInt) : bool stdcall = nil; GetThreadContext : function (thread: THandle; var context: TContext) : bool stdcall = nil; SetThreadContext : function (thread: THandle; const context: TContext) : bool stdcall = nil; CreateRemoteThread : function (process: THandle; attr: pointer; stack: NativeUInt; startAddr, params: pointer; flags: dword; var tid: dword) : THandle stdcall = nil; {$endif} SharedMem9x_Alloc : function (size : dword ) : pointer stdcall = nil; SharedMem9x_Free : function (ptr : pointer) : bool stdcall = nil; NtQuerySystemInformation : function (infoClass: dword; buf: pointer; size: dword; retSize: TPCardinal) : dword stdcall = nil; procedure InitToolhelp; begin if @Process32First = nil then begin CreateToolhelp32Snapshot := KernelProc(CCreateToolhelp32Snapshot); Process32First := KernelProc(CProcess32First); Process32Next := KernelProc(CProcess32Next); Thread32First := KernelProc(CThread32First); Thread32Next := KernelProc(CThread32Next); Module32First := KernelProc(CModule32First); Module32Next := KernelProc(CModule32Next); end; end; {$ifndef dynamic} procedure InitRemoteProcs; begin if @ReadProcessMemory = nil then begin ReadProcessMemory := KernelProc(CReadProcessMemory); WriteProcessMemory := KernelProc(CWriteProcessMemory); GetThreadContext := KernelProc(CGetThreadContext); SetThreadContext := KernelProc(CSetThreadContext); CreateRemoteThread := KernelProc(CCreateRemoteThread); end; end; {$endif} function EnumProcesses : TDAProcess; var count : integer; procedure AddItem(id, session, parentId: dword; const exeFile: UnicodeString; sid: PSid); begin if Length(result) = count then if count = 0 then SetLength(result, 64 ) else SetLength(result, count * 2); result[count].id := id; result[count].exeFile := exeFile; result[count].session := session; result[count].parentId := parentId; inc(count); end; var c1, c2 : dword; h1 : THandle; pe : TProcessEntry32; p1 : pointer; npi : ^TNtProcessInfo; begin result := nil; count := 0; if GetVersion and $80000000 = 0 then begin if @NtQuerySystemInformation = nil then NtQuerySystemInformation := NtProc(CNtQuerySystemInformation); c1 := 0; NtQuerySystemInformation(5, nil, 0, @c1); p1 := nil; if c1 = 0 then begin c1 := $10000; repeat c1 := c1 * 2; LocalFree(HLOCAL(p1)); p1 := pointer(LocalAlloc(LPTR, c1)); c2 := NtQuerySystemInformation(5, p1, c1, nil); until (c2 = 0) or (c1 = $400000); end else begin c1 := c1 * 2; p1 := pointer(LocalAlloc(LPTR, c1)); c2 := NtQuerySystemInformation(5, p1, c1, nil); end; if c2 = 0 then begin npi := p1; while true do begin if npi^.name <> nil then AddItem(npi^.pid, npi^.sessionId, npi^.parentPid, npi^.name, nil) else AddItem(npi^.pid, npi^.sessionId, npi^.parentPid, '[System Process]', nil); if npi^.offset = 0 then break; NativeUInt(npi) := NativeUInt(npi) + npi^.offset; end; end; LocalFree(HLOCAL(p1)); end else begin InitToolhelp; h1 := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0); if h1 <> INVALID_HANDLE_VALUE then begin pe.size := sizeOf(TProcessEntry32); if Process32First(h1, pe) then repeat AddItem(pe.processId, 0, pe.parentProcessId, UnicodeString(pe.exeFile), nil); until not Process32Next(h1, pe); CloseHandle(h1); end; end; SetLength(result, count); end; var kernel32pid : dword = 0; function GetKernel32ProcessHandle : THandle; var prcs : TDAProcess; i1 : integer; arrCh : array [0..MAX_PATH] of AnsiChar; begin prcs := nil; if kernel32pid = 0 then begin GetModuleFileNameA(kernel32handle, arrCh, MAX_PATH); prcs := EnumProcesses; for i1 := 0 to high(prcs) do if IsTextEqualA(AnsiString(prcs[i1].exeFile), arrCh) then begin kernel32pid := prcs[i1].id; break; end; end; if kernel32pid <> 0 then result := OpenProcess(PROCESS_DUP_HANDLE, false, kernel32pid) else result := 0; end; var smsspid : dword = 0; function GetSmssProcessHandle : THandle; var prcs : TDAProcess; i1 : integer; s1 : UnicodeString; begin prcs := nil; if smsspid = 0 then begin s1 := UnicodeString(DecryptStr(CSmss)); prcs := EnumProcesses; for i1 := 0 to high(prcs) do if IsTextEqualW(prcs[i1].exeFile, s1) then begin smsspid := prcs[i1].id; break; end; end; if smsspid <> 0 then result := OpenProcess(PROCESS_DUP_HANDLE, false, smsspid) else result := 0; end; function IsElevatedProcess(processHandle: THandle) : boolean; var size : dword; token : THandle; elevated : dword; begin if OpenProcessToken(processHandle, TOKEN_QUERY, token) then begin size := 4; result := GetTokenInformation(token, TTokenInformationClass(20) (*TokenElevation*), @elevated, 4, size) and (elevated <> 0); CloseHandle(token); end else result := false; end; function IsAdminAndElevated : boolean; function IsUserAdmin : boolean; const CAdminSia : TSidIdentifierAuthority = (value: (0, 0, 0, 0, 0, 5)); var sid : PSid; ctm : function (token: THandle; sid: pointer; var isMember: bool) : bool; stdcall; b1 : bool; begin result := false; ctm := GetProcAddress(LoadLibrary('advapi32.dll'), 'CheckTokenMembership'); if (@ctm <> nil) and AllocateAndInitializeSid(CAdminSia, 2, $20, $220, 0, 0, 0, 0, 0, 0, sid) then begin result := ctm(0, sid, b1) and b1; FreeSid(sid); end; end; var smss : THandle; begin if byte(GetVersion) < 6 then begin smss := GetSmssProcessHandle; result := smss <> 0; if result then CloseHandle(smss); end else result := IsUserAdmin and IsElevatedProcess(GetCurrentProcess); end; function HandleLiveForever(handle: THandle) : THandle; var h1 : THandle; begin result := 0; if GetVersion and $80000000 = 0 then h1 := GetSmssProcessHandle else h1 := GetKernel32ProcessHandle; if h1 <> 0 then begin // this makes our file mapping live forever // e.g. system wide hooks stay hooked until the next reboot DuplicateHandle(GetCurrentProcess, handle, h1, @result, 0, false, DUPLICATE_SAME_ACCESS); CloseHandle(h1); end; end; procedure InitSharedMem9x(alloc, free: TPPointer); var comctl : HMODULE; begin if (@SharedMem9x_Alloc = nil) and (GetVersion and $80000000 <> 0) then begin comctl := LoadLibraryA(PAnsiChar(DecryptStr(CComCtl32))); SharedMem9x_Alloc := GetImageProcAddress(comctl, 71); SharedMem9x_Free := GetImageProcAddress(comctl, 73); end; if alloc <> nil then alloc^ := @SharedMem9x_Alloc; if free <> nil then free^ := @SharedMem9x_Free; end; var PreviousAllocationAddress : pointer = nil; function AllocMemEx(size: dword; processHandle: THandle = 0 {$ifdef win64}; preferredAddress: pointer = nil {$endif}) : pointer; stdcall; {$ifndef dynamic} var mbi : TMemoryBasicInformation; p1 : pointer; cacheAddr : boolean; begin if size > 0 then begin if GetVersion and $80000000 = 0 then begin result := nil; if @VirtualAllocEx = nil then begin VirtualAllocEx := KernelProc(CVirtualAllocEx); VirtualQueryEx := KernelProc(CVirtualQueryEx); end; cacheAddr := false; if processHandle = 0 then begin cacheAddr := true; processHandle := GetCurrentProcess; end; {$ifdef win64} if preferredAddress <> nil then begin p1 := preferredAddress; while (VirtualQueryEx(processHandle, p1, mbi, sizeOf(mbi)) = sizeOf(mbi)) and (NativeInt(mbi.BaseAddress) - NativeInt(preferredAddress) < $7fff0000) do begin if mbi.State = MEM_FREE then begin result := VirtualAllocEx(processHandle, mbi.BaseAddress, size, MEM_RESERVE, PAGE_EXECUTE_READWRITE); if result <> nil then break; mbi.RegionSize := $10000; end; if mbi.RegionSize < $10000 then mbi.RegionSize := $10000 else mbi.RegionSize := mbi.RegionSize and $ffffffffffff0000; p1 := pointer(NativeUInt(p1) + mbi.RegionSize); end; end; if result = nil then begin if (preferredAddress <> nil) and ((NativeUInt(preferredAddress) < $70000000) or (NativeUInt(preferredAddress) > $80000000)) then p1 := preferredAddress else if (preferredAddress = nil) and ((processHandle = GetCurrentProcess) or Is64bitProcess(processHandle)) then // allocate <= 0x7feffff0000 to avoid fragmentation p1 := pointer($7feffff0000) else {$endif} // allocate <= 0x71af0000 to avoid fragmentation p1 := X86AllocationAddress; if {$ifdef win64} (preferredAddress = nil) and {$endif} (PreviousAllocationAddress <> nil) and cacheAddr then p1 := PreviousAllocationAddress; while VirtualQueryEx(processHandle, p1, mbi, sizeOf(mbi)) = sizeOf(mbi) do begin if mbi.State = MEM_FREE then begin result := VirtualAllocEx(processHandle, mbi.BaseAddress, size, MEM_RESERVE, PAGE_EXECUTE_READWRITE); break; end; if p1 = mbi.AllocationBase then p1 := pointer(NativeUInt(p1) - $10000) else p1 := mbi.AllocationBase; end; if {$ifdef win64} (preferredAddress = nil) and {$endif} (result <> nil) and cacheAddr then PreviousAllocationAddress := result; {$ifdef win64} end; {$endif} result := VirtualAllocEx(processHandle, result, size, MEM_COMMIT, PAGE_EXECUTE_READWRITE); end else begin InitSharedMem9x(nil, nil); result := SharedMem9x_Alloc(size); end; end else result := nil; {$else} begin if GetMadCHookApi('AllocMemEx', @AllocMemExProc) then result := AllocMemExProc(size, processHandle) else result := nil; {$endif} end; function FreeMemEx(mem: pointer; processHandle: THandle = 0) : bool; stdcall; {$ifndef dynamic} begin if GetVersion and $80000000 = 0 then begin if @VirtualFreeEx = nil then VirtualFreeEx := KernelProc(CVirtualFreeEx); if processHandle = 0 then processHandle := GetCurrentProcess; result := VirtualFreeEx(processHandle, mem, 0, MEM_RELEASE); end else begin InitSharedMem9x(nil, nil); result := (NativeUInt(mem) >= $80000000) and SharedMem9x_Free(mem); end; {$else} begin result := GetMadCHookApi('FreeMemEx', @FreeMemExProc) and FreeMemExProc(mem, processHandle); {$endif} end; // *************************************************************** var VxdCallProc : procedure = nil; VirtualProtectFunc : procedure = nil; IsBadWritePtrFunc : procedure = nil; GetVersionFunc : procedure = nil; procedure InitUnprotectMemory; var m1 : HMODULE; begin m1 := kernel32handle; if (GetVersion and $80000000 <> 0) and (@VxdCallProc = nil) then VxdCallProc := GetImageProcAddress(m1, 1); if @VirtualProtectFunc = nil then begin VirtualProtectFunc := KernelProc(CVirtualProtect); IsBadWritePtrFunc := KernelProc(CIsBadWritePtr); GetVersionFunc := KernelProc(CGetVersion); end; end; function IsMemoryProtected(addr: pointer) : boolean; var mbi : TMemoryBasicInformation; begin result := (VirtualQuery(addr, mbi, sizeOf(mbi)) <> sizeOf(mbi)) or ( (mbi.Protect and PAGE_EXECUTE_READWRITE = 0) and (mbi.Protect and PAGE_EXECUTE_WRITECOPY = 0) and (mbi.Protect and PAGE_READWRITE = 0) and (mbi.Protect and PAGE_WRITECOPY = 0) ); end; {$ifndef win64} procedure UnprotectMemoryAsm; // (address: pointer; size: integer); stdcall; asm push ebp mov ebp, esp mov ecx, [ebp+$0c] mov edx, [ebp+$08] push 0 push esp push PAGE_EXECUTE_READWRITE push ecx push edx call VirtualProtectFunc pop ecx cmp eax, 0 jz @try9x mov ecx, [ebp+$0c] mov edx, [ebp+$08] push ecx push edx call IsBadWritePtrFunc cmp eax, 0 jz @success @try9x: call GetVersionFunc and eax, $80000000 cmp eax, 0 je @quit mov eax, [ebp+$08] and eax, $80000000 cmp eax, 0 je @quit mov eax, [ebp+$08] and eax, $0FFF add eax, [ebp+$0c] add eax, $0FFF shr eax, 12 push $20060000 // or mask (PC_STATIC or PC_USER or PC_WRITABLE) push $FFFFFFFF // and mask push eax mov eax, [ebp+$08] shr eax, 12 push eax push $0001000D call VxdCallProc mov ecx, [ebp+$0c] mov edx, [ebp+$08] push ecx push edx call IsBadWritePtrFunc cmp eax, 0 je @success xor eax, eax jmp @quit @success: mov eax, $01 @quit: pop ebp ret $08 end; function UnprotectMemory(addr: pointer; size: dword) : boolean; asm push size push addr call UnprotectMemoryAsm end; procedure ProtectMemoryAsm; // (address: pointer; size: integer); stdcall; asm push ebp mov ebp, esp mov ecx, [ebp+$0c] mov edx, [ebp+$08] push 0 push esp push PAGE_EXECUTE_READ push ecx push edx call VirtualProtectFunc pop ecx cmp eax, 0 (* jz @try9x mov ecx, [ebp+$0c] mov edx, [ebp+$08] push ecx push edx call IsBadWritePtrFunc cmp eax, 0 *) jnz @success // @try9x: call GetVersionFunc and eax, $80000000 cmp eax, 0 je @quit mov eax, [ebp+$08] and eax, $80000000 cmp eax, 0 je @quit mov eax, [ebp+$08] and eax, $0FFF add eax, [ebp+$0c] add eax, $0FFF shr eax, 12 push $0 // or mask push $fffdffff // and mask (not PC_WRITABLE) push eax mov eax, [ebp+$08] shr eax, 12 push eax push $0001000D call VxdCallProc mov ecx, [ebp+$0c] mov edx, [ebp+$08] push ecx push edx call IsBadWritePtrFunc cmp eax, 0 jne @success xor eax, eax jmp @quit @success: mov eax, $01 @quit: pop ebp ret $08 end; function ProtectMemory(addr: pointer; size: dword) : boolean; asm push size push addr call ProtectMemoryAsm end; {$endif} // *************************************************************** function CopyFunction(func : pointer; processHandle : THandle = 0; acceptUnknownTargets : boolean = false; buffer : TPPointer = nil; fi : TPFunctionInfo = nil ) : pointer; {$ifndef dynamic} var fi2 : TFunctionInfo; s1 : AnsiString; c1 : NativeUInt; pp1, pp2 : TPPointer; i64, i65 : int64; i1 : integer; p1 : pointer; targetDif : integer; op : dword; begin result := nil; fi2 := ParseFunction(func); if not fi2.IsValid then begin SetLastError(fi2.LastErrorNo); exit; // raise MadException.Create(fi2.LastErrorStr) at fi2.LastErrorAddr; end; if not fi2.Copy.IsValid then begin SetLastError(fi2.Copy.LastErrorNo); exit; // raise MadException.Create(fi2.Copy.LastErrorStr) at fi2.Copy.LastErrorAddr; end; if (not acceptUnknownTargets) and (fi2.UnknownTargets <> nil) then begin SetLastError(CErrorNo_UnknownTarget); exit; // raise MadException.Create(CErrorStr_UnknownTarget) at fi2.UnknownTargets[0].CodeAddr2; end; if (processHandle = 0) or (GetVersion and $80000000 <> 0) then processHandle := GetCurrentProcess; p1 := AllocMemEx(fi2.Copy.BufferLen, processHandle); SetLength(s1, fi2.Copy.BufferLen); pp1 := pointer(NativeUInt(s1) + dword(fi2.CodeLen) + sizeOf(pointer)); pp2 := pointer(NativeUInt(p1) + dword(fi2.CodeLen) + sizeOf(pointer)); i64 := int64(NativeUInt(fi2.CodeBegin)) - int64(NativeUInt(s1)); i65 := int64(NativeUInt(fi2.CodeBegin)) - int64(NativeUInt(p1)); Move(fi2.CodeBegin^, pointer(s1)^, fi2.CodeLen); for i1 := 0 to high(fi2.FarCalls) do with fi2.FarCalls[i1] do if (Target <> nil) and ((PTarget <> nil) or (PPTarget <> nil)) then if RelTarget then begin {$ifdef win64} targetDif := integer(int64(NativeUInt(pp2)) - (int64(NativeUInt(PTarget)) - i65) - 4); TPWord(pp1)^ := $25ff; inc(NativeUInt(pp1), 2); inc(NativeUInt(pp2), 2); TPInteger(pp1)^ := 0; inc(NativeUInt(pp1), 4); inc(NativeUInt(pp2), 4); pp1^ := Target; inc(pp1); inc(pp2); {$else} targetDif := integer(int64(NativeUInt(SolveW9xDebugMode(Target))) - (int64(NativeUInt(PTarget)) - i65) - 4); {$endif} TPInteger(int64(NativeUInt(PTarget)) - i64)^ := targetDif; end else if PPTarget <> nil then begin pp1^ := SolveW9xDebugMode(Target); {$ifdef win64} if RipRelative then begin TPCardinal(int64(NativeUInt(PPTarget)) - i64)^ := dword(int64(NativeUInt(pp2)) - (int64(NativeUInt(PPTarget)) - i65) - 4); end else {$endif} TPPointer(int64(NativeUInt(PPTarget)) - i64)^ := pp2; inc(pp1); inc(pp2); end else TPPointer(int64(NativeUInt(PTarget)) - i64)^ := SolveW9xDebugMode(Target); InitRemoteProcs; if WriteProcessMemory(processHandle, p1, pointer(s1), Length(s1), c1) and (c1 = dword(Length(s1))) then result := pointer(NativeUInt(p1) + (NativeUInt(fi2.EntryPoint) - NativeUInt(fi2.CodeBegin))); VirtualProtectEx(processHandle, p1, Length(s1), PAGE_EXECUTE_READ, @op); if buffer <> nil then buffer^ := p1; if fi <> nil then fi^ := fi2; {$else} begin if GetMadCHookApi('CopyFunction', @CopyFunctionProc) then begin result := CopyFunctionProc(func, processHandle, acceptUnknownTargets, buffer); if (result <> nil) and (fi <> nil) then fi^ := ParseFunction(func); end else result := nil; {$endif} end; // *************************************************************** {$ifndef dynamic} type {$minenumsize 4} TNtProcessInfoClass = (ProcessBasicInformation, ProcessQuotaLimits, ProcessIoCounters, ProcessVmCounters, ProcessTimes, ProcessBasePriority, ProcessRaisePriority, ProcessDebugPort, ProcessExceptionPort, ProcessAccessToken, ProcessLdtInformation, ProcessLdtSize, ProcessDefaultHardErrorMode, ProcessIoPortHandlers, ProcessPooledUsageAndLimits, ProcessWorkingSetWatch, ProcessUserModeIOPL, ProcessEnableAlignmentFaultFixup, ProcessPriorityClass, MaxProcessInfoClass); TNtThreadInfoClass = (ThreadBasicInformation, ThreadTimes, ThreadPriority, ThreadBasePriority, ThreadAffinityMask, ThreadImpersonationToken, ThreadDescriptorTableEntry, ThreadEnableAlignmentFaultFixup, ThreadEventPair, ThreadQuerySetWin32StartAddress, ThreadZeroTlsCell, ThreadPerformanceCount, ThreadAmILastThread, MaxThreadInfoClass); {$minenumsize 1} var NtQueryInformationProcess : function (processHandle : THandle; infoClass : TNtProcessInfoClass; buffer : pointer; bufSize : dword; returnSize : TPCardinal ) : dword stdcall = nil; NtQueryInformationThread : function (threadHandle : THandle; infoClass : TNtThreadInfoClass; buffer : pointer; bufSize : dword; returnSize : TPCardinal ) : dword stdcall = nil; GetThreadId : function (threadHandle : THandle ) : dword stdcall = nil; GetProcessId : function (processHandle : THandle ) : dword stdcall = nil; GetProcessIdOfThread : function (threadHandle : THandle ) : dword stdcall = nil; {$ifndef win64} type T9xRemoteThread = record proc : pointer; param : pointer; closeProc : pointer; errorMode : dword; hiddenTh : THandle; end; var Close9xProc : pointer = nil; Hidden9xProc : pointer = nil; var SetErrorModeFunc : function (mode: dword) : dword stdcall = nil; WaitForSingleObjectFunc : function (handle: THandle; timeOut: dword) : dword stdcall = nil; GetCurrentProcessFunc : function : THandle stdcall = nil; GetCurrentThreadFunc : function : THandle stdcall = nil; DuplicateHandleFunc : function (sph, sh, dph: THandle; dh: pointer; access: dword; inherit: bool; options: dword) : bool stdcall = nil; CloseHandleFunc : function (obj: THandle) : bool stdcall = nil; CreateThreadFunc : function (attr: pointer; stack: NativeUInt; proc, param: pointer; flags: dword; var tid: dword) : THandle stdcall = nil; GetExitCodeThreadFunc : function (thread: THandle; var exitCode: dword) : bool stdcall = nil; GetCurrentProcessIdFunc : function : dword stdcall = nil; SleepProc : procedure (time: dword) stdcall = nil; function Close9xRemoteThread(var params: T9xRemoteThread) : dword; stdcall; begin WaitForSingleObjectFunc(params.hiddenTh, INFINITE); CloseHandleFunc(params.hiddenTh); SetErrorModeFunc(params.errorMode); SharedMem9x_Free(@params); result := 0; end; function Hidden9xRemoteThread(var params: T9xRemoteThread) : dword; stdcall; type T9xHandleItem = packed record access : dword; objAddr : dword; end; T9xHandleTable = packed record itemCount : integer; items : array [0..maxInt shr 3 - 1] of T9xHandleItem; end; var th : THandle; tid : dword; pid : dword; magic : dword; ht : ^T9xHandleTable; i1, i2, i3 : integer; begin asm mov eax, fs:[$30] // eax := threadEnvironmentBlock^.processDataBase mov pid, eax end; result := 0; ht := TPPointer(pid + $44)^; magic := pid xor GetCurrentProcessIdFunc; for i1 := 1 to 20 do begin i3 := 0; for i2 := 0 to ht^.itemCount - 1 do if (ht^.items[i2].objAddr <> 0) and (ht^.items[i2].objAddr <> Magic) and (ht^.items[i2].access and $80000000 = 0) then begin inc(i3); if i3 > 1 then break; end; if i3 > 1 then // we found more than the default one handle in the process' handle table // so it must be up and running break; SleepProc(100); end; if TPCardinal(pid + $20)^ and $30800000 = 0 then begin th := CreateThreadFunc(nil, 0, params.proc, params.param, 0, tid); if th <> 0 then begin WaitForSingleObjectFunc(th, INFINITE); GetExitCodeThreadFunc(th, result); if (TPCardinal(pid + $20)^ and $30800000 = 0) and DuplicateHandleFunc(GetCurrentProcessFunc, GetCurrentThreadFunc, GetCurrentProcessFunc, @params.hiddenTh, 0, false, DUPLICATE_SAME_ACCESS) then begin params.errorMode := SetErrorModeFunc(SEM_FAILCRITICALERRORS or SEM_NOGPFAULTERRORBOX or SEM_NOOPENFILEERRORBOX); th := CreateThreadFunc(nil, 0, params.closeProc, @params, 0, tid); if th <> 0 then CloseHandleFunc(th); end else SharedMem9x_Free(@params); end else SharedMem9x_Free(@params); end else SharedMem9x_Free(@params); end; function Init9xRemoteThread(var closeProc, hiddenProc: pointer) : boolean; type TMchRT9x = packed record name : array [0..7] of AnsiChar; close : pointer; hidden : pointer; end; var map : THandle; newMap : boolean; buf : ^TMchRT9x; s1 : AnsiString; i1 : integer; begin if @SetErrorModeFunc = nil then begin SetErrorModeFunc := KernelProc(CSetErrorMode, true); WaitForSingleObjectFunc := KernelProc(CWaitForSingleObject, true); GetCurrentProcessFunc := KernelProc(CGetCurrentProcess, true); GetCurrentThreadFunc := KernelProc(CGetCurrentThread, true); DuplicateHandleFunc := KernelProc(CDuplicateHandle, true); CloseHandleFunc := KernelProc(CCloseHandle, true); CreateThreadFunc := KernelProc(CCreateThread, true); GetExitCodeThreadFunc := KernelProc(CGetExitCodeThread, true); GetCurrentProcessIdFunc := KernelProc(CGetCurrentProcessId, true); SleepProc := KernelProc(CSleep, true); end; if (Close9xProc = nil) and (GetVersion and $80000000 <> 0) then begin s1 := DecryptStr(CMchRT9x); map := CreateFileMappingA(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, sizeOf(buf^), PAnsiChar(s1)); if map <> 0 then begin newMap := GetLastError <> ERROR_ALREADY_EXISTS; buf := MapViewOfFile(map, FILE_MAP_ALL_ACCESS, 0, 0, 0); if buf <> nil then begin for i1 := 1 to 50 do if newMap or (TPInt64(@buf^.name)^ = TPInt64(s1)^) then break else Sleep(50); if newMap or (TPInt64(@buf^.name)^ <> TPInt64(s1)^) then begin buf^.close := CopyFunction(@Close9xRemoteThread); buf^.hidden := CopyFunction(@Hidden9xRemoteThread); TPInt64(@buf^.name)^ := TPInt64(s1)^; HandleLiveForever(map); end; Close9xProc := buf^.close; Hidden9xProc := buf^.hidden; UnmapViewOfFile(buf); end; CloseHandle(map); end; end; closeProc := Close9xProc; hiddenProc := Hidden9xProc; result := (closeProc <> nil) and (hiddenProc <> nil); end; {$endif} var PCrtHookBuf : pointer = nil; // trampoline PCrtIntTarget : ^integer = nil; // patch address (for "int" size patch) PCrtOldInt : integer = 0; // original patch content (for "int" size patch) PCrtPVoidTarget : ^pointer = nil; // patch address (for "pvoid" size patch) PCrtOldPVoid : pointer = nil; // original patch content (for "pvoid" size patch) CsrClientCallServerNext : function (msg, reply: pointer; opcode, size: dword) : dword; stdcall; CsrClientCallServerHooked : boolean = false; function CsrClientCallServerCallback(msg, reply: pointer; opcode, size: dword) : dword; stdcall; // hooks CreateRemoteThread's call to CsrClientCallServer // the call to CsrClientCallServer is passed on unchanged // however, CsrClientCallServer is forced to always report success var error : dword; i1 : integer; begin error := CsrClientCallServerNext(msg, reply, opcode, size); if error <> 0 then for i1 := 7 to 14 do if TPACardinal(msg)[i1] = error then begin TPACardinal(msg)[i1] := 0; break; end; result := 0; end; function PatchCreateRemoteThread : boolean; // patches CreateRemoteThread to not fail for other TS client sessions // this patching works in most cases, except for win32 processes in a 64bit OS var fi : TFunctionInfo; i1 : integer; targetDif : integer; op : dword; {$ifdef win64} pp1 : TPPointer; {$endif} begin result := CsrClientCallServerHooked; if result then // already patched? exit; CsrClientCallServerNext := NtProc(CCsrClientCallServer); if @CsrClientCallServerNext <> nil then begin fi := ParseFunction(KernelProc(CCreateRemoteThreadEx)); if not fi.IsValid then fi := ParseFunction(KernelProc(CCreateRemoteThread)); for i1 := 0 to high(fi.FarCalls) do if ((fi.FarCalls[i1].PTarget <> nil) or (fi.FarCalls[i1].PPTarget <> nil)) and (fi.FarCalls[i1].Target = @CsrClientCallServerNext) then begin if fi.FarCalls[i1].RelTarget then begin {$ifdef win64} PCrtHookBuf := AllocMemEx(6 + sizeof(LPVOID), 0, fi.FarCalls[i1].CodeAddr2); pp1 := PCrtHookBuf; TPWord(pp1)^ := $25ff; inc(NativeUInt(pp1), 2); TPCardinal(pp1)^ := 0; inc(NativeUInt(pp1), 4); pp1^ := fi.FarCalls[i1].Target; targetDif := NativeInt(PCrtHookBuf) - NativeInt(fi.FarCalls[i1].PTarget) - 4; VirtualProtect(PCrtHookBuf, 6 + sizeof(LPVOID), PAGE_EXECUTE_READ, @op); {$else} targetDif := NativeInt(fi.FarCalls[i1].Target) - NativeInt(fi.FarCalls[i1].PTarget) - 4; {$endif} if VirtualProtect(fi.FarCalls[i1].PTarget, sizeOf(integer), PAGE_EXECUTE_READWRITE, @op) then begin PCrtIntTarget := fi.FarCalls[i1].PTarget; PCrtOldInt := PCrtIntTarget^; PCrtIntTarget^ := TargetDif; VirtualProtect(fi.FarCalls[i1].PTarget, sizeOf(integer), op, @op); end; end else if fi.FarCalls[i1].PPTarget <> nil then begin {$ifdef win64} PCrtHookBuf := AllocMemEx(sizeOf(pointer), 0, fi.FarCalls[i1].CodeAddr2); {$else} PCrtHookBuf := AllocMemEx(sizeOf(pointer)); {$endif} pointer(PCrtHookBuf^) := @CsrClientCallServerCallback; {$ifdef win64} if fi.FarCalls[i1].RipRelative then begin if VirtualProtect(fi.FarCalls[i1].PPTarget, sizeOf(integer), PAGE_EXECUTE_READWRITE, @op) then begin PCrtIntTarget := pointer(fi.FarCalls[i1].PPTarget); PCrtOldInt := PCrtIntTarget^; PCrtIntTarget^ := integer(NativeUInt(PCrtHookBuf) - NativeUInt(fi.FarCalls[i1].PPTarget) - 4); VirtualProtect(fi.FarCalls[i1].PPTarget, sizeOf(integer), op, @op); end; end else {$endif} if VirtualProtect(fi.FarCalls[i1].PPTarget, sizeOf(pointer), PAGE_EXECUTE_READWRITE, @op) then begin PCrtPVoidTarget := pointer(fi.FarCalls[i1].PPTarget); PCrtOldPVoid := PCrtPVoidTarget^; PCrtPVoidTarget^ := PCrtHookBuf; VirtualProtect(fi.FarCalls[i1].PPTarget, sizeOf(pointer), op, @op); end; VirtualProtect(PCrtHookBuf, sizeOf(pointer), PAGE_EXECUTE_READ, @op); end else if VirtualProtect(fi.FarCalls[i1].PTarget, sizeOf(pointer), PAGE_EXECUTE_READWRITE, @op) then begin PCrtPVoidTarget := fi.FarCalls[i1].PTarget; PCrtOldPVoid := PCrtPVoidTarget^; PCrtPVoidTarget^ := fi.FarCalls[i1].Target; VirtualProtect(fi.FarCalls[i1].PTarget, sizeOf(pointer), op, @op); end; result := (PCrtPVoidTarget <> nil) or (PCrtIntTarget <> nil); CsrClientCallServerHooked := result; break; end; end; end; procedure UnpatchCreateRemoteThread; var localPCrtIntTarget : ^integer; localPCrtPVoidTarget : ^pointer; var op : dword; begin localPCrtIntTarget := pointer(PCrtIntTarget); localPCrtPVoidTarget := pointer(PCrtPVoidTarget); PCrtIntTarget := nil; PCrtPVoidTarget := nil; if (localPCrtIntTarget <> nil) and VirtualProtect(localPCrtIntTarget, sizeOf(integer), PAGE_EXECUTE_READWRITE, @op) then begin localPCrtIntTarget^ := PCrtOldInt; VirtualProtect(localPCrtIntTarget, sizeOf(integer), op, @op); end; if (localPCrtPVoidTarget <> nil) and VirtualProtect(localPCrtPVoidTarget, sizeOf(pointer), PAGE_EXECUTE_READWRITE, @op) then begin localPCrtPVoidTarget^ := PCrtOldPVoid; VirtualProtect(localPCrtPVoidTarget, sizeOf(pointer), op, @op); end; CsrClientCallServerHooked := false; end; {$ifdef win64} var Kernel32APIs : array [0..14] of pointer = (nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); KernelAPIsInitialized : boolean = false; function GetKernelAPI(index: integer) : dword; begin result := dword(Kernel32APIs[index]); end; function GetPeb32(processHandle: THandle) : dword; // retrieve the 32bit PEB of some 32bit process from within our 64bit process var peb32 : NativeUInt; begin result := 0; if @NtQueryInformationProcess = nil then NtQueryInformationProcess := NtProc(CNtQueryInformationProcess); if (@NtQueryInformationProcess <> nil) and (NtQueryInformationProcess(processHandle, TNtProcessInfoClass(26), @peb32, sizeOf(peb32), nil) = 0) then result := dword(peb32); end; function GetSystemWow64DirectoryW(buf: PWideChar; size: dword) : dword; stdcall; external kernel32; function GetRemoteModuleHandle32(processHandle: THandle; const dllName: UnicodeString; dllFullPath: PWideChar) : HMODULE; // retrieve the module handle and full file path of a 32bit module in a remote 32bit process var peb : dword; ldr, loopEnd : dword; mi : array [0..8] of dword; c1 : NativeUInt; begin result := 0; InitRemoteProcs; try // first let's get the 32bit PEB (Process Environment Block) peb := GetPeb32(processHandle); if peb <> 0 then begin // we got it, now let's get the loader data if ReadProcessMemory(processHandle, pointer(peb + $0c), @ldr, 4, c1) and (c1 = 4) and ReadProcessMemory(processHandle, pointer(ldr + $14), @loopEnd, 4, c1) and (c1 = 4) and ReadProcessMemory(processHandle, pointer(loopEnd ), @mi, 36, c1) and (c1 = 36) then begin while (mi[0] <> loopEnd) and ReadProcessMemory(processHandle, pointer(mi[0]), @mi, 36, c1) and (c1 = 36) do begin // mi[0] = pointer to next dll // mi[4] = dll handle // mi[8] = full dll file name if (mi[8] <> 0) and ReadProcessMemory(processHandle, pointer(mi[8]), dllFullPath, MAX_PATH * 2, c1) and (c1 = MAX_PATH * 2) and IsTextEqualW(dllName, ExtractFileNameW(dllFullPath)) then begin // found the dll we're looking for GetSystemWow64DirectoryW(dllFullPath, MAX_PATH); lstrcatW(dllFullPath, '\'); lstrcatW(dllFullPath, PWideChar(dllName)); result := mi[4]; break; end; end; end; end; except end; end; function GetImageProcAddressesRaw(moduleFileName: UnicodeString; dll: HMODULE; const apiNames: array of AnsiString; procAddresses: TPAPointer; apiCount: integer) : boolean; var fh : THandle; map : THandle; buf : pointer; nh : PImageNtHeaders32; ed : PImageExportDirectory; va : dword; i1, i2 : integer; begin result := false; fh := CreateFileW(PWideChar(moduleFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); if fh <> INVALID_HANDLE_VALUE then begin map := CreateFileMapping(fh, nil, PAGE_READONLY, 0, 0, nil); if map <> 0 then begin buf := MapViewOfFile(map, FILE_MAP_READ, 0, 0, 0); if buf <> nil then begin nh := GetImageNtHeaders(HMODULE(buf)); if nh <> nil then begin if nh.OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC then va := PImageNtHeaders64(nh).OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress else va := nh.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress; ed := pointer(NativeUInt(buf) + VirtualToRaw(nh, va)); if ed <> nil then begin for i1 := 0 to ed.NumberOfNames - 1 do for i2 := 0 to apiCount - 1 do if apiNames[i2] = PAnsiChar(NativeUInt(buf) + VirtualToRaw(nh, TPACardinal(NativeUInt(buf) + VirtualToRaw(nh, ed.AddressOfNames))[i1])) then begin procAddresses[i2] := pointer(dll + TPACardinal(NativeUInt(buf) + VirtualToRaw(nh, ed.AddressOfFunctions))[TPAWord(NativeUInt(buf) + VirtualToRaw(nh, ed.AddressOfNameOrdinals))[i1]]); result := true; break; end; if result then for i1 := 0 to ApiCount - 1 do if procAddresses[i1] = nil then begin result := false; break; end; end; end; UnmapViewOfFile(buf); end; CloseHandle(map); end; CloseHandle(fh); end; end; function Init32bitKernelAPIs(processHandle: THandle) : boolean; var fileName : array [0..MAX_PATH] of WideChar; dll : HMODULE; apiNames : array [0..11] of AnsiString; begin if not KernelAPIsInitialized then begin dll := GetRemoteModuleHandle32(processHandle, 'kernel32.dll', fileName); if dll <> 0 then begin apiNames[ 0] := DecryptStr(CGetVersion ); apiNames[ 1] := DecryptStr(CVirtualFree ); apiNames[ 2] := DecryptStr(CSetErrorMode ); apiNames[ 3] := DecryptStr(CLoadLibraryW ); apiNames[ 4] := DecryptStr(CGetLastError ); apiNames[ 5] := DecryptStr(CGetModuleHandleW ); apiNames[ 6] := DecryptStr(CGetCurrentProcessId); apiNames[ 7] := DecryptStr(COpenFileMappingA ); apiNames[ 8] := DecryptStr(CMapViewOfFile ); apiNames[ 9] := DecryptStr(CUnmapViewOfFile ); apiNames[10] := DecryptStr(CCloseHandle ); apiNames[11] := DecryptStr(CFreeLibrary ); if GetImageProcAddressesRaw(fileName, dll, apiNames, @Kernel32APIs[0], 12) then begin dll := GetRemoteModuleHandle32(processHandle, 'ntdll.dll', fileName); if dll <> 0 then begin apiNames[0] := DecryptStr(CRtlEnterCriticalSection); apiNames[1] := DecryptStr(CRtlLeaveCriticalSection); apiNames[2] := DecryptStr(CRtlExitUserThread ); if not GetImageProcAddressesRaw(fileName, dll, apiNames, @Kernel32APIs[12], 3) then Kernel32APIs[0] := nil; end else Kernel32APIs[0] := nil; end else Kernel32APIs[0] := nil; end; KernelAPIsInitialized := (Kernel32APIs[0] <> nil) and (Kernel32APIs[12] <> nil); end; result := KernelApisInitialized; end; {$endif} type PROCESS_BASIC_INFORMATION = record exitStatus : NativeUInt; pebBaseAddress : NativeUInt; affinityMask : NativeUInt; basePriority : NativeUInt; pid : NativeUInt; parentPid : NativeUInt; end; PROCESS_EXTENDED_BASIC_INFORMATION = record Size : NativeUInt; BasicInfo : PROCESS_BASIC_INFORMATION; Flags : dword; end; function GetPeb(process: THandle) : NativeUInt; // get the process environment block ("peb") var pbi : PROCESS_BASIC_INFORMATION; begin if @NtQueryInformationProcess = nil then NtQueryInformationProcess := NtProc(CNtQueryInformationProcess); if (@NtQueryInformationProcess <> nil) and (NtQueryInformationProcess(process, ProcessBasicInformation, @pbi, sizeOf(pbi), nil) = 0) then result := pbi.pebBaseAddress else result := 0; end; function GetRemoteModuleHandle(processHandle: THandle; is32bit: boolean; const dllName: UnicodeString) : HMODULE; var peb : NativeUInt; ldr32, loopEnd32 : dword; mi32 : array [0..8] of dword; {$ifdef win64} ldr64, loopEnd64 : NativeUInt; mi64 : array [0..8] of NativeUInt; {$endif} c1 : NativeUInt; arrCh : PWideChar; begin result := 0; InitRemoteProcs; arrCh := pointer(LocalAlloc(LPTR, MAX_PATH * 2)); if arrCh <> nil then begin try if is32bit then begin // first let's get the 32bit PEB (Process Environment Block) {$ifdef win64} peb := GetPeb32(processHandle); {$else} peb := GetPeb(processHandle); {$endif} if peb <> 0 then begin // we got it, now let's get the loader data if ReadProcessMemory(processHandle, pointer(peb + $0c), @ldr32, 4, c1) and (c1 = 4) and ReadProcessMemory(processHandle, pointer(ldr32 + $14), @loopEnd32, 4, c1) and (c1 = 4) and ReadProcessMemory(processHandle, pointer(loopEnd32 ), @mi32, 36, c1) and (c1 = 36) then begin while (mi32[0] <> loopEnd32) and ReadProcessMemory(processHandle, pointer(mi32[0]), @mi32, 36, c1) and (c1 = 36) do begin // mi[0] = pointer to next dll // mi[4] = dll handle // mi[8] = full dll file name if (mi32[8] <> 0) and ReadProcessMemory(processHandle, pointer(mi32[8]), arrCh, MAX_PATH * 2, c1) and (c1 = MAX_PATH * 2) and IsTextEqualW(dllName, ExtractFileNameW(arrCh)) then begin // found the dll we're looking for result := mi32[4]; break; end; end; end; end; end else begin {$ifdef win64} // first let's get the 64bit PEB (Process Environment Block) peb := GetPeb(processHandle); if peb <> 0 then begin // we got it, now let's get the loader data if ReadProcessMemory(processHandle, pointer(peb + $18), @ldr64, 8, c1) and (c1 = 8) and ReadProcessMemory(processHandle, pointer(ldr64 + $20), @loopEnd64, 8, c1) and (c1 = 8) and ReadProcessMemory(processHandle, pointer(loopEnd64 ), @mi64, 72, c1) and (c1 = 72) then begin while (mi64[0] <> loopEnd64) and ReadProcessMemory(processHandle, pointer(mi64[0]), @mi64, 72, c1) and (c1 = 72) do begin // mi[0] = pointer to next dll // mi[4] = dll handle // mi[8] = full dll file name if (mi64[8] <> 0) and ReadProcessMemory(processHandle, pointer(mi64[8]), arrCh, MAX_PATH * 2, c1) and (c1 = MAX_PATH * 2) and IsTextEqualW(dllName, ExtractFileNameW(arrCh)) then begin // found the dll we're looking for result := mi64[4]; break; end; end; end; end; {$endif} end; except end; LocalFree(HLOCAL(arrCh)); end; end; function GetRemoteProcAddresses(processHandle: THandle; is32bit: boolean; const dllName: UnicodeString; const apiNames: array of AnsiString; procAddresses: TPAPointer; apiCount: integer) : boolean; var dll : HMODULE; nh : TImageNtHeaders32; ed : PImageExportDirectory; i1, i2 : integer; c1 : NativeUInt; c2 : dword; offset : NativeUInt; addr, size : dword; begin result := false; InitRemoteProcs; dll := GetRemoteModuleHandle(processHandle, is32bit, dllName); if (dll <> 0) and ReadProcessMemory(processHandle, pointer(dll + CENEWHDR), @c2, sizeOf(c2), c1) and (c1 = sizeOf(c2)) and ReadProcessMemory(processHandle, pointer(dll + c2 ), @nh, sizeOf(nh), c1) and (c1 = sizeOf(nh)) and (nh.Signature = CPEMAGIC) then begin if nh.OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC then begin addr := PImageOptionalHeader64(@nh.OptionalHeader).DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress; size := PImageOptionalHeader64(@nh.OptionalHeader).DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size; end else begin addr := nh.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress; size := nh.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size; end; ed := pointer(LocalAlloc(LPTR, size)); if ed <> nil then begin if ReadProcessMemory(processHandle, pointer(dll + addr), ed, size, c1) and (c1 = size) then begin offset := NativeUInt(ed) - addr; if (ed.AddressOfNames >= addr) and (ed.AddressOfNames + dword(ed.NumberOfNames) * 4 < addr + size) and (ed.AddressOfFunctions >= addr) and (ed.AddressOfFunctions + dword(ed.NumberOfNames) * 4 < addr + size) and (ed.AddressOfNameOrdinals >= addr) and (ed.AddressOfNameOrdinals + dword(ed.NumberOfNames) * 4 < addr + size) then for i1 := 0 to ed.NumberOfNames - 1 do for i2 := 0 to apiCount - 1 do if (TPACardinal(offset + ed.AddressOfNames)[i1] >= addr) and (TPACardinal(offset + ed.AddressOfNames)[i1] < addr + size) and (apiNames[i2] = PAnsiChar(offset + TPACardinal(offset + ed.AddressOfNames)[i1])) then begin procAddresses[i2] := pointer(dll + TPACardinal(offset + ed.AddressOfFunctions)[TPAWord(offset + ed.AddressOfNameOrdinals)[i1]]); result := true; break; end; if result then for i1 := 0 to ApiCount - 1 do if procAddresses[i1] = nil then begin result := false; break; end; end; LocalFree(HLOCAL(ed)); end; end; end; {$endif} {$ifndef dynamic} function GetKernelObjectSecurity(handle: THandle; requestedInfo: NativeUInt; sd: PSecurityDescriptor; size: dword; var sizeNeeded: dword) : bool; stdcall; external advapi32; {$endif} {$ifdef dynamic} procedure UnpatchCreateRemoteThread; begin end; function GetRemoteModuleHandle(processHandle: THandle; is32bit: boolean; const dllName: UnicodeString) : HMODULE; begin result := 0; end; function GetRemoteProcAddresses(processHandle: THandle; is32bit: boolean; const dllName: UnicodeString; const apiNames: array of AnsiString; procAddresses: TPAPointer; apiCount: integer) : boolean; begin result := false; end; {$endif} function CreateRemoteThreadEx(processHandle : THandle; threadAttr : PSecurityAttributes; stackSize : integer; startAddr : pointer; params : pointer; creationFlags : dword; var threadId : dword ) : THandle; stdcall; {$ifndef dynamic} {$ifndef win64} function FindPCurP9xPid(const fi: TFunctionInfo) : TPPointer; function CheckPCurP9xPid(PCurP9xPid: dword) : boolean; var c1 : dword; begin result := TryRead(TPPointer(PCurP9xPid)^, @c1, 4) and TryRead(pointer(c1), @c1, 4) and (c1 = GetCurrentProcessID xor Magic); end; var i1, i2 : integer; begin result := nil; for i1 := high(fi.FarCalls) downto 0 do for i2 := i1 - 1 downto 0 do if (fi.FarCalls[i1].Target = fi.FarCalls[i2].Target) and CheckPCurP9xPid(dword(fi.FarCalls[i1].CodeAddr1) - 6) then begin result := pointer(dword(fi.FarCalls[i1].CodeAddr1) - 6); exit; end; end; function Is16BitProcess(processID: dword) : boolean; begin result := false; if GetVersion and $80000000 <> 0 then try result := TPACardinal(processID xor Magic)^[8] and $18 <> 0; except end; end; {$endif} function GetSessionId(processId: dword) : dword; var pid2sid : function (processId: dword; var sessionId: dword) : bool; stdcall; begin pid2sid := KernelProc(CProcessIdToSessionId); if (@pid2sid = nil) or (not pid2sid(processId, result)) then result := 0; end; type TExitThreadFrame = packed record pushParam : dword; // 042474ff push dword ptr [esp+4] movEaxThreadProc : packed record opcode : byte; // b8 mov eax, threadProc threadProc : dword; end; callThreadProc : word; // d0ff call eax pushResult : byte; // 50 push eax pushDummy : byte; // 50 push eax pushMemRelease : packed record opcode : byte; // 68 push MEM_RELEASE memRelease : dword; end; pushSize : word; // 006a push 0 pushAddr : packed record opcode : byte; // 68 push frameAddr frameAddr : dword; end; pushExitThread : packed record opcode : byte; // 68 push @ExitThread exitThread : dword; end; movEaxVirtualFree : packed record opcode : byte; // b8 mov eax, @VirtualFree virtualFree : dword; end; jmpVirtualFree : word; // e0ff jmp eax end; const CExitThreadFrame : TExitThreadFrame = ( pushParam : $042474ff; movEaxThreadProc : (opcode: $b8); callThreadProc : $d0ff; pushResult : $50; pushDummy : $50; pushMemRelease : (opcode: $68; memRelease: MEM_RELEASE); pushSize : $006a; pushAddr : (opcode: $68); pushExitThread : (opcode: $68); movEaxVirtualFree : (opcode: $b8); jmpVirtualFree : $e0ff; ); const STACK_SIZE_PARAM_IS_A_RESERVATION = $10000; var c1 : dword; c2 : NativeUInt; h1, h2 : THandle; {$ifdef win64} ctxt : TContext; bts : pointer; {$else} i1 : integer; ci : TCodeInfo; p1 : pointer; proc2 : pointer; pp1 : TPPointer; pid : dword; k97 : procedure (param: dword); stdcall; k98 : procedure (param: dword); stdcall; ppid : pointer; fi : TFunctionInfo; proc1 : function (threadAttr : PSecurityAttributes; stackSize : integer; startAddr : pointer; params : pointer; crFlags : dword; var tid : dword ) : THandle; stdcall; rt9x : ^T9xRemoteThread; {$endif} client : array [0..1] of NativeUInt; rcut : function (processHandle : THandle; securityDescr : PSecurityDescriptor; createSuspended : NativeUInt; stackZeroBits : NativeUInt; var stackReserved : NativeUInt; var stackCommit : NativeUInt; startAddress : pointer; parameter : pointer; var threadHandle : THandle; clientID : pointer) : integer; stdcall; psd : PSecurityDescriptor; ssr : NativeUInt; ssc : NativeUInt; sa : TSecurityAttributes; sd : PSecurityDescriptor; etf : TExitThreadFrame; petf : ^TExitThreadFrame; op : dword; begin {$ifndef win64} if GetVersion and $80000000 <> 0 then begin result := 0; if (processHandle <> 0) and (processHandle <> INVALID_HANDLE_VALUE) then begin pid := ProcessHandleToId(processHandle); if (pid <> 0) and (pid <> Magic) and (not Is16BitProcess(pid)) then begin SetLastError(ERROR_CALL_NOT_IMPLEMENTED); pid := pid xor Magic; ppid := @pid; fi := ParseFunction(KernelProc(CCreateThread, true)); if Length(fi.CodeAreas) >= 7 then begin fi := ParseFunction(fi.CodeAreas[high(fi.CodeAreas) - 4].AreaBegin); if (fi.CodeLen < 200) and (Length(fi.FarCalls) >= 5) and (fi.FarCalls[high(fi.FarCalls)].Target = fi.FarCalls[high(fi.FarCalls) - 1].Target) then begin p1 := fi.EntryPoint; fi := ParseFunction(fi.FarCalls[high(fi.FarCalls) - 2].Target); if (fi.CodeLen < 500) and (FindPCurP9xPid(fi) <> nil) then begin proc2 := CopyFunction(fi.EntryPoint); try fi := ParseFunction(proc2); pp1 := FindPCurP9xPid(fi); if pp1 <> nil then begin pp1^ := @ppid; proc1 := CopyFunction(p1); try fi := ParseFunction(@proc1); with fi.FarCalls[high(fi.FarCalls) - 2] do begin NativeInt(PTarget^) := NativeInt(int64(NativeUInt(proc2)) - int64(NativeUInt(CodeAddr2))); for i1 := 0 to high(fi.CodeAreas) do if (NativeUInt(fi.CodeAreas[i1].AreaBegin) < NativeUInt(CodeAddr1)) and (NativeUInt(fi.CodeAreas[i1].AreaEnd ) > NativeUInt(CodeAddr1)) and (TPWord(fi.CodeAreas[i1].AreaBegin)^ = $086a) then begin // push $08 TPWord(fi.CodeAreas[i1].AreaBegin)^ := $186a; // push $18 break; end; end; if stackSize = 0 then stackSize := integer($ffffd000) else if stackSize > 0 then stackSize := -stackSize; // -> shared stack rt9x := AllocMemEx(sizeOf(rt9x^)); rt9x^.proc := startAddr; rt9x^.param := params; c1 := 0; c2 := 0; ci := ParseCode(KernelProc(CDebugActiveProcess, true)); for i1 := 1 to 10 do begin if ci.Opcode = $a1 then begin if c1 <> 0 then begin c2 := TPCardinal(NativeUInt(ci.This) + 1)^; break; end else c1 := TPCardinal(NativeUInt(ci.This) + 1)^; end; ci := ParseCode(ci.Next); end; if (c1 <> 0) or (c2 <> 0) then begin k97 := GetImageProcAddress(kernel32handle, 97); k98 := GetImageProcAddress(kernel32handle, 98); if (@k97 <> nil) and (@k98 <> nil) then begin if c1 <> 0 then k97(TPCardinal(c1)^); if c2 <> 0 then k97(TPCardinal(c2)^); end; end else begin k97 := nil; k98 := nil; end; try if Init9xRemoteThread(rt9x^.closeProc, p1) and (TPCardinal(pid + $20)^ and $30800000 = 0) then result := proc1(threadAttr, stackSize, p1, rt9x, creationFlags, threadId); finally if (@k97 <> nil) and (@k98 <> nil) then begin if c2 <> 0 then k98(TPCardinal(c2)^); if c1 <> 0 then k98(TPCardinal(c1)^); end; end; if result = 0 then FreeMemEx(rt9x); finally FreeMemEx(@proc1) end; end; finally FreeMemEx(proc2) end; end; end; end; end else SetLastError(ERROR_INVALID_PARAMETER); end else SetLastError(ERROR_INVALID_PARAMETER); end else begin {$endif} sd := nil; if (threadAttr = nil) and DuplicateHandle(GetCurrentProcess, GetCurrentThread, GetCurrentProcess, @h1, 0, false, DUPLICATE_SAME_ACCESS) then begin c1 := 0; GetKernelObjectSecurity(h1, 4, nil, 0, c1); if c1 > 0 then begin GetMem(sd, c1 * 2); if GetKernelObjectSecurity(h1, 4, sd, c1 * 2, c1) then begin sa.nLength := sizeOf(sa); sa.lpSecurityDescriptor := sd; sa.bInheritHandle := false; threadAttr := @sa; end; end; CloseHandle(h1); end; InitRemoteProcs; PatchCreateRemoteThread; result := CreateRemoteThread(processHandle, threadAttr, stackSize, startAddr, params, creationFlags, threadId); if result = 0 then begin // CreateRemoteThread failed; this can happen in two situations: // (1) for processes in other sessions // (2) for CSRSS processes in Windows 8 // In both those situations RtlCreateUserThread works. rcut := NtProc(CRtlCreateUserThread); if @rcut <> nil then begin h2 := 0; if threadAttr <> nil then psd := threadAttr^.lpSecurityDescriptor else psd := nil; ssr := 0; ssc := 0; if stackSize <> 0 then if creationFlags and STACK_SIZE_PARAM_IS_A_RESERVATION <> 0 then ssr := stackSize else ssc := stackSize; {$ifdef win64} if Is64bitProcess(processHandle) then begin client[0] := 0; client[1] := 0; bts := KernelProc(CBaseThreadStart); if bts <> nil then begin // in older x64 OSs we have to use BaseThreadStart, see below if rcut(processHandle, psd, 1, 0, ssr, ssc, bts, params, h2, @client) >= 0 then begin ZeroMemory(@ctxt, sizeOf(TContext)); ctxt.ContextFlags := CONTEXT_CONTROL or CONTEXT_INTEGER; if GetThreadContext(h2, ctxt) then begin // we have to end threads created by RtlCreateUserThread with an ExitThread call // in 64bit Windows we're using kernel32.BaseThreadStart for this purpose // this is a wrapper function which calls a thread function and afterwards ExitThread // BaseThreadStart is internally used by Create(Remote)Thread for the same purpose // fortunately BaseThreadStart is exported in 64bit Windows (unlike 32bit Windows) // BaseThreadStart wants two parameters, namely the thread function and the parameter ctxt.Rsp := ctxt.Rsp - $30; ctxt.Rcx := NativeUInt(startAddr); ctxt.Rdx := NativeUInt(params); if SetThreadContext(h2, ctxt) then begin result := h2; if creationFlags and CREATE_SUSPENDED = 0 then ResumeThread(h2); end else begin TerminateThread(h2, 0); CloseHandle(h2); h2 := 0; end; end else begin TerminateThread(h2, 0); CloseHandle(h2); h2 := 0; end; threadId := client[1]; end; end else // In newer x64 OSs BaseThreadStart does not exist, anymore, or at // at least it's not exported. On a positive note, it seems we don't // have to end threads with a manual ExitThread call, anymore, either. // So the code is much simpler. if rcut(processHandle, psd, 0, 0, ssr, ssc, startAddr, params, h2, @client) >= 0 then begin result := h2; threadId := client[1]; end; end else {$endif} begin {$ifdef win64} petf := AllocMemEx(sizeOf(etf), processHandle, X86AllocationAddress); {$else} petf := AllocMemEx(sizeOf(etf), processHandle); {$endif} if petf <> nil then begin // unfortunately RtlCreateUserThread threads must end with ExitThread // so we write a little frame to the target process // this frame internally calls the original thread procedure // afterwards it frees itself and then calls ExitThread // CAUTION: if the original thread procedure calls ExitThread then we get a memory leak etf := CExitThreadFrame; with etf do begin movEaxThreadProc.threadProc := dword(startAddr); pushAddr.frameAddr := dword(petf); {$ifdef win64} if Init32bitKernelAPIs(processHandle) then begin pushExitThread.exitThread := dword(kernel32APIs[14]); movEaxVirtualFree.virtualFree := dword(kernel32APIs[1]); end else begin FreeMemEx(petf, processHandle); petf := nil; end; {$else} pushExitThread.exitThread := dword(KernelProc(CExitThread, true)); movEaxVirtualFree.virtualFree := dword(KernelProc(CVirtualFree, true)); {$endif} end; if petf <> nil then if WriteProcessMemory(processHandle, petf, @etf, sizeOf(etf), c2) and (rcut(processHandle, psd, creationFlags and CREATE_SUSPENDED, 0, ssr, ssc, petf, params, h2, @client) >= 0) then begin result := h2; threadId := client[1]; VirtualProtectEx(processHandle, petf, sizeOf(etf), PAGE_EXECUTE_READ, @op); end else FreeMemEx(petf, processHandle); end; end; end; end; FreeMem(sd); {$ifndef win64} end; {$endif} {$else} begin if GetMadCHookApi('CreateRemoteThreadEx', @CreateRemoteThreadExProc) then result := CreateRemoteThreadExProc(processHandle, threadAttr, stackSize, startAddr, params, creationFlags, threadId) else result := 0; {$endif} end; function madCreateRemoteThread(processHandle : THandle; threadAttr : PSecurityAttributes; stackSize : integer; startAddr : pointer; params : pointer; creationFlags : dword; var threadId : dword ) : THandle; stdcall; begin result := CreateRemoteThreadEx(processHandle, threadAttr, stackSize, startAddr, params, creationFlags, threadId); end; // *************************************************************** function RemoteExecute(processHandle : THandle; func : TRemoteExecuteFunction; var funcResult : dword; params : pointer = nil; size : dword = 0 ) : bool; stdcall; {$ifndef dynamic} var buf, proc, par : pointer; h1 : THandle; c1 : NativeUInt; dw1 : dword; p1 : pointer; op : dword; begin result := false; proc := CopyFunction(@func, processHandle, false, @buf); if proc <> nil then try par := AllocMemEx(size, processHandle); VirtualProtectEx(processHandle, par, size, PAGE_READWRITE, @op); try if (size = 0) or WriteProcessMemory(processHandle, par, params, size, c1) then begin if par <> nil then p1 := par else p1 := params; h1 := CreateRemoteThreadEx(processHandle, nil, 0, proc, p1, 0, dw1); if h1 <> 0 then begin try WaitForSingleObject(h1, INFINITE); GetExitCodeThread(h1, funcResult); finally CloseHandle(h1) end; InitRemoteProcs; result := (size = 0) or IsBadWritePtr2(params, size) or ReadProcessMemory(processHandle, par, params, size, c1); end; end; finally FreeMemEx(par, processHandle) end; finally FreeMemEx(buf, processHandle) end; {$else} begin result := GetMadCHookApi('RemoteExecute', @RemoteExecuteProc) and RemoteExecuteProc(processHandle, func, funcResult, params, size); {$endif} end; // *************************************************************** {$ifndef win64} {$ifndef dynamic} type T9xHandleTable = packed record itemCount : integer; items : array [0..maxInt shr 3 - 1] of packed record access : dword; objAddr : TPByte; end; end; {$endif} {$endif} function ProcessHandleToId(processHandle: THandle) : dword; stdcall; {$ifndef dynamic} const PROCESS_QUERY_LIMITED_INFORMATION = $1000; type TNtProcessBasicInfo = packed record exitStatus : NativeUInt; pebBaseAddress : pointer; affinityMask : NativeUInt; basePriority : NativeUInt; pid : NativeUInt; parentPid : NativeUInt; end; var {$ifndef win64} ht : ^T9xHandleTable; {$endif} c1 : dword; pbi : TNtProcessBasicInfo; ph : THandle; begin result := 0; if processHandle = GetCurrentProcess then result := GetCurrentProcessId else {$ifndef win64} if GetVersion and $80000000 <> 0 then begin try ht := TPAPointer(GetCurrentProcessID xor Magic)^[17]; except ht := nil end; if ht <> nil then begin if Magic95 then c1 := processHandle else c1 := processHandle div 4; if int64(c1) < int64(ht^.itemCount) then begin try if (ht^.items[c1].objAddr <> nil) and (ht^.items[c1].objAddr^ = TPByte(GetCurrentProcessID xor Magic)^) then result := dword(ht^.items[c1].objAddr) xor Magic; except result := 0 end; end else SetLastError(ERROR_INVALID_PARAMETER); end; end else {$endif} begin if (not DuplicateHandle(GetCurrentProcess, processHandle, GetCurrentProcess, @ph, PROCESS_QUERY_INFORMATION, false, 0)) and (not DuplicateHandle(GetCurrentProcess, processHandle, GetCurrentProcess, @ph, PROCESS_QUERY_LIMITED_INFORMATION, false, 0)) then // vista specific ph := processHandle; if @GetProcessId = nil then GetProcessId := KernelProc(CGetProcessId); if @GetProcessId <> nil then begin result := GetProcessId(ph); if result = 0 then result := GetProcessId(processHandle); end else begin ZeroMemory(@pbi, sizeOf(TNtProcessBasicInfo)); if @NtQueryInformationProcess = nil then NtQueryInformationProcess := NtProc(CNtQueryInformationProcess); if @NtQueryInformationProcess <> nil then begin c1 := NtQueryInformationProcess(ph, ProcessBasicInformation, @pbi, sizeOf(TNtProcessBasicInfo), nil); if c1 <> 0 then c1 := NtQueryInformationProcess(processHandle, ProcessBasicInformation, @pbi, sizeOf(TNtProcessBasicInfo), nil); if c1 = 0 then result := pbi.pid else SetLastError(c1); end else SetLastError(ERROR_CALL_NOT_IMPLEMENTED); end; if ph <> processHandle then CloseHandle(ph); end; {$else} begin if GetMadCHookApi('ProcessHandleToId', @ProcessHandleToIdProc) then result := ProcessHandleToIdProc(processHandle) else result := 0; {$endif} end; function ThreadHandleToId(threadHandle: THandle) : dword; stdcall; {$ifndef dynamic} type TThreadBasicInfo = record exitStatus : dword; teb : pointer; processId : NativeUInt; threadId : NativeUInt; affinityMask : NativeUInt; basePriority : dword; difProcessPriority : dword; end; const THREAD_QUERY_INFORMATION = $40; THREAD_QUERY_LIMITED_INFORMATION = $800; var {$ifndef win64} ht : ^T9xHandleTable; {$endif} c1 : dword; tbi : TThreadBasicInfo; th : THandle; begin result := 0; if threadHandle = GetCurrentThread then result := GetCurrentThreadId else {$ifndef win64} if GetVersion and $80000000 <> 0 then begin try ht := TPAPointer(GetCurrentProcessID xor Magic)^[17]; except ht := nil end; if ht <> nil then begin if Magic95 then c1 := threadHandle else c1 := threadHandle div 4; if int64(c1) < int64(ht^.itemCount) then begin try if (ht^.items[c1].objAddr <> nil) and (ht^.items[c1].objAddr^ = TPByte(GetCurrentThreadID xor Magic)^) then result := dword(ht^.items[c1].objAddr) xor Magic; except result := 0 end; end else SetLastError(ERROR_INVALID_PARAMETER); end; end else {$endif} begin if (not DuplicateHandle(GetCurrentProcess, threadHandle, GetCurrentProcess, @th, THREAD_QUERY_INFORMATION, false, 0)) and (not DuplicateHandle(GetCurrentProcess, threadHandle, GetCurrentProcess, @th, THREAD_QUERY_LIMITED_INFORMATION, false, 0)) then // vista specific th := threadHandle; if @GetThreadId = nil then GetThreadId := KernelProc(CGetThreadId); if @GetThreadId <> nil then begin result := GetThreadId(th); if result = 0 then result := GetThreadId(threadHandle); end else begin ZeroMemory(@tbi, sizeOf(tbi)); if @NtQueryInformationThread = nil then NtQueryInformationThread := NtProc(CNtQueryInformationThread); if @NtQueryInformationThread <> nil then begin c1 := NtQueryInformationThread(th, ThreadBasicInformation, @tbi, sizeOf(tbi), @c1); if c1 <> 0 then c1 := NtQueryInformationThread(threadHandle, ThreadBasicInformation, @tbi, sizeOf(tbi), @c1); if c1 = 0 then result := tbi.threadId else SetLastError(c1); end else SetLastError(ERROR_CALL_NOT_IMPLEMENTED); end; if th <> threadHandle then CloseHandle(th); end; {$else} begin if GetMadCHookApi('ThreadHandleToId', @ThreadHandleToIdProc) then result := ThreadHandleToIdProc(threadHandle) else result := 0; {$endif} end; // *************************************************************** initialization finalization {$ifdef dynamic} if (madCHookDll <> 0) and (madCHookDll <> HMODULE(-1)) then begin FreeLibrary(madCHookDll); madCHookDll := 0; end; {$else} UnpatchCreateRemoteThread; {$endif} end.