////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : Unit1
//  * Purpose   : Демо получение информации о процессах
//  * Author    : Александр (Rouse_) Багель
//  * Version   : 1.00
//  ****************************************************************************
//

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TProcessTimer = record
    PID: Cardinal;
    KernelTime: FILETIME;
    UserTime: FILETIME;
    Time: Cardinal;
  end;
  TProcessTimersArray = array of TProcessTimer;

  TTMDemo = class(TForm)
    lvProcesses: TListView;
    sbInfo: TStatusBar;
    tmrRefresh: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmrRefreshTimer(Sender: TObject);
  private
    ProcessTimersCount: Integer;
    ProcessTimers: TProcessTimersArray;
    function GetSystemInformation: Boolean;
    function GetProcessCPUUsage(const PID: Cardinal; KernelTime,
      UserTime: FILETIME): Byte;
  end;

var
  TMDemo: TTMDemo;

implementation

const
  SystemBasicInformation = 0;
  SystemPerformanceInformation = 2;
  SystemTimeOfDayInformation = 3;
  SystemProcessesAndThreadsInformation = 5;

  STATUS_INFO_LENGTH_MISMATCH = $C0000004;

type
  PSYSTEM_BASIC_INFORMATION = ^SYSTEM_BASIC_INFORMATION;
  SYSTEM_BASIC_INFORMATION = packed record
    AlwaysZero              : ULONG;
    uKeMaximumIncrement     : ULONG;
    uPageSize               : ULONG;
    uMmNumberOfPhysicalPages: ULONG;
    uMmLowestPhysicalPage   : ULONG;
    uMmHighestPhysicalPage  : ULONG;
    uAllocationGranularity  : ULONG;
    pLowestUserAddress      : POINTER;
    pMmHighestUserAddress   : POINTER;
    uKeActiveProcessors     : POINTER;
    bKeNumberProcessors     : BYTE;
    Filler                  : array [0..2] of BYTE;
  end;

  PSYSTEM_PERFORMANCE_INFORMATION = ^SYSTEM_PERFORMANCE_INFORMATION;
  SYSTEM_PERFORMANCE_INFORMATION = packed record
    nIdleTime               : INT64;
    dwSpare                 : array [0..75]of DWORD;
  end;

  PSYSTEM_TIME_INFORMATION = ^SYSTEM_TIME_INFORMATION;
  SYSTEM_TIME_INFORMATION = packed record
    nKeBootTime             : INT64;
    nKeSystemTime           : INT64;
    nExpTimeZoneBias        : INT64;
    uCurrentTimeZoneId      : ULONG;
    dwReserved              : DWORD;
  end;

  PSYSTEM_THREADS = ^SYSTEM_THREADS;
  SYSTEM_THREADS  = packed record
    KernelTime: LARGE_INTEGER;
    UserTime: LARGE_INTEGER;
    CreateTime: LARGE_INTEGER;
    WaitTime: ULONG;
    StartAddress: Pointer;
    UniqueProcess: DWORD;
    UniqueThread: DWORD;
    Priority: Integer;
    BasePriority: Integer;
    ContextSwitchCount: ULONG;
    State: Longint;
    WaitReason: Longint;
  end;

  PSYSTEM_PROCESS_INFORMATION = ^SYSTEM_PROCESS_INFORMATION;
  SYSTEM_PROCESS_INFORMATION = packed record
    NextOffset: ULONG;
    ThreadCount: ULONG;
    Reserved1: array [0..5] of ULONG; // Что такое, пока не понятно...
    CreateTime: FILETIME;
    UserTime: FILETIME;
    KernelTime: FILETIME;
    ModuleNameLength: WORD;
    ModuleNameMaxLength: WORD;
    ModuleName: PWideChar;
    BasePriority: ULONG;
    ProcessID: ULONG;
    InheritedFromUniqueProcessID: ULONG;
    HandleCount: ULONG;
    Reserved2 : array[0..1] of ULONG; // Что такое, пока не понятно...
    PeakVirtualSize : ULONG;
    VirtualSize : ULONG;
    PageFaultCount : ULONG;
    PeakWorkingSetSize : ULONG;
    WorkingSetSize : ULONG;
    QuotaPeakPagedPoolUsage : ULONG;
    QuotaPagedPoolUsage : ULONG;
    QuotaPeakNonPagedPoolUsage : ULONG;
    QuotaNonPagedPoolUsage : ULONG;
    PageFileUsage : ULONG;
    PeakPageFileUsage : ULONG;
    PrivatePageCount : ULONG;
    ReadOperationCount : LARGE_INTEGER;
    WriteOperationCount : LARGE_INTEGER;
    OtherOperationCount : LARGE_INTEGER;
    ReadTransferCount : LARGE_INTEGER;
    WriteTransferCount : LARGE_INTEGER;
    OtherTransferCount : LARGE_INTEGER;
    ThreadInfo: array [0..0] of SYSTEM_THREADS;
  end;

  function NtQuerySystemInformation(
    SystemInformationClass: DWORD;   // тип требуемой информации
    SystemInformation : Pointer;     // указатель на буфер, в который вернется информация
    SystemInformationLength : DWORD; // размер буфера в байтах
    var ReturnLength: DWORD          // сколько байт было возвращено или требуется
    ): DWORD; stdcall; external 'ntdll.dll';

