BSOne.SFC/Tocsg.Module/Bs1Flt/MTPMon/dist/_madCodeHook/madRemote.pas

2347 lines
99 KiB
Plaintext

// ***************************************************************
// 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.