Windows Delphi / IsDebugged Flag

Code

unit UntPEBDebug;

interface

uses Windows;

const PROCESS_QUERY_LIMITED_INFORMATION = $1000;
        PROCESS_BASIC_INFORMATION         = 0;

// https://docs.microsoft.com/en-us/windows/win32/api/winternl/nf-winternl-ntqueryinformationprocess
var _NtQueryInformationProcess : function(
                                            ProcessHandle : THandle;
                                            ProcessInformationClass : DWORD;
                                            ProcessInformation : Pointer;
                                            ProcessInformationLength :
                                            ULONG; ReturnLength : PULONG) : LongInt; stdcall;

    hNTDLL : THandle;


{$IFDEF WIN64}
type
    PProcessBasicInformation = ^TProcessBasicInformation;
    TProcessBasicInformation = record
    ExitStatus         : Int64;
    PebBaseAddress     : Pointer;
    AffinityMask       : Int64;
    BasePriority       : Int64;
    UniqueProcessId    : Int64;
    InheritedUniquePID : Int64;
    end;
{$ELSE}
type
    PProcessBasicInformation = ^TProcessBasicInformation;
    TProcessBasicInformation = record
    ExitStatus         : DWORD;
    PebBaseAddress     : Pointer;
    AffinityMask       : DWORD;
    BasePriority       : DWORD;
    UniqueProcessId    : DWORD;
    InheritedUniquePID : DWORD;
    end;
{$ENDIF}

function GetProcessDebugStatus(AProcessID : Cardinal; var ADebugStatus : boolean) : Boolean;
function SetProcessDebugStatus(AProcessID : Cardinal; ADebugStatus : Boolean) : Boolean;

implementation

{-------------------------------------------------------------------------------
    Open a process and retrieve the point of debug flag from PEB.

    If function succeed, don't forget to call close process handle.
-------------------------------------------------------------------------------}
function GetDebugFlagPointer(AProcessID : Cardinal; var AProcessHandle : THandle) : Pointer;
var PBI     : TProcessBasicInformation;
    ARetLen : Cardinal;
begin
    result := nil;
    ///

    AProcessHandle := 0;

    if NOT Assigned(_NtQueryInformationProcess) then
    Exit();
    ///

    AProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_WRITE or PROCESS_VM_READ, false, AProcessID);
    if (AProcessHandle = 0) then
    Exit;

    if _NtQueryInformationProcess(AProcessHandle, PROCESS_BASIC_INFORMATION, @PBI, sizeOf(TProcessBasicInformation), @ARetLen) = ERROR_SUCCESS then
    result := Pointer(NativeUInt(PBI.PebBaseAddress) + (SizeOf(Byte) * 2))
    else
    CloseHandle(AProcessHandle);
end;

{-------------------------------------------------------------------------------
    Retrieve the target process debug status from PEB.

    ADebugStatus = True  : Target process debug flag is set.
    ADebugStatus = False : Target process debug flag is not set.
-------------------------------------------------------------------------------}
function GetProcessDebugStatus(AProcessID : Cardinal; var ADebugStatus : boolean) : Boolean;
var hProcess         : THandle;

    pDebugFlagOffset : Pointer;
    pDebugFlag       : pByte;
    ABytesRead       : SIZE_T;
begin
    result := false;
    ///

    pDebugFlagOffset := GetDebugFlagPointer(AProcessID, hProcess);

    if not Assigned(pDebugFlagOffset) then
    Exit();
    ///
    try
    getMem(pDebugFlag, sizeOf(Byte));
    try
        if NOT ReadProcessMemory(hProcess, pDebugFlagOffset, pDebugFlag, sizeOf(Byte), ABytesRead) then
        Exit;

        ///
        ADebugStatus := (pDebugFlag^ = 1);
    finally
        FreeMem(pDebugFlag);
    end;

    ///
    result := (ABytesRead = SizeOf(Byte));
    finally
    CloseHandle(hProcess);
    end;
end;

{-------------------------------------------------------------------------------
    Update target process debug flag.

    ADebugStatus = True  : Set target process debug flag.
    ADebugStatus = False : Unset target process debug flag.
-------------------------------------------------------------------------------}
function SetProcessDebugStatus(AProcessID : Cardinal; ADebugStatus : Boolean) : Boolean;
var hProcess         : THandle;

    pDebugFlagOffset : Pointer;
    ADebugFlag       : Byte;
    ABytesWritten    : SIZE_T;
begin
    result := false;
    ///

    pDebugFlagOffset := GetDebugFlagPointer(AProcessID, hProcess);

    if not Assigned(pDebugFlagOffset) then
    Exit();
    ///
    try
    if ADebugStatus then
        ADebugFlag := 1
    else
        ADebugFlag := 0;

    if NOT WriteProcessMemory(hProcess, pDebugFlagOffset, @ADebugFlag, SizeOf(Byte), ABytesWritten) then
        Exit;

    ///
    result := (ABytesWritten = SizeOf(Byte));
    finally
    CloseHandle(hProcess);
    end;
end;

initialization
    {
    Load NtQueryInformationProcess from NTDLL.dll
    }
    _NtQueryInformationProcess := nil;

    hNTDLL := LoadLibrary('ntdll.dll');

    if (hNTDLL <> 0) then
    @_NtQueryInformationProcess := GetProcAddress(hNTDLL, 'NtQueryInformationProcess');

finalization
    _NtQueryInformationProcess := nil;

    if (hNTDLL <> 0) then
    FreeLibrary(hNTDLL);


end.