{$R *.dfm}

{ TForm1 }

function TTMDemo.GetSystemInformation: Boolean;
type
  PTokenUser = ^TTokenUser;
  TTokenUser = record
    user: array [0..0] of TSIDAndAttributes;
  end;

  TProcessInfo = record
    UserName: String;
    SessionID: Integer;
    USERObjCount: Integer;
    GDIObjCount: Integer;
  end;

  function GetProcessInfo(const ProcessHandle: Cardinal): TProcessInfo;
  const
    TokenSessionId: TTokenInformationClass = TTokenInformationClass(12);
  var
    TokenHandle: THandle;
    ReturnLength: DWORD;
    TknUser: PTokenUser;
    userName : array [0..255] of char;
    userNameLen : DWORD;
    domainName : array [0..255] of char;
    domainNameLen : DWORD;
    use : SID_NAME_USE;
  begin
    Result.UserName := 'UNKNOWN';
    Result.SessionID := -1;
    Result.USERObjCount := GetGuiResources(ProcessHandle, GR_USEROBJECTS);
    Result.GDIObjCount := GetGuiResources(ProcessHandle, GR_GDIOBJECTS);

    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, TokenHandle) then
    try
      // ID Session
      GetTokenInformation(TokenHandle, TokenSessionId, @Result.SessionID,
        SizeOf(Result.SessionID), ReturnLength);

      // UserName
      GetTokenInformation(TokenHandle, TokenUser, nil, 0, ReturnLength);
      if GetLastError = ERROR_INSUFFICIENT_BUFFER then
      begin
        TknUser := GetMemory(ReturnLength);
        if TknUser <> nil then
        try
          if GetTokenInformation(TokenHandle, TokenUser,
            TknUser, ReturnLength, ReturnLength) then
          begin
            SetLength(Result.UserName, 255);
            userNameLen := 255;
            domainNameLen := 255;
            if LookupAccountSid(nil, TknUser^.User[0].Sid,
              userName, userNameLen, domainName, domainNameLen, use) then
              Result.UserName := String(userName);
          end;
        finally
          FreeMemory(TknUser);
        end;
      end;
    finally
      CloseHandle(TokenHandle);
    end;
  end;

var
  SystemInformation, Temp: PSYSTEM_PROCESS_INFORMATION;
  ReturnLength: DWORD;
  ProcessInfo: TProcessInfo;
  hProcess: THandle;
  AKernelTime: TSystemTime;
