processlist.~pas

File Mon Downloader. File Mon Downloader.

unit ProcessList;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  StdCtrls, dateutils, Psapi, Registry, dialogs;

type
  TProcessList = class;
  
  TProgramItem     = class(TCollectionItem)
  private
    FExeName      : String;
    FHandle       : DWORD;
    FCheckngTime  : Tdatetime;
    FCreateTime   : Tdatetime;
    FExitTime     : Tdatetime;
    FKernelTime   : Tdatetime;
    FUserTime     : Tdatetime;
    FCPURatio      : double;
    procedure set_FExename(value : String);
    procedure set_FHandle(value : DWORD);
    procedure set_FCheckngTime(value : TDatetime);
    procedure set_FCreateTime(value : TDatetime);
    procedure set_FExitTime(value : TDatetime);
    procedure set_FKernelTime(value : TDatetime);
    procedure set_FUserTime(value : TDatetime);
    procedure set_FCPURatio(value : double);
  public
    function GetDisplayName: String; override;
  published
    property  ExeName      : String    read FExeName write set_FExeName;
    property  Handle       : DWORD     read FHandle  write set_FHandle;
    property  CheckngTime  : Tdatetime read FCheckngTime write set_FCheckngTime;
    property  CreateTime   : Tdatetime read FCreateTime  write set_FCreateTime;
    property  ExitTime     : Tdatetime read FExitTime    write set_FExitTime;
    property  KernelTime   : Tdatetime read FKernelTime  write set_FKernelTime;
    property  UserTime     : Tdatetime read FUserTime    write set_FUserTime;
    property  CPURatio     : double    read FCPURatio    write set_FCPURatio;

  end;


  TProgramClass = class(TCollection)
   private
     FProcessList : TProcessList;
     function  get_Fitem(index : Integer) : TProgramItem;
     procedure set_Fitem(index : Integer; value : TProgramItem);
   protected
   public
     constructor Create( ProcessList : TProcessList);
     function    Add : TProgramItem;
     property    Items[Index: Integer] : TProgramItem read get_Fitem write Set_Fitem; default;
  end;
  

  TProgram = record
    ExeName      : String;
    Handle       : DWORD;
    CheckngTime  : Tdatetime;
    CreateTime   : Tdatetime;
    ExitTime     : Tdatetime;
    KernelTime   : Tdatetime;
    UserTime     : Tdatetime;
    CPURatio     : double;
  end;


  TProcessList = class(TComponent)
  private
    { Private declarations }
    FRAMQTY : Integer;
    FAvailRAMQTY : Integer;
    FTotalPageSize : integer;
    FAvailPageSize  : integer;
    FTotalVirtualSize : integer;
    FAvailVirtualSize : integer;

    FItems  : TProgramClass;
    
    FCheck : Boolean;
    FCPURatio : double;

    procedure set_FCheck(value : Boolean);

    function  get_FRAMQTY : integer;
    function  get_FAvailRAMQTY : Integer; 
    function  get_FTotalPageSize : integer;
    function  get_FAvailPageSize  : integer;
    function  get_FTotalVirtualSize : integer;
    function  get_FAvailVirtualSize : integer;

    procedure SetItems( Value : TProgramClass );

  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : Tcomponent); override;
    destructor  Destroy; override;
  published
    { Published declarations }
    property Items : TProgramClass read FItems write SetItems;
    property Check : Boolean read FCheck write set_FCheck;
    property CPURatio : double read FCPURatio write FCPURatio;
    property RAMQty   : Integer read get_FRAMQty  write FRAMQty;
    property TotalPageSize : integer  read get_FTotalPageSize write FTotalPageSize;
    property AvailPageSize  : integer read get_FAvailPageSize write FAvailPageSize;
    property TotalVirtualSize : integer read get_FTotalVirtualSize write FTotalVirtualSize;
    property AvailVirtualSize : integer read get_FAvailVirtualSize write FAvailVirtualSize;
    property AvailRAMQTY      : integer read get_FAvailRAMQTY write FAvailRAMQTY;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('AUSCPU', [TProcessList]);
end;

   {TProgramItem}
   function TProgramItem.GetDisplayName : String;
   begin
     Result := self.ExeName;
     if Result = '' then Result := inherited GetDisplayName;
   end;

   procedure TProgramItem.set_FExename(value : String);
   begin
     if self.FExeName <> value then self.FExeName := value;
   end;

   procedure TProgramItem.set_FHandle(value : DWORD);
   begin
     if self.FHandle <> value then self.FHandle := value;
   end;

   procedure TProgramItem.set_FCheckngTime(value : TDatetime);
   begin
     if self.FCheckngTime <> value then self.FCheckngTime := value; 
   end;

   procedure TProgramItem.set_FCreateTime(value : TDatetime);
   begin
     if self.FCreateTime <> value then self.FCreateTime := value;
   end;

   procedure TProgramItem.set_FExitTime(value : TDatetime);
   begin
     if self.FExitTime <> value then self.FExitTime := value;
   end;

   procedure TProgramItem.set_FKernelTime(value : TDatetime);
   begin
     if self.FKernelTime <> value then self.FKernelTime := value;
   end;

   procedure TProgramItem.set_FUserTime(value : TDatetime);
   begin
     if self.FUserTime <> value then self.FUserTime := value;
   end;

   procedure TProgramItem.set_FCPURatio(value : double);
   begin
     if self.FCPURatio <> value then self.FCPURatio := value;
   end;

   {TProgramClass}

   constructor TProgramClass.Create;
   begin
      inherited Create(TProgramItem);
      self.FProcessList := ProcessList;
   end;

   function TProgramClass.Get_FItem( Index : Integer ) : TProgramItem;
   begin
      Result := TProgramItem( inherited GetItem( Index ) );
   end;

   procedure TProgramClass.Set_FItem( Index : Integer; Value : TProgramItem );
   begin
      inherited SetItem( Index, Value );
   end;

   function  TProgramClass.Add : TProgramItem;
   begin
       Result := TProgramItem( inherited Add );
   end;


   {TProcessList}

   constructor TProcessList.Create(AOwner : Tcomponent);
   begin
     inherited Create(Aowner);
     self.FCPURatio := 0.0;
     self.FRAMQTY := 0;

     self.FItems := TProgramClass.Create(self);
     self.FItems.Clear;
   end;

   destructor  TProcessList.Destroy;
   begin

     self.FItems.Free;
     inherited Destroy;
   end;


   procedure TProcessList.SetItems( Value : TProgramClass );
   begin
     self.FItems.Assign(value);
   end;


   procedure   TProcessList.set_FCheck(value : Boolean);
   var
      ProcessHandle : THandle;
      PIDS : array [0..500] of DWORD;
      PModule       : HMODULE;
      dwSize        : DWORD;
      ProcessName   : Array[0..255] of Char;
      tmpSysTime    : TSystemTime;
      ProcessCnt ,
      ProcessIdx    : Integer;


      ftCreation, ftExit, ftKernel, ftUser : TFileTime;

      function get_ProgramIndex(ProcHandle : DWORD) : integer;