[Delphi] Check if ASLR is enabled

[Agmcz]

Fix func ImageDynamicallyRelocated

unit uCheckASLR;

// Original C++ Source: https://stackoverflow.com/questions/47105480/how-to-check-if-aslr-is-enabled-for-a-process
// Ported to Delphi by Agmcz 28-12-2017 2:25:32
// Fix 08-04-2018 10:56:25
// Fix2 01-05-2018 2:28:15

interface

uses
  Windows;

function CheckASLR(dwProcessId: LongWord; out bASLR: Boolean): LongWord;

implementation

const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;

type
 TSectionImageInformation  = record
    TransferAddress: Pointer;
    ZeroBits: LongWord;
    MaximumStackSize: LongWord;
    CommittedStackSize: LongWord;
    SubSystemType: LongWord;
    MinorSubsystemVersion: Word;
    MajorSubsystemVersion: Word;
    GpValue: LongWord;
    ImageCharacteristics: Word;
    DllCharacteristics: Word;
    Machine: Word;
    ImageContainsCode: Boolean;
    ImageFlags: Byte;
    LoaderFlags: LongWord;
    ImageFileSize: LongWord;
    CheckSum: LongWord;
  end;

  PROCESSINFOCLASS = (
    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,
    ProcessTlsInformation,
    ProcessCookie,
    ProcessImageInformation,
    ProcessCycleTime,
    ProcessPagePriority,
    ProcessInstrumentationCallback,
    ProcessThreadStackAllocation,
    ProcessWorkingSetWatchEx,
    ProcessImageFileNameWin32,
    ProcessImageFileMapping,
    ProcessAffinityUpdateMode,
    ProcessMemoryAllocationMode,
    ProcessGroupInformation,
    ProcessTokenVirtualizationEnabled,
    ProcessConsoleHostProcess,
    ProcessWindowInformation,
    MaxProcessInfoClass);

type
  NTSTATUS = LongWord;

function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: PROCESSINFOCLASS; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG ): LongInt; stdcall; external 'ntdll.dll';
function RtlNtStatusToDosError(Status: NTSTATUS): Integer; stdcall; external 'ntdll.dll';

function ImageDynamicallyRelocated(sii: TSectionImageInformation): Boolean;
asm
  MOVZX EAX, BYTE PTR SS:[sii.ImageFlags]
  SHR AL, 2
  AND EAX, 1
end;

function CheckASLR(dwProcessId: LongWord; out bASLR: Boolean): LongWord;
var
 hProcess: THandle;
 sii: TSectionImageInformation;
 status: NTSTATUS;
begin
  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, dwProcessId);
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  begin
    status := NtQueryInformationProcess(hProcess, ProcessImageInformation, @sii, SizeOf(sii), 0);
    CloseHandle(hProcess);
    if 0 <= status then
    begin
      bASLR := ImageDynamicallyRelocated(sii);
      Result := NOERROR;
      Exit;
    end;
    Result := RtlNtStatusToDosError(status);
    Exit;
  end;
  Result := GetLastError;
end;

end.