[Delphi] Hidden Thread Detection

Got borred today so code some snippet, maybe bisa dijadikan referensi…

Apa yang saya coding hari ini merupakan implementasi dari chat dengan teman saya ( fajar anggiawan ) 2 bulan yang lalu. Waktu itu saya tanya2 about bagaimana sih pcmedia mendeteksi stealty virus (virus yang menggunakan teknologi untuk menyembunyikan dirinya like code injection) berhubung pada waktu itu lagi gempar2nya virus ramnit. Om Fuajar pun memberikan kisi2 dalam mendeteksi virus like ramnit tersebut yaitu dengan :

– query all process
– query all thread in process
– each thread we check startaddress and get modulename
– thread yang tidak berada pada module tertentu kita bisa qoute sebagai suspicius thread

and the code looks like this

program Project1;

uses
  windows, SysUtils, codesitelogging,
  JwaNative, JwaNtStatus, JwaWinType, JwaWinNt;

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

Function GetInformation(Table: TSystemInformationClass): Pointer;
var
  mSize: dword;
  mPtr: Pointer;
  St: NTStatus;
begin
  Result := nil;
  mSize := $4000;
  repeat
    GetMem(mPtr, mSize);
    St := NTQuerySystemInformation(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 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(NtOpenProcess(@hProcess, dwDesiredAccess, @attr, @cli)) then result := hProcess
end;


function ExOpenThread(dwDesiredAccess: dword; Id: dword): THANDLE;
var
  hThread: THANDLE;
  attr: OBJECT_ATTRIBUTES;
  cli: CLIENT_ID;
begin
  InitializeObjectAttributes(@attr, nil, 0, 0, nil);
  cli.UniqueProcess := 0;
  cli.UniqueThread := THANDLE(Id);
  Result := 0;
  if NtSuccess(NtOpenThread(@hThread, dwDesiredAccess, @attr, @cli)) then
    Result := hThread
end;

Function GetThreadAddress(Handle: THANDLE): dword;
begin
  if not NtSuccess(NtQueryInformationThread(Handle,
    ThreadQuerySetWin32StartAddress, @Result, sizeof(dword), nil)) then
    exit(0);
end;

Function GetModuleFileNameByAddres(ph:THandle; Address : DWord):String;
var
  mSize,back: dword;
  mPtr: pointer;
  St: NTStatus;
begin
  result := '';
  mSize := 512;
  mPtr := AllocMem(mSize);
  St := NtQueryVirtualMemory(ph, Pointer(Address), MemorySectionName, mPtr,mSize,@back);
  if NtSuccess(st) then result :=strpas(PMEMORY_SECTION_NAME(mPtr).SectionFileName.Buffer);
  FreeMem(mPtr,mSize);
end;


Procedure ScanAllProcess;
var
  buffer: Pointer;
  pInfo: PSystemProcesses;
  i, ta: DWord;
  th, ph: THANDLE;
  modulename : string;
begin

  { Get SystemProcessesAndThreads Information }
  buffer := GetInformation(SystemProcessesAndThreadsInformation);
  if not assigned(buffer) then
  begin
{$IFDEF DebugMode}codesite.SendWinError('Get SystemProcessesAndThreadsInformation', getlasterror); {$ENDIF}
    exit;
  end;
  pInfo := PSystemProcesses(buffer);

  try

    { Enum All Process Info }
    repeat

      with pInfo^ do
      begin

        if (ProcessId <> 0) then
        begin

          { Check the processid, if not our process we need openaccess }
          if (ProcessId <> GetCurrentProcessID) then
          begin
            ph := ExOpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, ProcessId);
            if (ph = INVALID_HANDLE_VALUE) or (ph=0) then
            begin
              //Skip the process if we cant open access
              if pInfo^.NextEntryDelta = 0 then break;
              pInfo := Pointer(dword(pInfo) + pInfo^.NextEntryDelta);
              continue;
            end;
          end else ph := GetCurrentProcess;

          { Process All Thread, in current process }
          for i := 0 to ThreadCount - 1 do
          begin

            { Open Access to thread }
            th := ExOpenThread(THREAD_QUERY_INFORMATION, Threads[i].ClientId.UniqueThread);
            if (th <> INVALID_HANDLE_VALUE) or (th <> 0) then
            begin

              { Get thread address and module name }
              ta := GetThreadAddress(Th);
              modulename := GetModuleFileNameByAddres(ph, ta);
              if modulename = '' then begin
                {process your suspisius thread handling here}
              end;
              codesite.Send('Procid %d / threadid %d / Address %d / %s ',[ProcessId,Threads[i].ClientId.UniqueThread, ta, modulename]);
            end;
          end;
        end;
      end;

      { Next Process }
      if pInfo^.NextEntryDelta = 0 then break;
      pInfo := Pointer(dword(pInfo) + pInfo^.NextEntryDelta);
    until false;

  finally
    FreeMem(buffer);
  end;

end;

begin
  try
    ScanAllProcess;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

for salah2 coding mohon di fix sendiri yah, and big thumbs buat om fuajar and pcmav team…