[Delphi] Process Detection – Handle Table Enumeration

just some code requested for detect process by handle table enumeration..

program check;


uses
  windows, sysutils, codesitelogging,
  JwaNative,
  JwaNtStatus,
  JwaWinType;

Function GetInformation(Table:SYSTEM_INFORMATION_CLASS):Pointer;
var
  mSize: dword;
  mPtr: pointer;
  St: LongInt;
begin
  result := nil;
  mSize := $4000;
  repeat
    GetMem(mPtr, mSize);
    St := ZwQuerySystemInformation(Table, mPtr, mSize, nil);
    if (St = STATUS_INFO_LENGTH_MISMATCH) then begin
      FreeMem(mPtr);
      mSize := mSize * 2;
    end;
  until St <> STATUS_INFO_LENGTH_MISMATCH;
  if (St = STATUS_SUCCESS) then result := mPtr
  else FreeMem(mPtr);
end;

Function GetObjectInfo(Handle:THandle; Table: TObjectInformationClass):Pointer;
var
  mSize: dword;
  mPtr: pointer;
  St: NTStatus;
begin
  result := nil;
  ZwQueryObject(Handle, Table, nil, 1000, @mSize);
  GetMem(mPtr, mSize);
  st:=ZwQueryObject(Handle, Table, mPtr, mSize, nil);
  if (St = STATUS_SUCCESS) then result := mPtr
  else FreeMem(mPtr);
end;

function NtSuccess(AStatus: LongInt): Boolean;
var
  error : DWord;
begin
  Result := AStatus >= 0;
  if not result then begin
    error := RtlNtStatusToDosError(AStatus);
    SetLastError(error);
  end;
end;

function ExOpenProcess(dwDesiredAccess: DWord; Id : DWord):THANDLE;
var
  hProcess: THANDLE;
  attr: OBJECT_ATTRIBUTES;
  cli: CLIENT_ID;
begin
  InitializeObjectAttributes(@attr, nil, 0, 0, nil);
  cli.UniqueProcess := THandle(Id);
  cli.UniqueThread := 0;
  result := 0;
  if NtSuccess(ZwOpenProcess(@hProcess, dwDesiredAccess, @attr, @cli)) then result := hProcess
end;

type
  PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
  SYSTEM_HANDLE_INFORMATION_EX = packed record
    NumberOfHandles: dword;
    Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
  end;

  PROCESS_BASIC_INFORMATION = record
    ExitStatus: Cardinal;
    PebBaseAddress: PVOID;
    AffinityMask: Cardinal;
    BasePriority: Cardinal;
    UniqueProcessId: Cardinal;
    InheritedFromUniqueProcessId: Cardinal;
  end;
  TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
  PProcessBasicInformation = ^TProcessBasicInformation;

var
  CsrID : Array Of DWORD;

Function ThisCsr(ProcID :DWORD):Boolean;
var
  i : Integer;
begin
  result := false;
  for i := 0 to length(CsrID)-1 do begin
    if (ProcID = CsrID[i]) then begin
       result := true;
       exit;
    end;
  end;
end;

function GetPIDByProcess (ph : Thandle):DWord;
var
  PBI           : PROCESS_BASIC_INFORMATION;
begin
  result := 0;

  {Get PROCESS_BASIC_INFORMATION}
  if not NtSuccess(ZwQueryInformationProcess(ph, ProcessBasicInformation, @PBI, SizeOf(PBI), nil)) then begin
    codesite.SendWinError('Failed Get PROCESS BASIC INFORMATION',Getlasterror);
    exit;
  end;

  result := PBI.UniqueProcessId;
end;

procedure GetCsrProc;
var
  buffer:   Pointer;
  pInfo:    PSYSTEM_PROCESSES;
begin

  { Get SystemProcessesAndThreads Information }
  buffer := GetInformation(SystemProcessesAndThreadsInformation);
  if not assigned(buffer) then begin
    {$IFDEF DebugMode}OutputDebugString(Pchar('Failed Get SystemProcessesAndThreadsInformation : '+SysErrorMessage(Getlasterror)));{$ENDIF}
    exit;
  end;
  pInfo := PSystemProcesses(buffer);

  try
    { Enum All Info }
    repeat

      { check if this our target }
      if CompareText(PInfo^.ProcessName.Buffer, 'csrss.exe') = 0 then begin
        setlength(CsrID, Length(CsrID)+1);
        CsrID[length(CsrID)-1] := pInfo^.ProcessId;
      end;

      { Next Info }
      if pInfo^.NextEntryDelta = 0 then break;
      pInfo := pointer(dword(pInfo) + pInfo^.NextEntryDelta);
    until false;
  finally
    FreeMem(buffer);
  end;
end;

Procedure CheckCsr;
var
  ph,ih:  THANDLE;
  Info:   PSYSTEM_HANDLE_INFORMATION_EX;
  i:      Integer;
begin

  Info := GetInformation(JwaNative.SystemHandleInformation);
  if not assigned(Info) then begin
    codesite.SendWinError('GetInformation', GetLastError);
    Exit;
  end;

  try
    { Enum All Info }
    for i := 0 to Info^.NumberOfHandles do begin

      if ThisCsr(info^.Information[i].ProcessId) and
         (info^.Information[i].ObjectTypeNumber = 5) then begin

        ph := INVALID_HANDLE_VALUE;
        ih := INVALID_HANDLE_VALUE;

        ph := ExOpenProcess(PROCESS_DUP_HANDLE , info^.Information[i].ProcessId);
        if (ph = INVALID_HANDLE_VALUE) then begin
          codesite.SendWinError('Openhandle', GetLastError);
          continue;
        end;

        if not NtSuccess(ZwDuplicateObject(ph, info^.Information[i].Handle, GetCurrentProcess, @ih, 0, 0, DUPLICATE_SAME_ACCESS)) then begin
          ZwClose(ph);
          codesite.SendWinError('ZwDuplicateObject', GetLastError);
          continue;
        end;

        codesite.Send('PID', GetPIDByProcess(ih));

        ZwClose(ph);
        ZwClose(ih);
      end;

    end;
  finally
    FreeMem(Info);
  end;

end;

begin
  GetCsrProc;
  CheckCsr;
end.