begin
  Result := False;
  // Узнаем объем необходимой памяти
  lvProcesses.Items.BeginUpdate;
  try
    lvProcesses.Items.Clear;
    ReturnLength := 0;
    if NtQuerySystemInformation(
      SystemProcessesAndThreadsInformation,
      nil, 0, ReturnLength) <> STATUS_INFO_LENGTH_MISMATCH then Exit;
    if ReturnLength > 0 then
    begin
      GetMem(SystemInformation, ReturnLength);
      try
        if NtQuerySystemInformation(SystemProcessesAndThreadsInformation,
          SystemInformation, ReturnLength, ReturnLength) = 0 then
        begin
          Temp := SystemInformation;
          repeat
            with lvProcesses.Items.Add do
            begin
              if Temp^.ModuleName = nil then
                Caption := 'System Idle Process'
              else
                Caption := Temp^.ModuleName;
              SubItems.Add(IntToStr(Temp^.ProcessID));

              hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, True, Temp^.ProcessID);
              if hProcess <> 0 then
              try
                ProcessInfo := GetProcessInfo(hProcess);
                // User Name
                SubItems.Add(ProcessInfo.UserName);
                // Session ID
                SubItems.Add(IntToStr(ProcessInfo.SessionID));
              finally
                CloseHandle(hProcess);
              end
              else
              begin
                // User Name
                SubItems.Add('UNKNOWN');
                // Session ID
                SubItems.Add('-1');
              end;

              // CPU
              SubItems.Add(IntToStr(GetProcessCPUUsage(Temp^.ProcessID,
                Temp^.KernelTime, Temp^.UserTime)));
              // CPU Time
              FileTimeToSystemTime(Temp^.KernelTime, AKernelTime);
              SubItems.Add(Format('%.2d:%.2d:%.2d', [AKernelTime.wHour,
                AKernelTime.wMinute, AKernelTime.wSecond]));
              // MemUsage
              SubItems.Add(IntToStr(Temp^.WorkingSetSize div 1024) + ' K');
              // Peak Mem Usage
              SubItems.Add(IntToStr(Temp^.PeakWorkingSetSize div 1024) + ' K');
              // Mem Delta
              SubItems.Add('');
              // Page Faults
              SubItems.Add(IntToStr(Temp^.PageFaultCount));
              // PF Delta
              SubItems.Add('');
              // VM Size
              SubItems.Add(IntToStr(Temp^.PageFileUsage div 1024) + ' K');
              // Paged Pool
              SubItems.Add(IntToStr(Temp^.QuotaPagedPoolUsage div 1024) + ' K');
              // NP Pool
              SubItems.Add(IntToStr(Temp^.QuotaNonPagedPoolUsage div 1024) + ' K');
              // Base Pri
              case Temp^.BasePriority of
                0: SubItems.Add('N/A');
                1..4: SubItems.Add('Low [' + IntToStr(Temp^.BasePriority) + ']');
                5, 6: SubItems.Add('Below Normal [' + IntToStr(Temp^.BasePriority) + ']');
                7..9: SubItems.Add('Normal [8]');
                10..12: SubItems.Add('Above Normal [' + IntToStr(Temp^.BasePriority) + ']');
                13..23: SubItems.Add('High [' + IntToStr(Temp^.BasePriority) + ']');
                24: SubItems.Add('Real Time [24]');
              else
                SubItems.Add(IntToStr(Temp^.BasePriority));
              end;
              // Handles
              SubItems.Add(IntToStr(Temp^.HandleCount));
              // Threads
              SubItems.Add(IntToStr(Temp^.ThreadCount));
              // User Objects
              SubItems.Add(IntToStr(ProcessInfo.USERObjCount));
              // GDI Objects
              SubItems.Add(IntToStr(ProcessInfo.GDIObjCount));
              // I/O Reads
              SubItems.Add(IntToStr(Temp^.ReadOperationCount.QuadPart));
              // I/O Writes
              SubItems.Add(IntToStr(Temp^.WriteOperationCount.QuadPart));
              // I/O Other
              SubItems.Add(IntToStr(Temp^.OtherOperationCount.QuadPart));
              // I/O Read Bytes
              SubItems.Add(IntToStr(Temp^.ReadTransferCount.QuadPart));
              // I/O Writes Bytes
              SubItems.Add(IntToStr(Temp^.WriteTransferCount.QuadPart));
              // I/O Other Bytes
              SubItems.Add(IntToStr(Temp^.OtherTransferCount.QuadPart));
            end;
            Temp := Pointer(DWORD(Temp) + Temp^.NextOffset);
          until Temp^.NextOffset = 0;
          sbInfo.Panels.Items[0].Text := 'Processes: ' + IntToStr(lvProcesses.Items.Count);
        end;
      finally
        FreeMem(SystemInformation);
      end;
    end;
  finally
    lvProcesses.Items.EndUpdate;
  end;
