unit ProcessUtils
{platform};
interface
uses
Windows;
function GetProcessId(Process: THandle): DWORD
stdcall;
implementation
{$ALIGN 8}
{$MINENUMSIZE 4}
{$WRITEABLECONST ON}
//
// Windows 9x
//
function GetObsfucator(): DWORD;
asm
call GetCurrentThreadId
push eax
call GetCurrentProcessId
xor edx, edx
xor eax, fs:[edx + 30h]
pop ecx
xor ecx, eax
sub ecx, fs:[edx + 18h]
add ecx, 08h
jecxz @@done
add ecx, 08h
jecxz @@done
xor eax, eax
@@done:
end;
//
// Windows NT
//
type
PProcessInfoClass = ^TProcessInfoClass;
TProcessInfoClass = (
ProcessBasicInformation,
ProcessQuotaLimits,
ProcessIoCounters,
ProcessVmCounters,
ProcessTimes,
ProcessBasePriority,
ProcessRaisePriority,
ProcessDebugPort,
ProcessExceptionPort,
ProcessAccessToken,
ProcessLdtInformation,
ProcessLdtSize,
ProcessDefaultHardErrorMode,
ProcessIoPortHandlers,
ProcessPooledUsageAndLimits,
ProcessWorkingSetWatch,
ProcessUserModeIOPL,
ProcessEnableAlignmentFaultFixup,
ProcessPriorityClass,
ProcessWx86Information,
ProcessHandleCount,
ProcessAffinityMask,
ProcessPriorityBoost,
ProcessDeviceMap,
ProcessSessionInformation,
ProcessForegroundInformation,
ProcessWow64Information,
ProcessImageFileName,
ProcessLUIDDeviceMapsEnabled,
ProcessBreakOnTermination,
ProcessDebugObjectHandle,
ProcessDebugFlags,
ProcessHandleTracing,
ProcessIoPriority,
ProcessExecuteFlags,
ProcessResourceManagement,
ProcessCookie,
ProcessImageInformation,
MaxProcessInfoClass
);
type
PProcessBasicInformation = ^TProcessBasicInformation;
TProcessBasicInformation =
record
ExitStatus : LongInt;
PebBaseAddress : Pointer;
AffinityMask : Cardinal;
BasePriority : LongInt;
UniqueProcessId : Cardinal;
InheritedFromUniqueProcessId: Cardinal;
end;
function NtQueryInformationProcess(ProcessHandle: THandle;
ProcessInformationClass: TProcessInfoClass; ProcessInformation: Pointer;
ProcessInformationLength: ULONG; ReturnLength: PULONG): LongInt
stdcall;
type
TFNNtQueryInformationProcess =
function(ProcessHandle: THandle;
ProcessInformationClass: TProcessInfoClass; ProcessInformation: Pointer;
ProcessInformationLength: ULONG; ReturnLength: PULONG): LongInt
stdcall;
const
FNNtQueryInformationProcess: TFNNtQueryInformationProcess =
nil;
begin
if not Assigned(FNNtQueryInformationProcess)
then
FNNtQueryInformationProcess := TFNNtQueryInformationProcess(
GetProcAddress(GetModuleHandle('
ntdll.dll'), '
NtQueryInformationProcess'));
if not Assigned(FNNtQueryInformationProcess)
then
Result := LongInt($C0000002)
// STATUS_NOT_IMPLEMENTED
else
Result := FNNtQueryInformationProcess(ProcessHandle,
ProcessBasicInformation, ProcessInformation, ProcessInformationLength,
ReturnLength);
end;
//
// Wrapper
//
function GetProcessId(Process: THandle): DWORD
stdcall;
type
TFNGetProcessId =
function(Process: THandle): DWORD
stdcall;
const
FNGetProcessId: TFNGetProcessId =
nil;
var
ExitCode: DWORD;
BasicInformation: TProcessBasicInformation;
begin
// Check for 'CurrentProcess' handle
if Process = GetCurrentProcess()
then
begin
Result := GetCurrentProcessId();
Exit;
end;
// Check for exported Win32 API...
if not Assigned(FNGetProcessId)
then
FNGetProcessId := TFNGetProcessId(
GetProcAddress(GetModuleHandle(kernel32), '
GetProcessId'));
if Assigned(FNGetProcessId)
then
Result := FNGetProcessId(Process)
else
// Try native versions
if (DWORD(GetVersion()) > DWORD($80000000))
then
begin
// Win9x
if GetExitCodeProcess(Process, ExitCode)
then // validate handle
Result := Process
xor GetObsfucator()
else
Result := 0;
end
else
// WinNT
if NtQueryInformationProcess(Process, ProcessBasicInformation,
@BasicInformation, SizeOf(TProcessBasicInformation),
nil) >= 0
then
Result := BasicInformation.UniqueProcessId
else
Result := 0;
end;
end.