end;

procedure TTMDemo.FormCreate(Sender: TObject);
begin
  GetSystemInformation;
  ProcessTimersCount := 0;
end;

var
  nOldIdleTime    : Int64 = 0;
  nOldSystemTime  : INT64 = 0;
  nNewCPUTime     : ULONG = 0;

procedure TTMDemo.tmrRefreshTimer(Sender: TObject);
var
  spi : SYSTEM_PERFORMANCE_INFORMATION;
  sti : SYSTEM_TIME_INFORMATION;
  sbi : SYSTEM_BASIC_INFORMATION;
  Dummy: DWORD;
begin
  GetSystemInformation;
  if NTQuerySystemInformation(SystemBasicInformation, @sbi,
    SizeOf(SYSTEM_BASIC_INFORMATION), Dummy) = NO_ERROR then
    if NTQuerySystemInformation(SystemTimeOfDayInformation, @sti,
      SizeOf(SYSTEM_TIME_INFORMATION), Dummy) = NO_ERROR then
      if NTQuerySystemInformation(SystemPerformanceInformation, @spi,
        SizeOf(SYSTEM_PERFORMANCE_INFORMATION), Dummy) = NO_ERROR then
      begin
        if (nOldIdleTime <> 0) then
        begin
          nNewCPUTime:= Trunc(100 - ((spi.nIdleTime - nOldIdleTime)
            / (sti.nKeSystemTime - nOldSystemTime) * 100)
            / sbi.bKeNumberProcessors + 0.5);
          if (nNewCPUTime <> nOldIdleTime) then
            sbInfo.Panels.Items[1].Text := 'CPU Usage: ' + IntToStr(nNewCPUTIME) + '%';
        end;
        nOldIdleTime   := spi.nIdleTime;
        nOldSystemTime := sti.nKeSystemTime;
      end;
end;

function TTMDemo.GetProcessCPUUsage(const PID: Cardinal; KernelTime,
  UserTime: FILETIME): Byte;
var
  I: Integer;
  AKernelTime, AUserTime, BKernelTime, BUserTime: TSystemTime;
  Time: Cardinal;
  Tmp: DWORD;
begin
  Result := 0;
  if ProcessTimersCount > 0 then
    for I := 0 to ProcessTimersCount - 1 do
      if ProcessTimers[I].PID = PID then
      begin
        FileTimeToSystemTime(KernelTime, AKernelTime);
        FileTimeToSystemTime(UserTime, AUserTime);
        FileTimeToSystemTime(ProcessTimers[I].KernelTime, BKernelTime);
        FileTimeToSystemTime(ProcessTimers[I].UserTime, BUserTime);

        Time := GetTickCount;
        Tmp :=
          (((AKernelTime.wSecond - BKernelTime.wSecond) * 1000) +
           (AKernelTime.wMilliseconds - BKernelTime.wMilliseconds) +
           ((AUserTime.wSecond - BUserTime.wSecond) * 1000) +
           (AUserTime.wMilliseconds - BUserTime.wMilliseconds));
        Result := 100 * Tmp div (Time - ProcessTimers[I].Time);

        // Хм, ну я фиг знает чего он выше сотни прыгает, короче прибил на корню  :)
        while Result > 100 do Dec(Result, 100);

        ProcessTimers[I].KernelTime := KernelTime;
        ProcessTimers[I].UserTime := UserTime;
        ProcessTimers[I].Time := Time;
        Exit;
      end;
  Inc(ProcessTimersCount);
  SetLength(ProcessTimers, ProcessTimersCount);
  ProcessTimers[ProcessTimersCount - 1].PID := PID;
  ProcessTimers[ProcessTimersCount - 1].KernelTime := KernelTime;
  ProcessTimers[ProcessTimersCount - 1].UserTime := UserTime;
  ProcessTimers[ProcessTimersCount - 1].Time := GetTickCount;
end;

end.
