3435 lines
99 KiB
ObjectPascal
3435 lines
99 KiB
ObjectPascal
{*******************************************************}
|
|
{ MiTeC System Information Component Suite }
|
|
{ System and Process List Monitor Thread }
|
|
{ version 14.5.1 }
|
|
{ }
|
|
{ Copyright (c) 1997-2021 Michal Mutl }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
|
|
{$INCLUDE Compilers.inc}
|
|
|
|
unit MSI_SysProcMon;
|
|
|
|
interface
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
WinAPI.Windows, System.SysUtils, System.Classes, System.SyncObjs,
|
|
{$ELSE}
|
|
Windows, SysUtils, Classes, SyncObjs,
|
|
{$ENDIF}
|
|
MiTeC_Windows, MiTeC_CommonDefs, MiTeC_NativeDefs, MiTeC_NativeAPI, MiTeC_PSAPI,
|
|
MiTeC_PowrProf, MiTeC_Lists, MSI_Defs;
|
|
|
|
type
|
|
TCPURecord = record
|
|
Number: Cardinal;
|
|
Usage: double;
|
|
CurrentClock: Cardinal;
|
|
MaxClock: Cardinal;
|
|
_Fraction: double;
|
|
end;
|
|
TCPUData = record
|
|
Items: array of TCPURecord;
|
|
function GetNumberIndex(ANumber: byte): integer;
|
|
end;
|
|
|
|
TSampleMethod = (smCurrent, smAverage);
|
|
|
|
TSampleRecord = record
|
|
ID: Cardinal;
|
|
SessionID: Cardinal;
|
|
Name: string;
|
|
CPUUsage: double;
|
|
MemUsage: int64;
|
|
CreateTime: TDatetime;
|
|
CommandLine: string;
|
|
Username: string;
|
|
end;
|
|
TSampleData = array of TSampleRecord;
|
|
|
|
TSysProcMonThread = class;
|
|
|
|
TSysProcMonNotifyEvent = procedure(Sender: TSysProcMonThread) of object;
|
|
TSysProcMonSampleEvent = procedure(Sender: TSysProcMonThread; var ASampleData: TSampleData) of object;
|
|
|
|
TSysProcMonThread = class(TThread)
|
|
private
|
|
InternalLock: TCriticalSection;
|
|
FOnInterval: TSysProcMonNotifyEvent;
|
|
FInterval: Cardinal;
|
|
FList: TList;
|
|
FWL: TIntegerList;
|
|
FAutoSuspend: Boolean;
|
|
FMaxCPUPID,
|
|
FMaxMemPID,
|
|
FMaxIOPID: Cardinal;
|
|
FII: integer;
|
|
Buffer: Pointer;
|
|
BufferSize: Cardinal;
|
|
FTotalPPB, FTotalWS: uint64;
|
|
FFirstPass: boolean;
|
|
FCPUUsage: TSample;
|
|
FMemory: TSample;
|
|
FCPUData: TCPUData;
|
|
FCPUIdle,FCPUKernel,FCPUUser: TSamples;
|
|
FTicks: TSample;
|
|
FCPUMaxClock,FCPUCurClock: TSample;
|
|
FCurPerfDistribution,
|
|
FPrevPerfDistribution: PSystemProcessorPerformanceDistribution;
|
|
FPS: TSystemPowerStatus;
|
|
FCPUCount,FCPUPackageCount,FCPUCoreCount: Cardinal;
|
|
FTL: TStringlist;
|
|
FCPUCycle,
|
|
FCPUIdleCycle,
|
|
FCPUTotalTime: TSample;
|
|
FCalcHash, FEnumHandles, FEnumModules, FEnumThreads: boolean;
|
|
FOnSample: TSysProcMonSampleEvent;
|
|
FSamplePeriod: Cardinal;
|
|
FSampleMethod: TSampleMethod;
|
|
FEvalSym: boolean;
|
|
FCurrentProcess: TProcessRecord;
|
|
FPerfMeas: boolean;
|
|
FWinSysDir: string;
|
|
FEvalSecInfo: boolean;
|
|
FProcIcon: boolean;
|
|
FProcVerInfo: boolean;
|
|
FEvalProcInfo: boolean;
|
|
FAskFullProcessAccess: boolean;
|
|
FTF: string;
|
|
procedure RefreshData;
|
|
procedure GetSampleData(AMethod: TSampleMethod; var AData: TSampleData);
|
|
procedure DoSync;
|
|
function GetInterval: Cardinal;
|
|
function GetOnInterval: TSysProcMonNotifyEvent;
|
|
procedure SetInterval(const Value: Cardinal);
|
|
procedure SetOnInterval(const Value: TSysProcMonNotifyEvent);
|
|
function GetRecCount: Integer;
|
|
function GetMaxCPUPID: Cardinal;
|
|
function GetAutoSuspend: Boolean;
|
|
procedure SetAutoSuspend(const Value: Boolean);
|
|
function GetMaxMemPID: Cardinal;
|
|
procedure GetParentProps(APID: Cardinal; var AImageName, ACmdline: string);
|
|
function GetMaxIOPID: Cardinal;
|
|
function GetTotalPPB: uint64;
|
|
function GetTotalWS: uint64;
|
|
procedure _GetRecordByPID(APID: Cardinal; var ARecord: TProcessRecord); overload;
|
|
function _GetRecordByPID(APID: Cardinal): integer; overload;
|
|
function GetCPUUsage: double;
|
|
function GetCPUCC: Cardinal;
|
|
function GetCPUMC: Cardinal;
|
|
function GetBatRem: Byte;
|
|
function GetBatRemSec: int64;
|
|
function GetBatStatus: Cardinal;
|
|
function GetPowerStatus: boolean;
|
|
function GetCPUCoreCount: Byte;
|
|
function GetCPURecord(Index: Byte): TCPURecord;
|
|
function GetCpuFrequencyFromDistribution: double;
|
|
function GetCPUTimes: Integer;
|
|
function GetCPUCycles(var Values,IdleValues: TSamples): Integer;
|
|
procedure UpdateCPUCycleTime;
|
|
procedure UpdateCPUSysTime;
|
|
function GetCalcHash: boolean;
|
|
procedure SetCalcHash(const Value: boolean);
|
|
function GetEnumHandles: boolean;
|
|
procedure SetEnumHandles(const Value: boolean);
|
|
function GetEnumMods: boolean;
|
|
function GetEnumThrds: boolean;
|
|
procedure SetEnumMods(const Value: boolean);
|
|
procedure SetEnumThrds(const Value: boolean);
|
|
function GetOnSample: TSysProcMonSampleEvent;
|
|
function GetSamplePeriod: Cardinal;
|
|
procedure SetOnSample(const Value: TSysProcMonSampleEvent);
|
|
procedure SetSamplePeriod(const Value: Cardinal);
|
|
function GetSampleMethod: TSampleMethod;
|
|
procedure SetSampleMethod(const Value: TSampleMethod);
|
|
function GetEvalSym: boolean;
|
|
procedure SetEvalSym(const Value: boolean);
|
|
function GetCurrentProcessRecord: TProcessRecord;
|
|
function GetPerfMeas: boolean;
|
|
procedure SetPerfMeas(const Value: boolean);
|
|
function GetEvalSecInfo: boolean;
|
|
function GetRetrieveProcIcon: boolean;
|
|
function GetRetrieveProcVersionInfo: boolean;
|
|
procedure SetEvalSecInfo(const Value: boolean);
|
|
procedure SetRetrieveProcIcon(const Value: boolean);
|
|
procedure SetRetrieveProcVersionInfo(const Value: boolean);
|
|
function GetEvalProcInfo: boolean;
|
|
procedure SetEvalprocInfo(const Value: boolean);
|
|
function GetAskFullProcessAccess: boolean;
|
|
procedure SetAskFullProcessAccess(const Value: boolean);
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
class function InstallDate: TDateTime;
|
|
class function ReleaseID: string;
|
|
class function DisplayVersion: string;
|
|
class function BootTime: TDateTime;
|
|
class function LastShutdown: TDateTime;
|
|
class function LogicalCPUCount: Cardinal;
|
|
|
|
class function SessionID: Cardinal;
|
|
|
|
class function MemoryLoad: Cardinal;
|
|
class function InstalledMemory: Int64;
|
|
class function TotalPhysMemory: Int64;
|
|
class function UsedPhysMemory: Int64;
|
|
class function FreePhysMemory: Int64;
|
|
class function LimitCommitCharge: int64;
|
|
class function CurrentCommitCharge: Int64;
|
|
class function TotalVirtualMemory: Int64;
|
|
class function FreeVirtualMemory: Int64;
|
|
class function SystemCache: Int64;
|
|
class function PagedPool: Int64;
|
|
class function NonPagedPool: Int64;
|
|
|
|
class function TotalPageFile: int64;
|
|
class function FreePageFile: Int64;
|
|
|
|
class function ThreadCount: Cardinal;
|
|
class function ProcessCount: Cardinal;
|
|
class function HandleCount: Cardinal;
|
|
|
|
class function SystemDisk: string;
|
|
|
|
class function DiskFreeSpace(const ADisk: string): Int64;
|
|
class function DiskUserFreeSpace(const ADisk: string): Int64;
|
|
class function DiskTotalSpace(const ADisk: string): Int64;
|
|
class function DiskFileSystem(const ADisk: string): string;
|
|
|
|
class function CPUName: string;
|
|
class function SystemProductName: string;
|
|
class function BaseBoardName: string;
|
|
class function BIOS: string;
|
|
|
|
class function GetProcessImageNameByPID(APID: Cardinal): string;
|
|
class function GetProcessImageNameByHandle(AHandle: THandle): string;
|
|
|
|
class function GetProcessMemoryCountersByPID(APID: Cardinal): TProcessMemoryCountersEx;
|
|
class function GetProcessMemoryCountersByHandle(AHandle: THandle): TProcessMemoryCountersEx;
|
|
|
|
class procedure GetProcessThreads(APID: Cardinal; AList: TList);
|
|
class procedure GetProcessHandles(APID: Cardinal; AHandle: THandle; AList: TList);
|
|
class procedure GetProcessHandlesEx(APID: Cardinal; AHandle: THandle; AList: TList);
|
|
class procedure GetProcessHandlesEx2(APID: Cardinal; AHandle: THandle; AList: TList);
|
|
class function GetProcessModules(APID: Cardinal; AList: TList): boolean;
|
|
class procedure GetProcessWindows(APID: Cardinal; AOnlyVisible: Boolean; AList: TList);
|
|
class procedure GetProcessEnvironment(APID: Cardinal; AHandle: THandle; AList: TStringList);
|
|
class function FindThreadProcess(AThreadID: Cardinal): Cardinal;
|
|
|
|
class procedure SetThreadName(AID: Cardinal; const ADescription: string);
|
|
class function GetThreadName(AID: Cardinal): string;
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
|
|
procedure SkipFirstPass;
|
|
|
|
procedure GetRecord(AIndex: Integer; var ARecord: TProcessRecord);
|
|
procedure GetRecordByPID(APID: Cardinal; var ARecord: TProcessRecord);
|
|
procedure GetChildProcesses(APID: Cardinal; AList: TStringList);
|
|
procedure GetProcessList(AList: TList);
|
|
procedure SetWatchedProcess(APID: Cardinal; AValue: boolean);
|
|
function IsProcessWatched(APID: Cardinal): boolean;
|
|
procedure ClearWatch;
|
|
|
|
procedure SetThreadDesc(AID: Cardinal; const ADescription: string; const AFilename: string = '');
|
|
function GetThreadDesc(AID: Cardinal): string;
|
|
procedure RemoveThreadDesc(AID: Cardinal; const AFilename: string = '');
|
|
|
|
procedure SetThreadText(AID: Cardinal; const AText: string);
|
|
function GetThreadText(AID: Cardinal): string;
|
|
procedure RemoveThreadText(AID: Cardinal);
|
|
procedure SaveThreadTexts(const AFilename: string; ANoLock: Boolean = False);
|
|
procedure LoadThreadTexts(APID: Cardinal; const AFilename: string; ANoLock: Boolean = False);
|
|
|
|
property MaxCPUUsageProcessID: Cardinal read GetMaxCPUPID;
|
|
property MaxMemUsageProcessID: Cardinal read GetMaxMemPID;
|
|
property MaxIOUsageProcessID: Cardinal read GetMaxIOPID;
|
|
property TotalProcessPrivateBytes: uint64 read GetTotalPPB;
|
|
property TotalProcessWorkingSet: uint64 read GetTotalWS;
|
|
|
|
property CPUCoreCount: Byte read GetCPUCoreCount;
|
|
property CPUUsage: double read GetCPUUsage;
|
|
property CPURecords[Index: Byte]: TCPURecord read GetCPURecord;
|
|
property CPUCurrentClock: Cardinal read GetCPUCC;
|
|
property CPUMaxClock: Cardinal read GetCPUMC;
|
|
|
|
property ACPower: boolean read GetPowerStatus;
|
|
property BatteryRemaining: Byte read GetBatRem;
|
|
property BatterySecondsRemaining: int64 read GetBatRemSec;
|
|
property BatteryStatus: Cardinal read GetBatStatus;
|
|
|
|
property CurrentProcess: TProcessRecord read GetCurrentProcessRecord;
|
|
|
|
property AutoSuspend: Boolean read GetAutoSuspend write SetAutoSuspend;
|
|
property RecordCount: Integer read GetRecCount;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
property SamplePeriod: Cardinal read GetSamplePeriod write SetSamplePeriod;
|
|
property SampleMethod: TSampleMethod read GetSampleMethod write SetSampleMethod;
|
|
property PerformanceMeasuring: boolean read GetPerfMeas write SetPerfMeas;
|
|
property CalculateHash: boolean read GetCalcHash write SetCalcHash;
|
|
property EnumerateHandles: boolean read GetEnumHandles write SetEnumHandles;
|
|
property EnumerateModules: boolean read GetEnumMods write SetEnumMods;
|
|
property EnumerateThreads: boolean read GetEnumThrds write SetEnumThrds;
|
|
property EvaluateSymbols: boolean read GetEvalSym write SetEvalSym;
|
|
property EvaluateSecurityInfo: boolean read GetEvalSecInfo write SetEvalSecInfo;
|
|
property EvaluateProcessInfo: boolean read GetEvalProcInfo write SetEvalprocInfo;
|
|
property RetrieveProcessIcon: boolean read GetRetrieveProcIcon write SetRetrieveProcIcon;
|
|
property RetrieveProcessVersionInfo: boolean read GetRetrieveProcVersionInfo write SetRetrieveProcVersionInfo;
|
|
property AskFullProcessAccess: boolean read GetAskFullProcessAccess write SetAskFullProcessAccess;
|
|
property OnInterval: TSysProcMonNotifyEvent read GetOnInterval write SetOnInterval;
|
|
property OnSample: TSysProcMonSampleEvent read GetOnSample write SetOnSample;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
{$IFDEF TRIAL}VCL.Dialogs,{$ENDIF}WinApi.ShellAPI, WinAPI.TlHelp32, System.Math, System.DateUtils,
|
|
System.Win.Registry,
|
|
{$ELSE}
|
|
{$IFDEF TRIAL}Dialogs,{$ENDIF}ShellAPI, {$IFDEF FPC}JwaTlHelp32{$ELSE}TlHelp32{$ENDIF}, Math, DateUtils,
|
|
Registry,
|
|
{$ENDIF}
|
|
MiTeC_Routines, MiTeC_Datetime, MiTeC_StrUtils, MiTeC_WinCrypt, MiTeC_RegUtils, MiTeC_WMI, MiTeC_ImageHlp,
|
|
{$IFDEF FPC}MiTeC_FPC_WbemScripting_TLB{$ELSE}MiTeC_WbemScripting_TLB{$ENDIF};
|
|
|
|
type
|
|
TWinEnumParam = record
|
|
OnlyVisible: Boolean;
|
|
PID: Cardinal;
|
|
List: TList;
|
|
Count: Integer;
|
|
end;
|
|
PWinEnumParam = ^TWinEnumParam;
|
|
|
|
const
|
|
rsSystemIdle = '[System Idle Process]';
|
|
rsSystem = 'NT Kernel & System';
|
|
|
|
function EnumChildProc(Wnd: HWND; AParam: LPARAM): Boolean; stdcall;
|
|
var
|
|
WPID: Cardinal;
|
|
wep: PWinEnumParam;
|
|
w: PWindowRecord;
|
|
begin
|
|
wep:=PWinEnumParam(AParam);
|
|
GetWindowThreadProcessId(Wnd,WPID);
|
|
if (wep.PID=WPID) and (not wep.OnlyVisible or IsWindowVisible(Wnd)) then begin
|
|
if wep.Count=wep.List.Capacity then
|
|
wep.List.Capacity:=wep.List.Capacity+100;
|
|
new(w);
|
|
w^:=GetWindowInfo(Wnd,True);
|
|
wep.List.Add(w);
|
|
Inc(wep.Count);
|
|
end;
|
|
Result:=(Wnd<>0);
|
|
end;
|
|
|
|
function EnumWindowsProc(Wnd: HWND; AParam: LPARAM): Boolean; stdcall;
|
|
var
|
|
WPID: Cardinal;
|
|
wep: PWinEnumParam;
|
|
w: PWindowRecord;
|
|
begin
|
|
wep:=PWinEnumParam(AParam);
|
|
GetWindowThreadProcessId(Wnd,WPID);
|
|
if (wep.PID=WPID) and (not wep.OnlyVisible or IsWindowVisible(Wnd)) then begin
|
|
if (wep.List.Count>0) and (wep.Count=wep.List.Capacity) then
|
|
wep.List.Capacity:=wep.List.Capacity+100;
|
|
new(w);
|
|
w^:=GetWindowInfo(Wnd,True);
|
|
wep.List.Add(w);
|
|
Inc(wep.Count);
|
|
EnumChildWindows(Wnd,@EnumChildProc,AParam);
|
|
end;
|
|
Result:=(Wnd<>0);
|
|
end;
|
|
|
|
{ TSysProcMonThread }
|
|
|
|
class function TSysProcMonThread.BaseBoardName: string;
|
|
var
|
|
s: string;
|
|
begin
|
|
s:='';
|
|
Result:='';
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('HARDWARE\DESCRIPTION\System\BIOS',False) then begin
|
|
if ValueExists('BaseBoardManufacturer') then
|
|
Result:=Result+ReadString('BaseBoardManufacturer');
|
|
if ValueExists('BaseBoardProduct') then
|
|
Result:=Result+' '+ReadString('BaseBoardProduct');
|
|
if ValueExists('BaseBoardVersion') then begin
|
|
s:=ReadString('BaseBoardVersion');
|
|
if not SameText(s,'N/A') and (s<>'') then
|
|
Result:=Result+' '+s;
|
|
end;
|
|
Result:=Trim(Result);
|
|
CloseKey;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.BIOS: string;
|
|
begin
|
|
Result:='';
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('HARDWARE\DESCRIPTION\System\BIOS',False) then begin
|
|
if ValueExists('BIOSVendor') then
|
|
Result:=Result+ReadString('BIOSVendor');
|
|
if ValueExists('BIOSVersion') then
|
|
Result:=Result+' '+ReadString('BIOSVersion');
|
|
if ValueExists('BIOSReleaseDate') then
|
|
Result:=Result+' '+ReadString('BIOSReleaseDate');
|
|
Result:=Trim(Result);
|
|
CloseKey;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.BootTime: TDateTime;
|
|
begin
|
|
Result:=Now-(GetTickCountSafe/1000)/(24*3600);
|
|
end;
|
|
|
|
procedure TSysProcMonThread.Clear;
|
|
var
|
|
i: integer;
|
|
begin
|
|
{$IFDEF TRIAL}
|
|
if not RunFromIDE then
|
|
MessageDlg('TSysProcMonThread'+sLineBreak+cCompName+sLineBreak+cCopyright,mtInformation,[mbOK],0);
|
|
{$ENDIF}
|
|
InternalLock.Enter;
|
|
try
|
|
for i:=0 to FList.Count-1 do begin
|
|
PProcessRecord(FList[i])^.Finalize;
|
|
Dispose(PProcessRecord(FList[i]));
|
|
end;
|
|
FList.Clear;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
FWL.Clear;
|
|
FTL.Clear;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.ClearWatch;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FWL.Clear;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.CPUName: string;
|
|
begin
|
|
Result:='';
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('HARDWARE\DESCRIPTION\System\CentralProcessor\0',False) then begin
|
|
if ValueExists('ProcessorNameString') then
|
|
Result:=ReadString('ProcessorNameString')
|
|
else if ValueExists('Identifier') then
|
|
Result:=ReadString('Identifier');
|
|
Result:=StripSpaces(Result);
|
|
Result:=FastStringReplace(Result,'@','-');
|
|
CloseKey;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TSysProcMonThread.Create;
|
|
var
|
|
ShInfo: TSHFileInfo;
|
|
begin
|
|
inherited Create(True);
|
|
FSamplePeriod:=0;
|
|
FOnSample:=nil;
|
|
FEvalProcInfo:=True;
|
|
FAskFullProcessAccess:=True;
|
|
FPerfMeas:=True;
|
|
FEvalSecInfo:=True;
|
|
FProcIcon:=True;
|
|
FProcVerInfo:=True;
|
|
FEvalSym:=False;
|
|
FSampleMethod:=smAverage;
|
|
FFirstPass:=True;
|
|
FCalcHash:=False;
|
|
FEnumHandles:=False;
|
|
FEnumModules:=False;
|
|
FEnumThreads:=False;
|
|
InternalLock:=TCriticalSection.Create;
|
|
GetCPUTopology(FCPUPackageCount,FCPUCoreCount,FCPUCount);
|
|
FCPUCount:=SystemInfo.dwNumberOfProcessors;
|
|
FList:=TList.Create;
|
|
FWL:=TIntegerList.Create;
|
|
FWL.Duplicates:=dupIgnore;
|
|
FTL:=TStringlist.Create;
|
|
ResetMemory(FCurrentProcess,sizeof(FCurrentProcess));
|
|
FAutoSuspend:=False;
|
|
FMaxCPUPID:=0;
|
|
FMaxMemPID:=0;
|
|
FMaxIOPID:=0;
|
|
FCPUCycle.Clear;
|
|
FCPUIdleCycle.Clear;
|
|
FCPUTotalTime.Clear;
|
|
SetLength(FCPUData.Items,FCPUCount);
|
|
SetLength(FCPUKernel.Items,FCPUCount);
|
|
SetLength(FCPUIdle.Items,FCPUCount);
|
|
SetLength(FCPUUser.Items,FCPUCount);
|
|
FTicks.Update(GetTickCountSafe);
|
|
FPrevPerfDistribution:=nil;
|
|
NativeQueryProcessorPerformanceDistribution(FCurPerfDistribution);
|
|
FreeOnTerminate:=False;
|
|
FInterval:=1000;
|
|
FII:=0;
|
|
if SHGetFileInfo(PChar(IncludeTrailingPathDelimiter(GetSysDir)+'svchost.exe'),0,ShInfo,SizeOf(ShInfo),SHGFI_SYSICONINDEX)>0 then
|
|
FII:=shInfo.iIcon;
|
|
FWinSysDir:=GetWinSysDir;
|
|
end;
|
|
|
|
class function TSysProcMonThread.CurrentCommitCharge: Int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
PI: TPerformanceInformation;
|
|
begin
|
|
if Assigned(GetPerformanceInfo) and GetPerformanceInfo(@PI,sizeof(PI)) then
|
|
Result:=int64(PI.CommitTotal)*int64(PI.PageSize)
|
|
else if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullTotalPageFile-MSEX.ullAvailPageFile;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwTotalPageFile-MS.dwAvailPageFile;
|
|
end;
|
|
end;
|
|
|
|
destructor TSysProcMonThread.Destroy;
|
|
begin
|
|
FOnInterval:=nil;
|
|
if not Terminated then
|
|
Terminate;
|
|
while not Terminated do
|
|
Sleep(100);
|
|
Clear;
|
|
FList.Free;
|
|
FWL.Free;
|
|
FTL.Free;
|
|
Finalize(FCPUData);
|
|
Finalize(FCPUKernel);
|
|
Finalize(FCPUIdle);
|
|
Finalize(FCPUUser);
|
|
FreeAndNil(InternalLock);
|
|
if Assigned(FPrevPerfDistribution) then
|
|
Freemem(FPrevPerfDistribution);
|
|
if Assigned(FCurPerfDistribution) then
|
|
Freemem(FCurPerfDistribution);
|
|
inherited;
|
|
end;
|
|
|
|
class function TSysProcMonThread.DiskFileSystem(const ADisk: string): string;
|
|
var
|
|
sn,mcl,fsf: Cardinal;
|
|
vn,fsn: array[0..MAX_PATH] of char;
|
|
begin
|
|
Result:='';
|
|
if GetVolumeInformation(PChar(ADisk),vn,SizeOf(vn),@sn,mcl,fsf,fsn,SizeOf(fsn)) then
|
|
Result:=string(fsn);
|
|
end;
|
|
|
|
class function TSysProcMonThread.DiskFreeSpace(const ADisk: string): Int64;
|
|
var
|
|
t,f,tf: Int64;
|
|
begin
|
|
Result:=0;
|
|
if GetDiskFreeSpaceEx(PChar(ADisk),f,t,@tf) then
|
|
Result:=tf;
|
|
end;
|
|
|
|
class function TSysProcMonThread.DiskTotalSpace(const ADisk: string): Int64;
|
|
var
|
|
t,f,tf: Int64;
|
|
begin
|
|
Result:=0;
|
|
if GetDiskFreeSpaceEx(PChar(ADisk),f,t,@tf) then
|
|
Result:=t;
|
|
end;
|
|
|
|
class function TSysProcMonThread.DiskUserFreeSpace(const ADisk: string): Int64;
|
|
var
|
|
t,f,tf: Int64;
|
|
begin
|
|
Result:=0;
|
|
if GetDiskFreeSpaceEx(PChar(ADisk),f,t,@tf) then
|
|
Result:=f;
|
|
end;
|
|
|
|
class function TSysProcMonThread.DisplayVersion: string;
|
|
begin
|
|
Result:='';
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
Rootkey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion',False) and ValueExists('DisplayVersion') then
|
|
Result:=ReadString('DisplayVersion');
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.DoSync;
|
|
begin
|
|
if Assigned(FOnInterval) then
|
|
FOnInterval(Self);
|
|
end;
|
|
|
|
procedure TSysProcMonThread.Execute;
|
|
var
|
|
se: TSimpleEvent;
|
|
r: PProcessRecord;
|
|
sd: TSampleData;
|
|
ok: boolean;
|
|
s: string;
|
|
begin
|
|
se:=TSimpleEvent.Create{$IFDEF BDS35PLUS}(nil,False,False,''){$ENDIF};
|
|
BufferSize:=SizeOf(TSystemProcessInformation);
|
|
Buffer:=AllocMem(BufferSize);
|
|
try
|
|
while not Terminated do begin
|
|
InternalLock.Enter;
|
|
try
|
|
s:='';
|
|
FTicks.Update(GetTickCountSafe);
|
|
if FPerfMeas then
|
|
try
|
|
GetCPUTimes;
|
|
except on e: exception do
|
|
s:=s+Format('TSysProcMonThread.GetCPUTimes: %s',[e.Message])+sLineBreak;
|
|
end;
|
|
ok:=(FSamplePeriod>0) and (FTicks.AccumulatedDelta>=FSamplePeriod);
|
|
try
|
|
RefreshData;
|
|
except on e: exception do
|
|
s:=s+Format('TSysProcMonThread.RefreshData[%s]: %s',[FTF,e.Message])+sLineBreak;
|
|
end;
|
|
if ok then begin
|
|
if Assigned(FOnSample) then
|
|
GetSampleData(FSampleMethod,sd);
|
|
FCPUUsage.Clear(True);
|
|
FMemory.Clear(True);
|
|
for r in FList do begin
|
|
r.Performance.CPUUsage.Clear(True);
|
|
r.Performance.PrivateBytes.Clear(True);
|
|
r.Performance.IOReadUsage.Clear(True);
|
|
r.Performance.IOWriteUsage.Clear(True);
|
|
r.Performance.IOOtherUsage.Clear(True);
|
|
r.Performance.CPUTime.Clear(True);
|
|
r.Performance.CycleTime.Clear(True);
|
|
end;
|
|
end;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
|
|
if not FFirstPass and not Terminated then begin
|
|
if Assigned(FOnInterval) then
|
|
Synchronize(DoSync);
|
|
if ok then begin
|
|
if Assigned(FOnSample) then
|
|
FOnSample(Self,sd);
|
|
FTicks.Clear(True);
|
|
end;
|
|
end;
|
|
|
|
if s<>'' then
|
|
with TStringList.Create do try Text:=Trim(s); SaveToFile('TSysProcMonThread.log'); finally Free end;
|
|
|
|
if not Terminated then begin
|
|
if not FFirstPass and FAutoSuspend and not Suspended then
|
|
Suspended:=True
|
|
else
|
|
se.WaitFor(FInterval);
|
|
end;
|
|
|
|
FFirstPass:=False;
|
|
end;
|
|
finally
|
|
Freemem(Buffer);
|
|
se.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.FindThreadProcess(AThreadID: Cardinal): Cardinal;
|
|
var
|
|
SnapshotHandle: THandle;
|
|
th32: TThreadEntry32;
|
|
Continue: BOOL;
|
|
begin
|
|
Result:=Cardinal(-1);
|
|
SnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
|
|
if (SnapshotHandle=INVALID_HANDLE_VALUE) then
|
|
Exit;
|
|
try
|
|
th32.dwSize:=SizeOf(th32);
|
|
Continue:=Thread32First(SnapshotHandle,th32);
|
|
while Continue do begin
|
|
if (th32.th32ThreadID=AThreadID) then begin
|
|
Result:=th32.th32OwnerProcessID;
|
|
Exit;
|
|
end;
|
|
Continue:=Thread32Next(SnapshotHandle,th32);
|
|
end;
|
|
finally
|
|
CloseHandle(SnapshotHandle);
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.FreePageFile: Int64;
|
|
var
|
|
wmiServices: ISWbemServices;
|
|
wmi: TInstances;
|
|
begin
|
|
Result:=0;
|
|
if not WMIConnect('','','',Rootnamespace,wmiServices) then
|
|
Exit;
|
|
try
|
|
WMICommand(wmiServices,'Win32_PageFileUsage',wmi);
|
|
Result:=GetFileSize(GetInstancePropertyValue(wmi,'Name'))-StrToIntDef(GetInstancePropertyValue(wmi,'CurrentUsage'),0);
|
|
finally
|
|
WMIDisconnect(wmiServices);
|
|
Finalize(wmi);
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.FreePhysMemory: Int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
begin
|
|
if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullAvailPhys;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwAvailPhys;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.FreeVirtualMemory: Int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
begin
|
|
if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullAvailVirtual;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwAvailVirtual;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetAskFullProcessAccess: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FAskFullProcessAccess;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetAutoSuspend: Boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FAutoSuspend;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetBatRem: Byte;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FPS.BatteryLifePercent;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetBatRemSec: int64;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FPS.BatteryLifeTime;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetBatStatus: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FPS.BatteryFlag;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCalcHash: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCalcHash;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.GetChildProcesses(APID: Cardinal;
|
|
AList: TStringList);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
AList.Clear;
|
|
for i:=0 to FList.Count-1 do begin
|
|
if PProcessRecord(FList[i])^.ParentPID=APID then
|
|
AList.Add(Format('%d=%s',[PProcessRecord(FList[i])^.PID,PProcessRecord(FList[i])^.ImageName]))
|
|
else if AList.IndexOfName(IntToStr(PProcessRecord(FList[i])^.ParentPID))>-1 then
|
|
AList.Add(Format('%d=%s',[PProcessRecord(FList[i])^.PID,PProcessRecord(FList[i])^.ImageName]));
|
|
end;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPUCC: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCPUCurClock.RoundValue;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPUCoreCount: Byte;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCPUCoreCount;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPUCycles(var Values,IdleValues: TSamples): Integer;
|
|
var
|
|
i: integer;
|
|
spt: Pointer;
|
|
begin
|
|
if Length(Values.Items)=0 then begin
|
|
SetLength(Values.Items,FCPUCount);
|
|
SetLength(IdleValues.Items,FCPUCount);
|
|
Values.ClearValues;
|
|
IdleValues.ClearValues;
|
|
end;
|
|
try
|
|
spt:=AllocMem(sizeof(LARGE_INTEGER)*FCPUCount);
|
|
try
|
|
NtQuerySystemInformation(SystemProcessorCycleTimeInformation,spt,sizeof(LARGE_INTEGER)*FCPUCount,nil);
|
|
for i:=0 to FCPUCount-1 do
|
|
Values.Update(i,PLARGE_INTEGER(PAnsiChar(spt)+i*(sizeof(LARGE_INTEGER)))^.QuadPart);
|
|
|
|
Result:=NtQuerySystemInformation(SystemProcessorIdleCycleTimeInformation,spt,sizeof(LARGE_INTEGER)*FCPUCount,nil);
|
|
for i:=0 to FCPUCount-1 do
|
|
IdleValues.Update(i,PLARGE_INTEGER(PAnsiChar(spt)+i*(sizeof(LARGE_INTEGER)))^.QuadPart);
|
|
finally
|
|
FreeMem(spt);
|
|
end;
|
|
except
|
|
Result:=GetLastError;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCpuFrequencyFromDistribution: double;
|
|
var
|
|
stateSize: Cardinal;
|
|
diffs: Pointer;
|
|
stateDistribution: PSystemProcessorPerformanceStateDistribution;
|
|
stateDiff: PSystemProcessorPerformanceStateDistribution;
|
|
hitcountOld: PSystemProcessorPerformanceHitcountWin8;
|
|
i,j: Cardinal;
|
|
c,t,cp,tp: double;
|
|
begin
|
|
Result:=-1;
|
|
if (FCurPerfDistribution.ProcessorCount<>FCPUCount) or (FPrevPerfDistribution.ProcessorCount<>FCPUCount) then
|
|
Exit;
|
|
stateSize:=sizeof(TSystemProcessorPerformanceStateDistribution)+sizeof(TSystemProcessorPerformanceHitcount);
|
|
diffs:=AllocMem(stateSize*FCPUCount);
|
|
try
|
|
for i:=0 to FCPUCount-1 do begin
|
|
stateDistribution:=PSystemProcessorPerformanceStateDistribution(PAnsiChar(FCurPerfDistribution)+FCurPerfDistribution.Offsets[i]);
|
|
stateDiff:=Pointer(PAnsiChar(diffs)+stateSize*i);
|
|
if (stateDistribution.StateCount<>2) then
|
|
Exit;
|
|
for j:=0 to stateDistribution.StateCount-1 do begin
|
|
if (OS>=osBlue) then
|
|
stateDiff.States[j]:=stateDistribution.States[j]
|
|
else begin
|
|
hitcountOld:=PSystemProcessorPerformanceHitcountWin8(PAnsiChar(@stateDistribution.States)+sizeof(TSystemProcessorPerformanceHitcount)*j);
|
|
stateDiff.States[j].Hits:=hitcountOld.Hits;
|
|
stateDiff.States[j].PercentFrequency:=hitcountOld.PercentFrequency;
|
|
end;
|
|
end;
|
|
end;
|
|
for i:=0 to FCPUCount-1 do begin
|
|
stateDistribution:=PSystemProcessorPerformanceStateDistribution(PAnsiChar(FPrevPerfDistribution)+FPrevPerfDistribution.Offsets[i]);
|
|
stateDiff:=Pointer(PAnsiChar(diffs)+stateSize*i);
|
|
if (stateDistribution.StateCount<>2) then
|
|
Exit;
|
|
for j:=0 to stateDistribution.StateCount-1 do begin
|
|
if (OS>=osBlue) then
|
|
stateDiff.States[j].Hits:=stateDiff.States[j].Hits-stateDistribution.States[j].Hits
|
|
else begin
|
|
hitcountOld:=PSystemProcessorPerformanceHitcountWin8(PAnsiChar(@stateDistribution.States)+sizeof(TSystemProcessorPerformanceHitcount)*j);
|
|
stateDiff.States[j].Hits:=stateDiff.States[j].Hits-hitcountOld.Hits;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Calculate the frequency.
|
|
|
|
c:=0;
|
|
t:=0;
|
|
|
|
for i:=0 to FCPUCount-1 do begin
|
|
stateDiff:=Pointer(PAnsiChar(diffs)+stateSize*i);
|
|
cp:=0;
|
|
tp:=0;
|
|
FCPUData.Items[i].Number:=stateDiff.ProcessorNumber;
|
|
FCPUData.Items[i]._Fraction:=0;
|
|
for j:=0 to 1 do begin
|
|
cp:=cp+stateDiff.States[j].Hits;
|
|
tp:=tp+stateDiff.States[j].Hits*stateDiff.States[j].PercentFrequency;
|
|
end;
|
|
c:=c+cp;
|
|
t:=t+tp;
|
|
if CompareValue(cp,0)=1 then begin
|
|
FCPUData.Items[i]._Fraction:=tp/cp;
|
|
FCPUData.Items[i]._Fraction:=FCPUData.Items[i]._Fraction/100;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(diffs);
|
|
end;
|
|
|
|
if (c=0) then
|
|
Exit;
|
|
|
|
t:=t/c;
|
|
t:=t/100;
|
|
Result:=t;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPUMC: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCPUMaxClock.RoundValue;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPUTimes: Integer;
|
|
var
|
|
i: integer;
|
|
spt: Pointer;
|
|
idle,krnl,usr: TFileTime;
|
|
begin
|
|
try
|
|
spt:=AllocMem(FCPUCount*(SizeOf(TSystemProcessorTimes)+4));
|
|
try
|
|
Result:=NtQuerySystemInformation(SystemProcessorPerformanceInformation,spt,FCPUCount*(SizeOf(TSystemProcessorTimes)+4),@Result);
|
|
if Result=S_OK then
|
|
for i:=0 to FCPUCount-1 do
|
|
with PSystemProcessorTimes(PAnsiChar(spt)+i*(sizeof(TSystemProcessorTimes)+4))^ do begin
|
|
FCPUIdle.Update(i,IdleTime.QuadPart);
|
|
FCPUKernel.Update(i,KernelTime.QuadPart-IdleTime.QuadPart);
|
|
FCPUUser.Update(i,UserTime.QuadPart);
|
|
end;
|
|
finally
|
|
FreeMem(spt);
|
|
end;
|
|
except
|
|
Result:=GetLastError;
|
|
end;
|
|
{$IFNDEF FPC}
|
|
if Result<>0 then begin
|
|
{$IFDEF RAD9PLUS}WinAPi.Windows.{$ENDIF}GetSystemTimes(idle,krnl,usr);
|
|
for i:=0 to FCPUCount-1 do begin
|
|
FCPUIdle.Update(i,(UInt64(idle.dwHighDateTime) shl 32 or idle.dwLowDateTime)/FCPUCount);
|
|
FCPUKernel.Update(i,(UInt64(krnl.dwHighDateTime) shl 32 or krnl.dwLowDateTime)/FCPUCount-FCPUIdle.Items[i].Value);
|
|
FCPUUser.Update(i,(UInt64(usr.dwHighDateTime) shl 32 or usr.dwLowDateTime)/FCPUCount);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPUUsage: double;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCPUUsage.Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCurrentProcessRecord: TProcessRecord;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCurrentProcess;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetEnumHandles: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FEnumHandles;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetEnumMods: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FEnumModules;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetEnumThrds: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FEnumThreads;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetEvalProcInfo: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FEvalProcInfo;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetEvalSecInfo: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FEvalSecInfo;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetEvalSym: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FEvalSym;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetInterval: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FInterval;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.GetProcessList(AList: TList);
|
|
var
|
|
i: Integer;
|
|
p: PProcessRecord;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
for i:=0 to AList.Count-1 do
|
|
Dispose(PProcessRecord(AList[i]));
|
|
AList.Clear;
|
|
AList.Capacity:=FList.Capacity;
|
|
for i:=0 to FList.Count-1 do begin
|
|
new(p);
|
|
p^:=PProcessRecord(FList[i])^;
|
|
AList.Add(p);
|
|
end;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetCPURecord(Index: Byte): TCPURecord;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FCPUData.Items[Index];
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetMaxCPUPID: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FMaxCPUPID;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetMaxIOPID: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FMaxIOPID;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetMaxMemPID: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FMaxMemPID;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.GetParentProps(APID: Cardinal; var AImageName, ACmdline: string);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
AImageName:='';
|
|
ACmdLine:='';
|
|
for i:=0 to FList.Count-1 do
|
|
if PProcessRecord(FList[i]).PID=APID then begin
|
|
ACmdLine:=PProcessRecord(FList[i]).CommandLine;
|
|
AImageName:=PProcessRecord(FList[i]).ImageName;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetPerfMeas: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FPerfMeas;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetPowerStatus: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FPS.ACLineStatus<>0;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.GetProcessImageNameByHandle(
|
|
AHandle: THandle): string;
|
|
var
|
|
c: {$IFDEF NATIVEINT}NativeUInt{$ELSE}Cardinal{$ENDIF};
|
|
pbi: PROCESS_BASIC_INFORMATION;
|
|
pb: TPEB;
|
|
ib: TProcessParameters;
|
|
pwc: PWideChar;
|
|
n,j: Cardinal;
|
|
Buf: array[0..MAX_PATH] of char;
|
|
begin
|
|
Result:='';
|
|
c:=0;
|
|
if (AHandle<>0) and (AHandle<>INVALID_HANDLE_VALUE) then
|
|
try
|
|
n:=SizeOf(Buf);
|
|
if Assigned(QueryFullProcessImageName) and (QueryFullProcessImageName(AHandle,0,@Buf,@n)>0) then
|
|
Result:=Buf;
|
|
if (Result='') and (NtQueryInformationProcess(AHandle,ProcessBasicInformation,@pbi,SizeOf(pbi),@c)=0) then
|
|
if ReadProcessMemory(AHandle,pbi.PebBaseAddress,@pb,SizeOf(pb),c) then
|
|
if ReadProcessMemory(AHandle,Pointer(pb.ProcessParameters),@ib,SizeOf(ib),c) then begin
|
|
pwc:=AllocMem(MAX_PATH+1);
|
|
try
|
|
if ReadProcessMemory(AHandle,Pointer(ib.ImagePathName.Buffer),pwc,MAX_PATH,c) then
|
|
Result:=WideCharToString(pwc);
|
|
finally
|
|
FreeMem(pwc);
|
|
end;
|
|
end;
|
|
ResetMemory(Buf,SizeOf(Buf));
|
|
c:=0;
|
|
if (Result='') and (NtQueryInformationProcess(AHandle,ProcessImageFileName,@Buf,SizeOf(Buf),@c)=0) then begin
|
|
Result:=Trim(Copy(string(Buf),5,c));
|
|
if Result<>'' then
|
|
for j:=0 to High(VolumeTable.Items) do
|
|
if Pos(VolumeTable.Items[j].DeviceName,Result)=1 then begin
|
|
Result:=StringReplace(Result,VolumeTable.Items[j].DeviceName,VolumeTable.Items[j].DiskSign,[rfIgnoreCase]);
|
|
Break;
|
|
end;
|
|
end;
|
|
if (Result<>'') and not FileExists(Result) then
|
|
Result:=ExpandEnvVars(Result);
|
|
finally
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.GetProcessImageNameByPID(
|
|
APID: Cardinal): string;
|
|
var
|
|
h: THandle;
|
|
begin
|
|
h:=GetProcessHandle(APID,PROCESS_DUP_HANDLE);
|
|
if (h<>0) and (h<>INVALID_HANDLE_VALUE) then
|
|
try
|
|
GetProcessImageNameByHandle(h);
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.GetProcessMemoryCountersByHandle(
|
|
AHandle: THandle): TProcessMemoryCountersEx;
|
|
var
|
|
cb: Cardinal;
|
|
begin
|
|
cb:=SizeOf(Result);
|
|
ResetMemory(Result,cb);
|
|
GetProcessMemoryInfo(AHandle,@Result,cb);
|
|
end;
|
|
|
|
class function TSysProcMonThread.GetProcessMemoryCountersByPID(
|
|
APID: Cardinal): TProcessMemoryCountersEx;
|
|
var
|
|
h: THandle;
|
|
begin
|
|
ResetMemory(Result,sizeof(Result));
|
|
h:=GetProcessHandle(APID);
|
|
if (h<>0) and (h<>INVALID_HANDLE_VALUE) then
|
|
try
|
|
Result:=GetProcessMemoryCountersByHandle(h);
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetOnInterval: TSysProcMonNotifyEvent;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FOnInterval;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetOnSample: TSysProcMonSampleEvent;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FOnSample;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetRecCount: Integer;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FList.Count;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.GetRecord(AIndex: Integer;
|
|
var ARecord: TProcessRecord);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
ResetMemory(ARecord,SizeOf(ARecord));
|
|
if AIndex<FList.Count then
|
|
ARecord:=PProcessRecord(FList[AIndex])^;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.GetRecordByPID(APID: Cardinal;
|
|
var ARecord: TProcessRecord);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
_GetRecordByPID(APID,ARecord);
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetRetrieveProcIcon: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FProcIcon;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetRetrieveProcVersionInfo: boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FProcVerInfo;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.GetSampleData(AMethod: TSampleMethod; var AData: TSampleData);
|
|
var
|
|
r: PProcessRecord;
|
|
s: TSampleRecord;
|
|
begin
|
|
Finalize(AData);
|
|
s.ID:=0;
|
|
s.Name:='System';
|
|
s.SessionID:=0;
|
|
case AMethod of
|
|
smCurrent: begin
|
|
s.CPUUsage:=FCPUUsage.Value;
|
|
s.MemUsage:=FMemory.RoundValue;
|
|
end;
|
|
smAverage: begin
|
|
s.CPUUsage:=FCPUUsage.AverageValue;
|
|
s.MemUsage:=Round(FMemory.AverageValue);
|
|
end;
|
|
end;
|
|
s.CreateTime:=BootTime;
|
|
s.CommandLine:=FormOSName;
|
|
SetLength(AData,Length(AData)+1);
|
|
AData[High(AData)]:=s;
|
|
for r in FList do
|
|
if r.PID>0 then begin
|
|
s.ID:=r.PID;
|
|
s.Name:=r.Name;
|
|
s.SessionID:=r.SessionID;
|
|
case AMethod of
|
|
smCurrent: begin
|
|
s.CPUUsage:=r.Performance.CPUUsage.Value;
|
|
s.MemUsage:=r.Performance.PrivateBytes.RoundValue;
|
|
end;
|
|
smAverage: begin
|
|
s.CPUUsage:=r.Performance.CPUUsage.AverageValue;
|
|
s.MemUsage:=Round(r.Performance.PrivateBytes.AverageValue);
|
|
end;
|
|
end;
|
|
s.CreateTime:=r.CreationTime;
|
|
s.CommandLine:=r.CommandLine;
|
|
s.Username:=r.UserName;
|
|
SetLength(AData,Length(AData)+1);
|
|
AData[High(AData)]:=s;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetSampleMethod: TSampleMethod;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FSampleMethod;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetSamplePeriod: Cardinal;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FSamplePeriod;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetThreadDesc(AID: Cardinal): string;
|
|
var
|
|
h: THandle;
|
|
p: PWideChar;
|
|
begin
|
|
if Assigned(GetThreadDescription) then begin
|
|
h:=GetThreadHandle(AID);
|
|
try
|
|
p:=nil;
|
|
GetThreadDescription(h,p);
|
|
Result:=string(p);
|
|
if Assigned(p) then
|
|
LocalFree(p);
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end else
|
|
Result:=GetThreadText(AID);
|
|
end;
|
|
|
|
class function TSysProcMonThread.GetThreadName(AID: Cardinal): string;
|
|
var
|
|
h: THandle;
|
|
p: PWideChar;
|
|
begin
|
|
if not Assigned(GetThreadDescription) then
|
|
Exit;
|
|
h:=GetThreadHandle(AID);
|
|
try
|
|
p:=nil;
|
|
GetThreadDescription(h,p);
|
|
Result:=string(p);
|
|
if Assigned(p) then
|
|
LocalFree(p);
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetThreadText(AID: Cardinal): string;
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:='';
|
|
idx:=FTL.IndexOfName(IntToStr(AID));
|
|
if (idx>-1) then
|
|
Result:=FTL.ValueFromIndex[idx];
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetTotalPPB: uint64;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FTotalPPB;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread.GetTotalWS: uint64;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FTotalWS;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.HandleCount: Cardinal;
|
|
var
|
|
pi: TPerformanceInformation;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(GetPerformanceInfo) or not GetPerformanceInfo(@pi,SizeOf(pi)) then
|
|
Exit;
|
|
Result:=pi.HandleCount;
|
|
end;
|
|
|
|
class function TSysProcMonThread.InstallDate: TDateTime;
|
|
const
|
|
rvInstalldate = 'FirstInstallDateTime';
|
|
rvInstalldateNT = 'InstallDate';
|
|
SecsPerDay = 24*60*60;
|
|
var
|
|
p: PAnsiChar;
|
|
n: Cardinal;
|
|
ft: TFiletime;
|
|
begin
|
|
Result:=0;
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
Rootkey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion',False) then begin
|
|
if ValueExists(rvInstallDate) then begin
|
|
try
|
|
n:=ReadInteger(rvInstallDate);
|
|
except
|
|
n:=GetDataSize(rvInstallDate);
|
|
p:=AllocMem(n);
|
|
try
|
|
ReadBinarydata(rvInstallDate,p^,n);
|
|
Move(p[0],n,n);
|
|
finally
|
|
FreeMem(p);
|
|
end;
|
|
end;
|
|
DosDateTimeToFileTime(HiWord(n),LoWord(n),ft);
|
|
Result:=FileTimeTodateTime(ft);
|
|
end;
|
|
if ValueExists(rvInstallDateNT) then begin
|
|
n:=ReadInteger(rvInstallDateNT);
|
|
Result:=Int(Encodedate(1970,1,1));
|
|
Result:=((Result*SecsPerDay)+n)/SecsPerDay;
|
|
end;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.InstalledMemory: Int64;
|
|
const
|
|
i = 1073741824;
|
|
var
|
|
e,m: Double;
|
|
t: Int64;
|
|
begin
|
|
e:=2;
|
|
m:=i;
|
|
t:=TotalPhysMemory;
|
|
while Round(m)<t do begin
|
|
m:=e*i;
|
|
e:=e+1;
|
|
end;
|
|
Result:=Round(m);
|
|
end;
|
|
|
|
function TSysProcMonThread.IsProcessWatched(APID: Cardinal): boolean;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
Result:=FWL.IndexOf(APID)>-1;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.LastShutdown: TDateTime;
|
|
var
|
|
rki: TRegKeyInfo;
|
|
begin
|
|
Result:=0;
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('SYSTEM\CurrentControlSet\Control\Windows',False) then begin
|
|
GetKeyInfo(rki);
|
|
Result:=UTCToLocalDatetime({$IFNDEF FPC}FileTimeToDateTime{$ENDIF}(rki.FileTime));
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.LimitCommitCharge: int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
PI: TPerformanceInformation;
|
|
begin
|
|
if Assigned(GetPerformanceInfo) and GetPerformanceInfo(@PI,sizeof(PI)) then
|
|
Result:=int64(PI.CommitLimit)*int64(PI.PageSize)
|
|
else if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullTotalPageFile;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwTotalPageFile;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.LoadThreadTexts(APID: Cardinal; const AFilename: string; ANoLock: Boolean = False);
|
|
var
|
|
i,idx,j: Integer;
|
|
sl: TStringList;
|
|
begin
|
|
if not FileExists(AFilename) then
|
|
Exit;
|
|
if not ANoLock then
|
|
InternalLock.Enter;
|
|
try
|
|
sl:=TStringList.Create;
|
|
try
|
|
j:=_GetRecordByPID(APID);
|
|
if j=-1 then
|
|
Exit;
|
|
try sl.LoadFromFile(AFilename) except end;
|
|
for i:=0 to PProcessRecord(FList[j]).ThreadList.Count-1 do begin
|
|
idx:=sl.IndexOfName(IntToStr(PThreadRecord(PProcessRecord(FList[j]).ThreadList[i])^.ID));
|
|
if (idx>-1) and (sl.ValueFromIndex[idx]<>'') then
|
|
PThreadRecord(PProcessRecord(FList[j]).ThreadList[i])^.Text:=sl.ValueFromIndex[idx];
|
|
end;
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
finally
|
|
if not ANoLock then
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
|
|
class function TSysProcMonThread.LogicalCPUCount: Cardinal;
|
|
{var
|
|
k: integer;
|
|
n: Cardinal;
|
|
buf1,slpi: PSystemLogicalProcessorInformation;
|
|
buf2,slpiex: PSystemLogicalProcessorInformationEx;}
|
|
begin
|
|
{Result:=0;
|
|
if Assigned(GetLogicalProcessorInformationEx) then begin
|
|
n:=0;
|
|
GetLogicalProcessorInformationEx(RelationAll,nil,n);
|
|
buf2:=AllocMem(n);
|
|
try
|
|
if GetLogicalProcessorInformationEx(RelationAll,buf2,n) then begin
|
|
slpiex:=buf2;
|
|
while (NativeUInt(slpiex)-NativeUInt(buf2))<n do begin
|
|
if slpiex.Relationship=RelationProcessorCore then begin
|
|
for k:=0 to slpiex.Processor.GroupCount-1 do
|
|
inc(Result,CountSetBits(slpiex.Processor.GroupMask[k].Mask));
|
|
end;
|
|
slpiex:=PSystemLogicalProcessorInformationEx(NativeUInt(slpiex)+slpiex.Size);
|
|
end;
|
|
if Result=0 then
|
|
Result:=1;
|
|
end;
|
|
finally
|
|
Freemem(buf2);
|
|
end;
|
|
end else if Assigned(GetLogicalProcessorInformation) then begin
|
|
n:=0;
|
|
if not GetLogicalProcessorInformation(nil,n) then begin
|
|
buf1:=AllocMem(n);
|
|
try
|
|
if GetLogicalProcessorInformation(buf1,n) then begin
|
|
slpi:=buf1;
|
|
while (NativeUInt(slpi)-NativeUInt(buf1))<n do begin
|
|
if slpi.Relationship=RelationProcessorCore then
|
|
Inc(Result,CountSetBits(slpi.ProcessorMask));
|
|
slpi:=PSystemLogicalProcessorInformation(NativeUInt(slpi)+SizeOf(TSystemLogicalProcessorInformation));
|
|
end;
|
|
if Result=0 then
|
|
Result:=1;
|
|
end;
|
|
finally
|
|
FreeMem(buf1);
|
|
end;
|
|
end;
|
|
end else}
|
|
Result:=SystemInfo.dwNumberOfProcessors;
|
|
end;
|
|
|
|
class function TSysProcMonThread.MemoryLoad: Cardinal;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
begin
|
|
if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.dwMemoryLoad;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwMemoryLoad;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.NonPagedPool: Int64;
|
|
var
|
|
pi: TPerformanceInformation;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(GetPerformanceInfo) or not GetPerformanceInfo(@pi,SizeOf(pi)) then
|
|
Exit;
|
|
Result:=Int64(pi.KernelNonpaged)*Int64(pi.PageSize);
|
|
end;
|
|
|
|
class function TSysProcMonThread.PagedPool: Int64;
|
|
var
|
|
pi: TPerformanceInformation;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(GetPerformanceInfo) or not GetPerformanceInfo(@pi,SizeOf(pi)) then
|
|
Exit;
|
|
Result:=Int64(pi.KernelPaged)*Int64(pi.PageSize);
|
|
end;
|
|
|
|
class function TSysProcMonThread.ProcessCount: Cardinal;
|
|
var
|
|
pi: TPerformanceInformation;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(GetPerformanceInfo) or not GetPerformanceInfo(@pi,SizeOf(pi)) then
|
|
Exit;
|
|
Result:=pi.ProcessCount;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.RefreshData;
|
|
var
|
|
status: Cardinal;
|
|
pspi: PSystemProcessInformation;
|
|
i,j,idx,hr: Integer;
|
|
br,tid :Cardinal;
|
|
n: {$IFDEF NATIVEINT}NativeUint{$ELSE}Cardinal{$ENDIF};
|
|
r: PProcessRecord;
|
|
tr: PThreadRecord;
|
|
mr: PModuleRecord;
|
|
Wow64: LongBool;
|
|
Buf: array[0..MAX_PATH] of char;
|
|
pbi: PROCESS_BASIC_INFORMATION;
|
|
pb: TPEB;
|
|
ib: TProcessParameters;
|
|
pwc,p,td: PWideChar;
|
|
mc,mm,mio,io: double;
|
|
s: string;
|
|
ShInfo: TSHFileInfo;
|
|
ok: bool;
|
|
cpu,f: double;
|
|
c: UInt64;
|
|
mbi: TMemoryBasicInformation;
|
|
envbuf: TBytes;
|
|
sa: NativeUInt;
|
|
stct,stt,cct,tt: UInt64;
|
|
ppi: Pointer;
|
|
pi: TProcessorPowerInformation;
|
|
th: THandle;
|
|
mf: boolean;
|
|
ff: double;
|
|
begin
|
|
FTF:='';
|
|
FMAXCPUPID:=0;
|
|
FMAXMemPID:=0;
|
|
FTotalPPB:=0;
|
|
FTotalWS:=0;
|
|
mc:=0;
|
|
mm:=0;
|
|
mio:=0;
|
|
stct:=0;
|
|
|
|
GetSystemPowerStatus(FPS);
|
|
|
|
if FPerfMeas then begin
|
|
UpdateCPUCycleTime;
|
|
UpdateCpuSysTime;
|
|
|
|
if Assigned(FPrevPerfDistribution) then
|
|
Freemem(FPrevPerfDistribution);
|
|
FPrevPerfDistribution:=FCurPerfDistribution;
|
|
NativeQueryProcessorPerformanceDistribution(FCurPerfDistribution);
|
|
|
|
if Assigned(CallNtPowerInformation) then begin
|
|
ppi:=AllocMem(FCPUCount*SizeOf(TProcessorPowerInformation));
|
|
try
|
|
CallNtPowerInformation(ProcessorInformation,nil,0,ppi,FCPUCount*SizeOf(TProcessorPowerInformation));
|
|
FCPUMaxClock.Update(PProcessorPowerInformation(ppi).MaxMhz);
|
|
f:=-1;
|
|
if Assigned(FCurPerfDistribution) and Assigned(FPrevPerfDistribution) then
|
|
f:=GetCpuFrequencyFromDistribution;
|
|
ff:=PProcessorPowerInformation(ppi).MaxMhz*f;
|
|
if CompareValue(ff,100)=1 then
|
|
FCPUCurClock.Update(ff)
|
|
else
|
|
FCPUCurClock.Update(PProcessorPowerInformation(ppi).CurrentMhz);
|
|
for i:=0 to FCPUCount-1 do begin
|
|
pi:=PProcessorPowerInformation(PProcessorPowerInformation(PAnsiChar(ppi)+i*SizeOf(TProcessorPowerInformation)))^;
|
|
if CompareValue(ff,100)=1 then
|
|
FCPUData.Items[i].CurrentClock:=Round(pi.MaxMhz*FCPUData.Items[i]._Fraction)
|
|
else
|
|
FCPUData.Items[i].CurrentClock:=pi.CurrentMhz;
|
|
FCPUData.Items[i].MaxClock:=pi.MaxMhz;
|
|
end;
|
|
finally
|
|
FreeMem(ppi);
|
|
end;
|
|
end;
|
|
end;
|
|
status:=NtQuerySystemInformation(SystemProcessInformation,Buffer,BufferSize,@br);
|
|
while (status=STATUS_BUFFER_OVERFLOW) or (status=STATUS_INFO_LENGTH_MISMATCH) do begin
|
|
if br=0 then
|
|
Inc(BufferSize,$1000)
|
|
else
|
|
BufferSize:=br;
|
|
ReallocMem(Buffer,BufferSize);
|
|
status:=NtQuerySystemInformation(SystemProcessInformation,Buffer,BufferSize,@br);
|
|
end;
|
|
if status=STATUS_SUCCESS then begin
|
|
for i:=0 to FList.Count-1 do begin
|
|
PProcessRecord(FList[i])._Exists:=False;
|
|
PProcessRecord(FList[i]).ChildCount:=0;
|
|
PProcessRecord(FList[i]).ChildInstancesPrivateBytes:=0;
|
|
PProcessRecord(FList[i]).ChildInstancesUsage:=0;
|
|
end;
|
|
|
|
if FPerfMeas then begin
|
|
pspi:=PSystemProcessInformation(Buffer);
|
|
repeat
|
|
idx:=-1;
|
|
if pspi.ProcessId=0 then
|
|
pspi.CycleTime:=FCpuIdleCycle.RoundValue;
|
|
for i:=0 to FList.Count-1 do
|
|
if (PProcessRecord(FList[i]).PID=pspi.ProcessId) and SameDateTime(PProcessRecord(FList[i]).CreationTime,FileTimeToDateTime(TFileTime(pspi.CreateTime),True)) then begin
|
|
idx:=i;
|
|
Break;
|
|
end;
|
|
|
|
if idx=-1 then
|
|
inc(stct,pspi.CycleTime)
|
|
else begin
|
|
inc(stct,pspi.CycleTime-PProcessRecord(FList[idx]).Performance.CycleTime.RoundUValue);
|
|
PProcessRecord(FList[i])._Exists:=True;
|
|
end;
|
|
if pspi^.NextEntryDelta=0 then
|
|
Break;
|
|
pspi:=PSystemProcessInformation(PAnsiChar(pspi)+pspi^.NextEntryDelta);
|
|
until False;
|
|
cct:=FCPUCycle.RoundDelta;
|
|
inc(stct,cct);
|
|
end;
|
|
|
|
i:=0;
|
|
while i<FList.Count do
|
|
if not PProcessRecord(FList[i])._Exists then begin
|
|
c:=0;
|
|
if FPerfMeas then begin
|
|
if (PProcessRecord(FList[i]).Handle<>INVALID_HANDLE_VALUE) and (PProcessRecord(FList[i]).Handle<>0) and Assigned(QueryProcessCycleTime) then
|
|
QueryProcessCycleTime(PProcessRecord(FList[i]).Handle,@c);
|
|
Inc(stct,c-PProcessRecord(FList[i]).Performance.CycleTime.RoundUValue);
|
|
end;
|
|
PProcessRecord(FList[i]).Finalize;
|
|
Dispose(PProcessRecord(FList[i]));
|
|
FList.Delete(i);
|
|
end else
|
|
Inc(i);
|
|
FList.Capacity:=FList.Count;
|
|
|
|
if FPerfMeas then begin
|
|
stt:=FCPUTotalTime.RoundValue;
|
|
if (stct=0) then
|
|
stct:=UInt64(-1);
|
|
if (stt=0) then
|
|
stt:=UInt64(-1);
|
|
|
|
FMemory.Update(UsedPhysMemory);
|
|
if not SameValue(FCPUCycle.Value,0) then begin
|
|
FCPUUsage.Update((1-FCPUIdleCycle.Delta/stct)*100);
|
|
for i:=0 to High(FCPUData.Items) do begin
|
|
tt:=FCPUKernel.Items[i].RoundDelta+FCPUUser.Items[i].RoundDelta+FCPUIdle.Items[i].RoundDelta;
|
|
if tt=0 then
|
|
FCPUData.Items[i].Usage:=0
|
|
else
|
|
FCPUData.Items[i].Usage:=(FCPUKernel.Items[i].Delta+FCPUUser.Items[i].Delta)/tt*100;
|
|
end;
|
|
end else begin
|
|
cpu:=0;
|
|
if CompareValue(FTicks.Delta,0)=1 then
|
|
for i:=0 to High(FCPUData.Items) do begin
|
|
FCPUData.Items[i].Usage:=100-(FCPUIdle.Items[i].Delta/FTicks.Delta)/100;
|
|
cpu:=cpu+FCPUData.Items[i].Usage;
|
|
end;
|
|
FCPUUsage.Update(cpu/FCPUCount);
|
|
end;
|
|
end;
|
|
pspi:=PSystemProcessInformation(Buffer);
|
|
repeat
|
|
idx:=-1;
|
|
for i:=0 to FList.Count-1 do
|
|
if (PProcessRecord(FList[i]).PID=pspi.ProcessId) then begin
|
|
idx:=i;
|
|
Break;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(r);
|
|
r.Initialize;
|
|
r.Handle:=GetProcessHandle(pspi.ProcessId,0,FAskFullProcessAccess);
|
|
r.IsNew:=True;
|
|
r._ImageIndex:=FII;
|
|
r.Performance.CycleTime.Clear;
|
|
if pspi.ProcessId=0 then
|
|
r.Performance.CycleTime.Value:=FCpuIdleCycle.Value;
|
|
r.Performance.CPUTime.Clear;
|
|
if FEvalProcInfo then begin
|
|
if (pspi.ProcessId>4) then
|
|
r.DpiAwareness:=GetWinDpiAwareness(GetProcessWindow(pspi.ProcessId,True));
|
|
if r.DpiAwareness=dpiUnavailable then
|
|
r.DpiAwareness:=GetProcDpiAwareness(r.Handle);
|
|
end;
|
|
FList.Add(r);
|
|
idx:=FList.Count-1;
|
|
end else
|
|
PProcessRecord(FList[idx])^.IsNew:=False;
|
|
|
|
r:=PProcessRecord(FList[idx]);
|
|
with r^ do begin
|
|
if pspi.ProcessId=0 then
|
|
s:=rsSystemIdle
|
|
else if pspi.ProcessId=4 then begin
|
|
s:=rsSystem;
|
|
if OS<=osXP then
|
|
ImageName:=ExpandFilename(FileSearchEx('ntkrnlpa.exe',FWinSysDir))
|
|
else
|
|
ImageName:=ExpandFilename(FileSearchEx('ntoskrnl.exe',FWinSysDir));
|
|
end else
|
|
s:={$IFDEF UNICODE}string{$ELSE}WideToAnsi{$ENDIF}(pspi.ProcessName.Buffer);
|
|
|
|
_Exists:=True;
|
|
PID:=pspi.ProcessId;
|
|
SessionID:=pspi.SessionId;
|
|
BasePriority:=pspi.BasePriority;
|
|
ParentPID:=pspi.InheritedFromProcessId;
|
|
if FEvalProcInfo then begin
|
|
if ParentImage='' then
|
|
GetParentProps(ParentPID,ParentImage,ParentCmd);
|
|
end;
|
|
ThreadCount:=pspi.ThreadCount;
|
|
HandleCount:=pspi.HandleCount;
|
|
UserTime:=pspi.UserTime.QuadPart;
|
|
KernelTime:=pspi.KernelTime.QuadPart;
|
|
CreationTime:=FileTimeToDateTime(TFileTime(pspi.CreateTime),True);
|
|
VMCounters:=pspi.VmCounters;
|
|
IOCounters:=pspi.IoCounters;
|
|
GDIHandleCount:=GetGuiResources(Handle,GR_GDIOBJECTS);
|
|
USERHandleCount:=GetGuiResources(Handle,GR_USEROBJECTS);
|
|
//PMCounters:=GetProcessMemoryCounters(Handle);
|
|
if FPerfMeas then begin
|
|
Inc(FTotalPPB,VMCounters.PrivatePageCount);
|
|
Inc(FTotalWS,VMCounters.WorkingSetSize);
|
|
|
|
r.Performance.PrivateBytes.Update(pspi.VmCounters.PrivatePageCount);
|
|
r.Performance.IOReadUsage.Update(pspi.IOCounters.ReadTransferCount.QuadPart);
|
|
r.Performance.IOWriteUsage.Update(pspi.IOCounters.WriteTransferCount.QuadPart);
|
|
r.Performance.IOOtherUsage.Update(pspi.IOCounters.OtherTransferCount.QuadPart);
|
|
|
|
ok:=False;
|
|
if (Handle<>INVALID_HANDLE_VALUE) and (Handle<>0) then begin
|
|
Priority:=GetPriorityClass(Handle);
|
|
GetProcessAffinityMask(Handle,Affinity,sa);
|
|
ok:=Assigned(QueryProcessCycleTime);
|
|
end;
|
|
|
|
cpu:=0;
|
|
if pspi.UniqueProcessKey<>$FFFFFFFF then
|
|
Performance.CycleTime.Update(pspi.CycleTime);
|
|
Performance.CPUTime.Update(pspi.KernelTime.QuadPart+pspi.UserTime.QuadPart);
|
|
if ok then begin
|
|
QueryProcessCycleTime(Handle,@Cycles);
|
|
cpu:=(Performance.CycleTime.Delta/stct)*100
|
|
end else if CompareValue(FTicks.Delta,0)=1 then
|
|
cpu:=((Performance.CPUTime.Delta/FTicks.Delta)/100)/FCPUCount;
|
|
if not InRange(cpu,0,100) then
|
|
cpu:=Performance.CPUUsage.Value;
|
|
|
|
Performance.CPUUsage.Update(cpu);
|
|
|
|
io:=Performance.IOReadUsage.Delta+Performance.IOWriteUsage.Delta+Performance.IOOtherUsage.Delta;
|
|
if pspi.ProcessId>0 then begin
|
|
if CompareValue(Performance.CPUUsage.Value,mc)=1 then begin
|
|
mc:=Performance.CPUUsage.Value;
|
|
FMaxCPUPID:=pspi.ProcessId;
|
|
end;
|
|
if pspi.VmCounters.PrivatePageCount>mm then begin
|
|
mm:=pspi.VmCounters.PrivatePageCount;
|
|
FMaxMemPID:=pspi.ProcessId;
|
|
end;
|
|
if io>mio then begin
|
|
mio:=io;
|
|
FMaxIOPID:=pspi.ProcessId;
|
|
end;
|
|
end;
|
|
end;
|
|
IsSuspended:=FEvalProcInfo;
|
|
if FEvalProcInfo then begin
|
|
for i:=0 to FList.Count-1 do
|
|
if (PProcessRecord(FList[i]).PID=pspi.InheritedFromProcessId) then begin
|
|
Inc(PProcessRecord(FList[i]).ChildCount);
|
|
if SameText(PProcessRecord(FList[i]).Name,s) then begin
|
|
Inc(PProcessRecord(FList[i]).ChildInstancesPrivateBytes,pspi.VmCounters.PrivatePageCount);
|
|
PProcessRecord(FList[i]).ChildInstancesUsage:=PProcessRecord(FList[i]).ChildInstancesUsage+Performance.CPUUsage.Value;
|
|
end;
|
|
Break;
|
|
end;
|
|
|
|
for i:=0 to pspi.ThreadCount-1 do begin
|
|
if (pspi.Threads[i].State<>5{Cardinal(StateWait)}) or (pspi.Threads[i].WaitReason<>5{Cardinal(Suspended)}) then begin
|
|
IsSuspended:=False;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if (Name='') or not SameText(Name,s) then begin
|
|
|
|
Name:=s;
|
|
|
|
if (Handle<>INVALID_HANDLE_VALUE) and (Handle<>0) then
|
|
try
|
|
if (&Platform=0) then begin
|
|
if Is64 then begin
|
|
Wow64:=False;
|
|
if Assigned(IsWow64Process) and IsWow64Process(Handle,Wow64) then begin
|
|
if not Wow64 then
|
|
&Platform:=64
|
|
else
|
|
&Platform:=32;
|
|
end;
|
|
end else
|
|
&Platform:=32;
|
|
end;
|
|
|
|
{ZeroMemory(@Buf,SizeOf(Buf));
|
|
if GetModuleFileNameEx(Handle,0,@Buf,SizeOf(Buf))>0 then begin
|
|
ImageName:=Buf;
|
|
SetLength(ImageName,StrLen(PChar(ImageName)));
|
|
ImageName:=StringReplace(ImageName,'\??\','',[]);
|
|
end;}
|
|
|
|
if ImageName='' then begin
|
|
n:=SizeOf(Buf);
|
|
if Assigned(QueryFullProcessImageName) then
|
|
if QueryFullProcessImageName(Handle,0,@Buf,@n)>0 then
|
|
ImageName:=Buf;
|
|
end;
|
|
|
|
if ImageName='' then begin
|
|
ResetMemory(Buf,SizeOf(Buf));
|
|
n:=0;
|
|
if NtQueryInformationProcess(Handle,ProcessImageFileName,@Buf,SizeOf(Buf),@n)=0 then begin
|
|
ImageName:=Trim(Copy(string(Buf),5,n));
|
|
if ImageName<>'' then
|
|
for i:=0 to High(VolumeTable.Items) do
|
|
if Pos(VolumeTable.Items[i].DeviceName,ImageName)=1 then begin
|
|
ImageName:=StringReplace(ImageName,VolumeTable.Items[i].DeviceName,VolumeTable.Items[i].DiskSign,[rfIgnoreCase]);
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
if ImageName='' then
|
|
ImageName:=ExpandFilename(FileSearchEx(Name,FWinSysDir+ExtractFilePath(ImageName)));
|
|
if (ImageName<>'') and not FileExists(ImageName) then
|
|
ImageName:=ExpandEnvVars(ImageName);
|
|
if (Pos('.',ImageName)=0) and not FileExists(ImageName) then
|
|
ImageName:='';
|
|
n:=0;
|
|
|
|
if NtQueryInformationProcess(Handle,ProcessBasicInformation,@pbi,SizeOf(pbi),@n)=0 then begin
|
|
if ReadProcessMemory(Handle,pbi.PebBaseAddress,@pb,SizeOf(pb),n) then
|
|
if ReadProcessMemory(Handle,Pointer(pb.ProcessParameters),@ib,SizeOf(ib),n) then begin
|
|
if VirtualQueryEx(Handle,ib.Environment,mbi,SizeOf(mbi))=0 then
|
|
br:=(mbi.RegionSize-(ULONG_PTR(ib.Environment)-ULONG_PTR(mbi.BaseAddress)))
|
|
else
|
|
br:=ib.EnvironmentSize;
|
|
if (br=0) or (br>1048576) then begin
|
|
if (os<=osXP) then
|
|
br:=(mbi.RegionSize-(ULONG_PTR(ib.Environment)-ULONG_PTR(mbi.BaseAddress)))
|
|
else
|
|
br:=MAXWORD;
|
|
end;
|
|
repeat
|
|
SetLength(envbuf,br);
|
|
if ReadProcessMemory(Handle,Pointer(ib.Environment),@envbuf[0],br,n) and (n>0) then
|
|
Break;
|
|
br:=br div 2;
|
|
until (br<256);
|
|
if (n>0) then begin
|
|
p:=PWideChar(@envbuf[0]);
|
|
while p^<> #0 do begin
|
|
if p[0]<>'=' then
|
|
Environment:=Environment+{$IFNDEF UNICODE}WideCharToString{$ENDIF}(p)+sLineBreak;
|
|
Inc(p,Length(WideString(p))+1);
|
|
end;
|
|
Environment:=Trim(Environment);
|
|
end;
|
|
|
|
pwc:=AllocMem(ib.CommandLine.MaximumLength);
|
|
try
|
|
if ReadProcessMemory(Handle,Pointer(ib.CommandLine.Buffer),pwc,ib.CommandLine.MaximumLength,n) then
|
|
CommandLine:=WideCharToString(pwc);
|
|
if ImageName='' then begin
|
|
if ib.CommandLine.MaximumLength<ib.ImagePathName.MaximumLength then
|
|
ReallocMem(pwc,ib.ImagePathName.MaximumLength);
|
|
if ReadProcessMemory(Handle,Pointer(ib.ImagePathName.Buffer),pwc,ib.ImagePathName.MaximumLength,n) then
|
|
ImageName:=WideCharToString(pwc);
|
|
end;
|
|
finally
|
|
FreeMem(pwc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if CommandLine='' then
|
|
CommandLine:=ImageName;
|
|
|
|
GetProcessUserName(Handle,Username,DomainName);
|
|
if FEvalSecInfo then begin
|
|
GetProcessPrivileges(Handle,Privileges,Elevation);
|
|
GetProcessGroups(Handle,Groups);
|
|
end;
|
|
if FProcIcon and (PID>4) and (SHGetFileInfo(PChar(ImageName),0,ShInfo,SizeOf(ShInfo),SHGFI_SYSICONINDEX)>0) and not IsSuspended then
|
|
_ImageIndex:=shInfo.iIcon;
|
|
finally
|
|
|
|
end;
|
|
|
|
if (&Platform=0) and not IsSuspended then begin
|
|
if Is64 then
|
|
&Platform:=64
|
|
else
|
|
&Platform:=32;
|
|
end;
|
|
|
|
if FProcVerInfo then
|
|
GetFileVerInfo(ImageName,VersionInfo);
|
|
if FCalcHash then
|
|
SHA1:=BytesToHEX(CreateFileHash(ImageName));
|
|
|
|
System:=SameText(DomainName,'NT AUTHORITY') or
|
|
//SameText(DomainName,'Window Manager') or
|
|
SameText(Username,'SYSTEM') or
|
|
SameText(Username,'LOCAL SERVICE') or
|
|
SameText(Username,'NETWORK SERVICE') or
|
|
((Username='') and (SessionId<2)) or
|
|
(PID<5);
|
|
end;
|
|
|
|
if FWL.IndexOf(pspi.ProcessId)>-1 then begin
|
|
WindowCount:=GetWindowCount(pspi.ProcessId);
|
|
if FEnumModules then
|
|
mf:=GetProcessModules(pspi.ProcessId,ModuleList)
|
|
else
|
|
mf:=False;
|
|
if FEnumHandles then begin
|
|
if OS>=osWin8 then
|
|
GetProcessHandlesEx2(pspi.ProcessId,Handle,HandleList)
|
|
else
|
|
GetProcessHandlesEx(pspi.ProcessId,Handle,HandleList);
|
|
end;
|
|
if FEnumThreads then begin
|
|
for i:=0 to ThreadList.Count-1 do
|
|
PThreadRecord(ThreadList[i])._Exists:=False;
|
|
|
|
for i:=0 to pspi.ThreadCount-1 do begin
|
|
idx:=-1;
|
|
for j:=0 to ThreadList.Count-1 do begin
|
|
if pspi.ProcessId<>0 then
|
|
tid:=pspi.Threads[i].ClientId.UniqueThread
|
|
else
|
|
tid:=i;
|
|
if (PThreadRecord(ThreadList[j]).ID=tid) then begin
|
|
idx:=j;
|
|
Break;
|
|
end;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(tr);
|
|
ResetMemory(tr^,sizeof(tr^));
|
|
if pspi.ProcessId<>0 then
|
|
tr.ID:=pspi.Threads[i].ClientId.UniqueThread
|
|
else
|
|
tr.ID:=ThreadList.Count;
|
|
tr.MaxCPUUsage:=0;
|
|
tr.AvgCPUUsage:=0;
|
|
tr.CPUUsage:=0;
|
|
tr.Cycles.Clear;
|
|
tr.CPUTime.Clear;
|
|
tr.Handle:=GetThreadHandle(pspi.Threads[i].ClientId.UniqueThread);
|
|
//if not DuplicateHandle(GetCurrentProcess,tr.Handle,GetCurrentProcess,@th,THREAD_QUERY_INFORMATION,FALSE,0) then
|
|
th:=tr.Handle;
|
|
NtQueryInformationThread(th,ThreadQuerySetWin32StartAddress,@tr.StartAddress,SizeOf(PVOID),nil);
|
|
{if th<>tr.Handle then
|
|
CloseHandle(th);}
|
|
if tr.StartAddress=0 then
|
|
tr.StartAddress:=PNativeUInt(@(pspi.Threads[i].StartAddress))^;
|
|
tr.StartAddressString:=Format('0x%x',[tr.StartAddress]);
|
|
for j:=0 to ModuleList.Count-1 do begin
|
|
mr:=PModuleRecord(ModuleList[j]);
|
|
if (tr.StartAddress>=mr.BaseAddress) and (tr.StartAddress<=mr.BaseAddress+mr.ImageSize) then begin
|
|
tr.StartAddressString:=Format('%s+0x%x',[mr.Name,tr.StartAddress-mr.BaseAddress]);
|
|
if FEvalSym then begin
|
|
s:=GetDescriptionAtAddr(Handle,tr.StartAddress,mr.BaseAddress,mr.ImageName);
|
|
if s='' then
|
|
s:=GetDescriptionAtAddr2(Handle,tr.StartAddress,mr.BaseAddress,mr.ImageName);
|
|
if s<>'' then
|
|
tr.StartAddressString:=s;
|
|
end;
|
|
Break;
|
|
end;
|
|
end;
|
|
ThreadList.Add(tr);
|
|
idx:=ThreadList.Count-1;
|
|
end;
|
|
with PThreadRecord(ThreadList[idx])^ do begin
|
|
_Exists:=True;
|
|
Text:=FTL.Values[IntToStr(ID)];
|
|
State:=pspi.Threads[i].State;
|
|
ContextSwitchCount:=pspi.Threads[i].ContextSwitchCount;
|
|
WaitReason:=pspi.Threads[i].WaitReason;
|
|
Priority:=pspi.Threads[i].Priority;
|
|
BasePriority:=pspi.Threads[i].BasePriority;
|
|
KernelTime:=pspi.Threads[i].KernelTime.QuadPart;
|
|
UserTime:=pspi.Threads[i].UserTime.QuadPart;
|
|
WaitTime:=pspi.Threads[i].WaitTime;
|
|
CreateTime:=FileTimeToDateTime(TFiletime(pspi.Threads[i].CreateTime),True);
|
|
|
|
if Assigned(GetThreadDescription) then begin
|
|
td:=nil;
|
|
hr:=GetThreadDescription(Handle,td);
|
|
Description:=string(td);
|
|
if Assigned(td) then
|
|
LocalFree(td);
|
|
end;
|
|
|
|
CPUTime.Update(pspi.Threads[i].KernelTime.QuadPart+pspi.Threads[i].UserTime.QuadPart);
|
|
ok:=Assigned(QueryThreadCycleTime) and (Handle<>INVALID_HANDLE_VALUE) and (Handle<>0);
|
|
|
|
if ok then begin
|
|
QueryThreadCycleTime(Handle,@c);
|
|
Cycles.Update(c);
|
|
if not SameValue(Cycles.Value,Cycles.Delta) then
|
|
CPUUsage:=(Cycles.Delta/stct)*100;
|
|
end else if not SameValue(CPUTime.Value,CPUTime.Delta) then
|
|
CPUUsage:=(CPUTime.Delta/stt)*100;
|
|
|
|
if not InRange(CPUUsage,0,100) then
|
|
CPUUsage:=0;
|
|
if CPUUsage>MaxCPUUsage then
|
|
MaxCPUUsage:=CPUUsage;
|
|
AvgCPUUsage:=(AvgCPUUsage+CPUUsage)/2;
|
|
end;
|
|
end;
|
|
i:=0;
|
|
while i<ThreadList.Count do
|
|
if not PThreadRecord(ThreadList[i])._Exists then begin
|
|
CloseHandle(PThreadRecord(ThreadList[i])^.Handle);
|
|
Dispose(PThreadRecord(ThreadList[i]));
|
|
ThreadList.Delete(i);
|
|
end else
|
|
Inc(i);
|
|
ThreadList.Capacity:=ThreadList.Count;
|
|
if (pspi.ProcessId<>4) and not mf then
|
|
ModuleList.Clear;
|
|
end;
|
|
end;
|
|
end else
|
|
Name:=s;
|
|
end;
|
|
if pspi.ProcessId=GetCurrentProcessId then
|
|
FCurrentProcess:=r^;
|
|
if pspi^.NextEntryDelta=0 then
|
|
Break;
|
|
pspi:=PSystemProcessInformation(PAnsiChar(pspi)+pspi^.NextEntryDelta);
|
|
until False;
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.GetProcessEnvironment(APID: Cardinal;
|
|
AHandle: THandle; AList: TStringList);
|
|
var
|
|
h: Boolean;
|
|
n: {$IFDEF NATIVEINT}NativeUint{$ELSE}Cardinal{$ENDIF};
|
|
pbi: PROCESS_BASIC_INFORMATION;
|
|
pb: TPEB;
|
|
ib: TProcessParameters;
|
|
s: string;
|
|
mbi: TMemoryBasicInformation;
|
|
envbuf: TBytes;
|
|
br :Cardinal;
|
|
p: PWideChar;
|
|
begin
|
|
AList.Clear;
|
|
h:=False;
|
|
if AHandle=0 then begin
|
|
AHandle:=GetProcessHandle(APID{,PROCESS_DUP_HANDLE});
|
|
h:=True;
|
|
end;
|
|
if (AHandle=0) or (AHandle=INVALID_HANDLE_VALUE) then
|
|
Exit;
|
|
try
|
|
n:=0;
|
|
s:='';
|
|
if NtQueryInformationProcess(AHandle,ProcessBasicInformation,@pbi,SizeOf(pbi),@n)=0 then begin
|
|
if ReadProcessMemory(AHandle,pbi.PebBaseAddress,@pb,SizeOf(pb),n) then
|
|
if ReadProcessMemory(AHandle,Pointer(pb.ProcessParameters),@ib,SizeOf(ib),n) then begin
|
|
if VirtualQueryEx(AHandle,ib.Environment,mbi,SizeOf(mbi))=0 then
|
|
br:=(mbi.RegionSize-(ULONG_PTR(ib.Environment)-ULONG_PTR(mbi.BaseAddress)))
|
|
else
|
|
br:=ib.EnvironmentSize;
|
|
if (br=0) or (br>1048576) then begin
|
|
if (os<=osXP) then
|
|
br:=(mbi.RegionSize-(ULONG_PTR(ib.Environment)-ULONG_PTR(mbi.BaseAddress)))
|
|
else
|
|
br:=MAXWORD;
|
|
end;
|
|
repeat
|
|
SetLength(envbuf,br);
|
|
if ReadProcessMemory(AHandle,Pointer(ib.Environment),@envbuf[0],br,n) and (n>0) then
|
|
Break;
|
|
br:=br div 2;
|
|
until (br<256);
|
|
if (n>0) then begin
|
|
p:=PWideChar(@envbuf[0]);
|
|
while p^<> #0 do begin
|
|
if p[0]<>'=' then
|
|
s:=s+{$IFNDEF UNICODE}WideCharToString{$ENDIF}(p)+sLineBreak;
|
|
Inc(p,Length(WideString(p))+1);
|
|
end;
|
|
s:=Trim(s);
|
|
end;
|
|
end;
|
|
end;
|
|
AList.Text:=s;
|
|
finally
|
|
if h then
|
|
CloseHandle(AHandle);
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.GetProcessHandles(APID: Cardinal;
|
|
AHandle: THandle; AList: TList);
|
|
var
|
|
Buffer: Pointer;
|
|
br,status,sz,c: Cardinal;
|
|
pshi: PSystemHandleTableEntryInfo;
|
|
r: PHandleRecord;
|
|
i,idx: integer;
|
|
h: Boolean;
|
|
begin
|
|
try
|
|
h:=False;
|
|
if AHandle=0 then begin
|
|
AHandle:=GetProcessHandle(APID,PROCESS_DUP_HANDLE);
|
|
h:=True;
|
|
end;
|
|
if (AHandle=0) or (AHandle=INVALID_HANDLE_VALUE) then
|
|
Exit;
|
|
try
|
|
for i:=0 to AList.Count-1 do
|
|
PHandleRecord(AList[i])._Exists:=False;
|
|
|
|
sz:=SizeOf(TSystemHandleInformation);
|
|
Buffer:=AllocMem(sz);
|
|
try
|
|
status:=NtQuerySystemInformation(SystemHandleInformation,Buffer,sz,@br);
|
|
while (status=STATUS_BUFFER_OVERFLOW) or (status=STATUS_INFO_LENGTH_MISMATCH) do begin
|
|
sz:=br;
|
|
ReallocMem(Buffer,sz);
|
|
status:=NtQuerySystemInformation(SystemHandleInformation,Buffer,sz,@br);
|
|
end;
|
|
if status=STATUS_SUCCESS then begin
|
|
c:=0;
|
|
pshi:=PSystemHandleTableEntryInfo(PAnsiChar(Buffer)+{$IFDEF WIN64}2*{$ENDIF}SizeOf(DWORD));
|
|
repeat
|
|
ResetMemory(r,sizeof(r));
|
|
if (pshi^.UniqueProcessId=APID) then begin
|
|
idx:=-1;
|
|
for i:=0 to AList.Count-1 do
|
|
if (PHandleRecord(AList[i]).Handle=pshi^.HandleValue) then begin
|
|
idx:=i;
|
|
r:=PHandleRecord(AList[idx]);
|
|
Break;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(r);
|
|
ResetMemory(r^,SizeOf(r^));
|
|
end;
|
|
r._Exists:=True;
|
|
if (idx=-1) or (r.Typ=integer(OB_TYPE_FILE)) then begin
|
|
r.PID:=pshi^.UniqueProcessId;
|
|
r.Handle:=pshi^.HandleValue;
|
|
r.Access:=pshi^.GrantedAccess;
|
|
r.Typ:=pshi^.ObjectTypeIndex;
|
|
r.FilePos:=-1;
|
|
|
|
GetHandleProps(AHandle,r^);
|
|
|
|
if (idx=-1) and (r.Name<>'') then
|
|
AList.Add(r)
|
|
else if idx=-1 then
|
|
Dispose(r);
|
|
end;
|
|
|
|
end;
|
|
Inc(c);
|
|
if c>PDWORD(Buffer)^ then
|
|
Break;
|
|
pshi:=PSystemHandleTableEntryInfo(PAnsiChar(pshi)+SizeOf(pshi^));
|
|
until pshi=nil;
|
|
end;
|
|
finally
|
|
Freemem(Buffer);
|
|
end;
|
|
finally
|
|
if h then
|
|
CloseHandle(AHandle);
|
|
end;
|
|
|
|
i:=0;
|
|
while i<AList.Count do
|
|
if not PHandleRecord(AList[i])._Exists {$IFDEF DEBUG}and (Pos('ERROR',PHandleRecord(AList[i]).TypeName)=0){$ENDIF} then begin
|
|
Dispose(PHandleRecord(AList[i]));
|
|
AList.Delete(i);
|
|
end else
|
|
Inc(i);
|
|
AList.Capacity:=AList.Count;
|
|
|
|
except
|
|
{$IFDEF DEBUG}
|
|
on e: exception do begin
|
|
r.TypeName:='ERROR: '+r.TypeName;
|
|
r.Name:=r.Name+' ('+e.Message+')';
|
|
r._Exists:=True;
|
|
if (idx=-1) then
|
|
AList.Add(r);
|
|
end
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.GetProcessHandlesEx(APID: Cardinal;
|
|
AHandle: THandle; AList: TList);
|
|
var
|
|
Buffer: Pointer;
|
|
br,status,sz,c: Cardinal;
|
|
pshi: PSystemHandleTableEntryInfoEx;
|
|
r: PHandleRecord;
|
|
i,idx: integer;
|
|
h: Boolean;
|
|
begin
|
|
try
|
|
h:=False;
|
|
if AHandle=0 then begin
|
|
AHandle:=GetProcessHandle(APID,PROCESS_DUP_HANDLE);
|
|
h:=True;
|
|
end;
|
|
if (AHandle=0) or (AHandle=INVALID_HANDLE_VALUE) then
|
|
Exit;
|
|
try
|
|
for i:=0 to AList.Count-1 do
|
|
PHandleRecord(AList[i])._Exists:=False;
|
|
|
|
sz:=$10000;
|
|
Buffer:=AllocMem(sz);
|
|
try
|
|
status:=NtQuerySystemInformation(SystemExtendedHandleInformation,Buffer,sz,@br);
|
|
while (status=STATUS_BUFFER_OVERFLOW) or (status=STATUS_INFO_LENGTH_MISMATCH) do begin
|
|
sz:=br;
|
|
ReallocMem(Buffer,sz);
|
|
status:=NtQuerySystemInformation(SystemExtendedHandleInformation,Buffer,sz,@br);
|
|
end;
|
|
if status=STATUS_SUCCESS then begin
|
|
c:=0;
|
|
pshi:=PSystemHandleTableEntryInfoEx(PAnsiChar(Buffer)+2*SizeOf(ULONG_PTR));
|
|
repeat
|
|
if (pshi^.UniqueProcessId=APID) then begin
|
|
idx:=-1;
|
|
ResetMemory(r,sizeof(r));
|
|
for i:=0 to AList.Count-1 do
|
|
if (PHandleRecord(AList[i]).Handle=pshi^.HandleValue) then begin
|
|
idx:=i;
|
|
r:=PHandleRecord(AList[idx]);
|
|
Break;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(r);
|
|
ResetMemory(r^,SizeOf(r^));
|
|
end;
|
|
r._Exists:=True;
|
|
if (idx=-1) or (r.Typ=integer(OB_TYPE_FILE)) then begin
|
|
r.PID:=pshi^.UniqueProcessId;
|
|
r.Handle:=pshi^.HandleValue;
|
|
r.Access:=pshi^.GrantedAccess;
|
|
r.Typ:=pshi^.ObjectTypeIndex;
|
|
r.FilePos:=-1;
|
|
|
|
GetHandleProps(AHandle,r^);
|
|
|
|
if (idx=-1) and (r.Name<>'') then
|
|
AList.Add(r)
|
|
else if idx=-1 then
|
|
Dispose(r);
|
|
end;
|
|
|
|
end;
|
|
Inc(c);
|
|
if c>PULONG_PTR(Buffer)^ then
|
|
Break;
|
|
pshi:=PSystemHandleTableEntryInfoEx(PAnsiChar(pshi)+SizeOf(pshi^));
|
|
until pshi=nil;
|
|
end;
|
|
finally
|
|
Freemem(Buffer);
|
|
end;
|
|
finally
|
|
if h then
|
|
CloseHandle(AHandle);
|
|
end;
|
|
|
|
i:=0;
|
|
while i<AList.Count do
|
|
if not PHandleRecord(AList[i])._Exists {$IFDEF DEBUG}and (Pos('ERROR',PHandleRecord(AList[i]).TypeName)=0){$ENDIF} then begin
|
|
Dispose(PHandleRecord(AList[i]));
|
|
AList.Delete(i);
|
|
end else
|
|
Inc(i);
|
|
AList.Capacity:=AList.Count;
|
|
|
|
except
|
|
{$IFDEF DEBUG}
|
|
on e: exception do begin
|
|
r.TypeName:='ERROR: '+r.TypeName;
|
|
r.Name:=r.Name+' ('+e.Message+')';
|
|
r._Exists:=True;
|
|
if (idx=-1) then
|
|
AList.Add(r);
|
|
end
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.GetProcessHandlesEx2(APID: Cardinal;
|
|
AHandle: THandle; AList: TList);
|
|
var
|
|
Buffer: Pointer;
|
|
br,status,sz: Cardinal;
|
|
pshi: PProcessHandleTableEntryInfo;
|
|
r: PHandleRecord;
|
|
i,j: integer;
|
|
c,idx: int64;
|
|
h: Boolean;
|
|
begin
|
|
try
|
|
h:=False;
|
|
if (AHandle=0) then begin
|
|
AHandle:=GetProcessHandle(APID,PROCESS_DUP_HANDLE);
|
|
h:=True;
|
|
end;
|
|
if (AHandle=0) or (AHandle=INVALID_HANDLE_VALUE) then
|
|
Exit;
|
|
try
|
|
for i:=0 to AList.Count-1 do
|
|
PHandleRecord(AList[i])._Exists:=False;
|
|
|
|
sz:=$8000;
|
|
Buffer:=AllocMem(sz);
|
|
try
|
|
status:=NtQueryInformationProcess(AHandle,ProcessHandleInformation,Buffer,sz,@br);
|
|
while (status=STATUS_BUFFER_OVERFLOW) or (status=STATUS_INFO_LENGTH_MISMATCH) do begin
|
|
sz:=br;
|
|
ReallocMem(Buffer,sz);
|
|
status:=NtQueryInformationProcess(AHandle,ProcessHandleInformation,Buffer,sz,@br);
|
|
end;
|
|
if status=STATUS_SUCCESS then begin
|
|
c:=PProcessHandleSnapshotInformation(Buffer).NumberOfHandles;
|
|
pshi:=PProcessHandleTableEntryInfo(PAnsiChar(Buffer)+2*sizeof(ULONG_PTR));
|
|
for i:=0 to c-1 do begin
|
|
idx:=-1;
|
|
ResetMemory(r,sizeof(r));
|
|
for j:=0 to AList.Count-1 do
|
|
if (PHandleRecord(AList[j]).Handle=pshi^.HandleValue) then begin
|
|
idx:=j;
|
|
r:=PHandleRecord(AList[idx]);
|
|
Break;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(r);
|
|
ResetMemory(r^,SizeOf(r^));
|
|
end;
|
|
r._Exists:=True;
|
|
if (idx=-1) or (r.Typ=integer(OB_TYPE_FILE)) then begin
|
|
r.PID:=APID;
|
|
r.Handle:=pshi.HandleValue;
|
|
r.Access:=pshi.GrantedAccess;
|
|
r.Typ:=pshi.ObjectTypeIndex;
|
|
r.Attributes:=pshi.HandleAttributes;
|
|
r.FilePos:=-1;
|
|
|
|
GetHandleProps(AHandle,r^);
|
|
|
|
if (idx=-1) and (r.Name<>'') then
|
|
AList.Add(r)
|
|
else if idx=-1 then
|
|
Dispose(r);
|
|
end;
|
|
if i=c-1 then
|
|
Break;
|
|
pshi:=PProcessHandleTableEntryInfo(PAnsiChar(pshi)+SizeOf(pshi^));
|
|
end;
|
|
end;
|
|
finally
|
|
Freemem(Buffer);
|
|
end;
|
|
finally
|
|
if h then
|
|
CloseHandle(AHandle);
|
|
end;
|
|
|
|
i:=0;
|
|
while i<AList.Count do
|
|
if not PHandleRecord(AList[i])._Exists {$IFDEF DEBUG}and (Pos('ERROR',PHandleRecord(AList[i]).TypeName)=0){$ENDIF} then begin
|
|
Dispose(PHandleRecord(AList[i]));
|
|
AList.Delete(i);
|
|
end else
|
|
Inc(i);
|
|
AList.Capacity:=AList.Count;
|
|
|
|
except
|
|
{$IFDEF DEBUG}
|
|
on e: exception do begin
|
|
r.TypeName:='ERROR: '+r.TypeName;
|
|
r.Name:=r.Name+' ('+e.Message+')';
|
|
r._Exists:=True;
|
|
if (idx=-1) then
|
|
AList.Add(r);
|
|
end
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.GetProcessModules(APID: Cardinal; AList: TList): boolean;
|
|
const
|
|
TH32CS_SNAPMODULE32 = $00000010;
|
|
var
|
|
i,j,idx,c: integer;
|
|
ms: THandle;
|
|
me32: TMODULEENTRY32;
|
|
ok: Boolean;
|
|
r: PModuleRecord;
|
|
s: string;
|
|
ba: NativeUInt;
|
|
Buffer: Pointer;
|
|
br,status,sz: Cardinal;
|
|
pmi: PRTLProcessModuleInformation;
|
|
begin
|
|
Result:=False;
|
|
try
|
|
for i:=0 to AList.Count-1 do
|
|
PModuleRecord(AList[i])._Exists:=False;
|
|
|
|
if APID>4 then begin
|
|
ms:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE or TH32CS_SNAPMODULE32,APID);
|
|
if (ms=INVALID_HANDLE_VALUE) then
|
|
ms:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE or TH32CS_SNAPMODULE32,0)
|
|
else
|
|
Result:=True;
|
|
try
|
|
me32.dwSize:=sizeof(TMODULEENTRY32);
|
|
ok:=Module32First(ms,me32);
|
|
while ok do begin
|
|
ba:=PNativeUInt(@(me32.modBaseAddr))^;
|
|
if PosText(Format('%x',[ba]),s)=0 then begin
|
|
idx:=-1;
|
|
for i:=0 to AList.Count-1 do
|
|
if (PModuleRecord(AList[i]).BaseAddress=ba) and SameText(string(me32.szModule),PModuleRecord(AList[i]).Name) then begin
|
|
idx:=i;
|
|
Break;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(r);
|
|
ResetMemory(r^,SizeOf(r^));
|
|
r.Name:=string(me32.szModule);
|
|
r.ImageName:=string(me32.szExePath);
|
|
r.ImageName:=StringReplace(r.ImageName,'\??\','',[rfIgnoreCase]);
|
|
if not FileExists(r.ImageName) then
|
|
r.ImageName:=ExpandEnvVars(r.ImageName);
|
|
if not FileExists(r.ImageName) then
|
|
r.ImageName:=ExpandFilename(FileSearchEx(r.ImageName,GetWinSysDir));
|
|
r.BaseAddress:=ba;
|
|
r.ImageSize:=me32.modBaseSize;
|
|
if FileExists(r.ImageName) then
|
|
GetFileVerInfo(r.ImageName,r.VersionInfo);
|
|
r.Size:=GetFileSize(r.ImageName);
|
|
if r.Size<0 then
|
|
r.Size:=0;
|
|
AList.Add(r);
|
|
idx:=AList.Count-1;
|
|
end;
|
|
if idx<>-1 then
|
|
PModuleRecord(AList[idx])^._Exists:=True;
|
|
s:=s+Format('%x,',[ba]);
|
|
end;
|
|
ok:=Module32Next(ms,me32);
|
|
end;
|
|
finally
|
|
CloseHandle(ms);
|
|
end;
|
|
end;
|
|
if (AList.Count=0) or not Result then begin
|
|
Result:=APID=4;
|
|
sz:=2048;
|
|
Buffer:=AllocMem(sz);
|
|
try
|
|
status:=NtQuerySystemInformation(SystemModuleInformation,Buffer,sz,@br);
|
|
while (status=STATUS_BUFFER_OVERFLOW) or (status=STATUS_INFO_LENGTH_MISMATCH) do begin
|
|
sz:=br;
|
|
ReallocMem(Buffer,sz);
|
|
status:=NtQuerySystemInformation(SystemModuleInformation,Buffer,sz,@br);
|
|
end;
|
|
if status=STATUS_SUCCESS then begin
|
|
c:=PRTLProcessModules(Buffer).NumberOfModules;
|
|
if c>0 then begin
|
|
pmi:=PRTLProcessModuleInformation(Addr(PRTLProcessModules(Buffer).Modules[0]));
|
|
for i:=0 to c-1 do begin
|
|
ba:=PNativeUInt(@(pmi.ImageBase))^;
|
|
s:=Copy(string(pmi.FullPathName),pmi^.OffsetToFileName+1);
|
|
if PosText(Format('%x',[ba]),s)=0 then begin
|
|
idx:=-1;
|
|
for j:=0 to AList.Count-1 do
|
|
if (PModuleRecord(AList[j]).BaseAddress=ba) and SameText(PModuleRecord(AList[j]).Name,s) then begin
|
|
idx:=j;
|
|
Break;
|
|
end;
|
|
if idx=-1 then begin
|
|
new(r);
|
|
ResetMemory(r^,SizeOf(r^));
|
|
r.ImageName:=string(pmi.FullPathName);
|
|
r.Name:=s;
|
|
r.ImageName:=FastStringReplace(r.ImageName,'\??\','');
|
|
if not FileExists(r.ImageName) then
|
|
r.ImageName:=ExpandEnvVars(r.ImageName);
|
|
if not FileExists(r.ImageName) then
|
|
r.ImageName:=ExpandFilename(FileSearchEx(r.ImageName,GetWinSysDir));
|
|
r.BaseAddress:=ba;
|
|
r.ImageSize:=pmi.ImageSize;
|
|
if FileExists(r.ImageName) then
|
|
GetFileVerInfo(r.ImageName,r.VersionInfo);
|
|
r.Size:=GetFileSize(r.ImageName);
|
|
if r.Size<0 then
|
|
r.Size:=0;
|
|
AList.Add(r);
|
|
idx:=AList.Count-1;
|
|
end;
|
|
if idx<>-1 then
|
|
PModuleRecord(AList[idx])^._Exists:=True;
|
|
s:=s+Format('%x,',[ba]);
|
|
end;
|
|
if i=c-1 then
|
|
Break;
|
|
pmi:=PRTLProcessModuleInformation(PAnsiChar(pmi)+SizeOf(pmi^));
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
end;
|
|
{
|
|
ph:=GetProcessHandle(APID);
|
|
if (ph<>INVALID_HANDLE_VALUE) and (ph<>0) then
|
|
try
|
|
if Assigned(EnumProcessModulesEx) and EnumProcessModulesEx(ph,nil,0,n,LIST_MODULES_ALL) then begin
|
|
hm:=AllocMem(n);
|
|
ok:=EnumProcessModulesEx(ph,hm,n,n,LIST_MODULES_ALL);
|
|
end else begin
|
|
EnumProcessModules(ph,nil,0,n);
|
|
hm:=AllocMem(n);
|
|
ok:=EnumProcessModules(ph,hm,n,n);
|
|
end;
|
|
if ok then begin
|
|
c:=n div SizeOf(HMODULE);
|
|
end;
|
|
finally
|
|
CloseHandle(ph);
|
|
end;
|
|
}
|
|
|
|
i:=0;
|
|
while i<AList.Count do
|
|
if not PModuleRecord(AList[i])._Exists then begin
|
|
Dispose(PModuleRecord(AList[i]));
|
|
AList.Delete(i);
|
|
end else
|
|
Inc(i);
|
|
AList.Capacity:=AList.Count;
|
|
finally
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.GetProcessThreads(APID: Cardinal; AList: TList);
|
|
var
|
|
Buffer: Pointer;
|
|
BufferSize: Cardinal;
|
|
br, status: Cardinal;
|
|
pspi: PSystemProcessInformation;
|
|
i: integer;
|
|
tr: PThreadRecord;
|
|
c: UInt64;
|
|
begin
|
|
AList.Clear;
|
|
BufferSize:=SizeOf(TSystemProcessInformation);
|
|
Buffer:=AllocMem(BufferSize);
|
|
status:=NtQuerySystemInformation(SystemProcessInformation,Buffer,BufferSize,@br);
|
|
while (status=STATUS_BUFFER_OVERFLOW) or (status=STATUS_INFO_LENGTH_MISMATCH) do begin
|
|
if br=0 then
|
|
Inc(BufferSize,$1000)
|
|
else
|
|
BufferSize:=br;
|
|
ReallocMem(Buffer,BufferSize);
|
|
status:=NtQuerySystemInformation(SystemProcessInformation,Buffer,BufferSize,@br);
|
|
end;
|
|
try
|
|
if status=STATUS_SUCCESS then begin
|
|
pspi:=PSystemProcessInformation(Buffer);
|
|
repeat
|
|
if pspi.ProcessId=APID then
|
|
for i:=0 to pspi.ThreadCount-1 do begin
|
|
new(tr);
|
|
if pspi.ProcessId<>0 then
|
|
tr.ID:=pspi.Threads[i].ClientId.UniqueThread
|
|
else
|
|
tr.ID:=AList.Count;
|
|
tr.MaxCPUUsage:=0;
|
|
tr.AvgCPUUsage:=0;
|
|
tr.CPUUsage:=0;
|
|
tr.Cycles.Clear;
|
|
tr.CPUTime.Clear;
|
|
tr.Handle:=GetThreadHandle(pspi.Threads[i].ClientId.UniqueThread);
|
|
NtQueryInformationThread(tr.Handle,ThreadQuerySetWin32StartAddress,@tr.StartAddress,SizeOf(PVOID),nil);
|
|
tr.StartAddressString:=Format('0x%x',[tr.StartAddress]);
|
|
tr._Exists:=True;
|
|
tr.State:=pspi.Threads[i].State;
|
|
tr.ContextSwitchCount:=pspi.Threads[i].ContextSwitchCount;
|
|
tr.WaitReason:=pspi.Threads[i].WaitReason;
|
|
tr.Priority:=pspi.Threads[i].Priority;
|
|
tr.BasePriority:=pspi.Threads[i].BasePriority;
|
|
tr.KernelTime:=pspi.Threads[i].KernelTime.QuadPart;
|
|
tr.UserTime:=pspi.Threads[i].UserTime.QuadPart;
|
|
tr.WaitTime:=pspi.Threads[i].WaitTime;
|
|
tr.CreateTime:=FileTimeToDateTime(TFiletime(pspi.Threads[i].CreateTime),True);
|
|
tr.CPUTime.Update(pspi.Threads[i].KernelTime.QuadPart+pspi.Threads[i].UserTime.QuadPart);
|
|
if Assigned(QueryThreadCycleTime) and (tr.Handle<>INVALID_HANDLE_VALUE) and (tr.Handle<>0) then begin
|
|
QueryThreadCycleTime(tr.Handle,@c);
|
|
tr.Cycles.Update(c);
|
|
end;
|
|
AList.Add(tr);
|
|
end;
|
|
if pspi^.NextEntryDelta=0 then
|
|
Break;
|
|
pspi:=PSystemProcessInformation(PAnsiChar(pspi)+pspi^.NextEntryDelta);
|
|
until AList.Count>0;
|
|
end;
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.GetProcessWindows(APID: Cardinal;
|
|
AOnlyVisible: Boolean; AList: TList);
|
|
var
|
|
wep: PWinEnumParam;
|
|
begin
|
|
new(wep);
|
|
try
|
|
AList.Clear;
|
|
wep.PID:=APID;
|
|
wep.List:=AList;
|
|
wep.OnlyVisible:=AOnlyVisible;
|
|
wep.Count:=0;
|
|
EnumWindows(@EnumWindowsProc,lParam(Integer(wep)));
|
|
finally
|
|
dispose(wep);
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.ReleaseID: string;
|
|
begin
|
|
Result:='';
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
Rootkey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion',False) and ValueExists('ReleaseId') then
|
|
Result:=ReadString('ReleaseId');
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.RemoveThreadDesc(AID: Cardinal;
|
|
const AFilename: string);
|
|
var
|
|
h: THandle;
|
|
begin
|
|
if not Assigned(SetThreadDescription) then begin
|
|
RemoveThreadText(AID);
|
|
if AFilename<>'' then
|
|
SaveThreadTexts(AFilename);
|
|
end else begin
|
|
h:=GetThreadHandle(AID);
|
|
try
|
|
SetThreadDescription(h,nil);
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.RemoveThreadText(AID: Cardinal);
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
idx:=FTL.IndexOfName(IntToStr(AID));
|
|
if (idx>-1) then
|
|
FTL.Delete(idx);
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SaveThreadTexts(const AFilename: string;
|
|
ANoLock: Boolean);
|
|
begin
|
|
if Terminated then
|
|
Exit;
|
|
if not ANoLock then
|
|
InternalLock.Enter;
|
|
try
|
|
try
|
|
FTL.SaveToFile(AFilename)
|
|
except
|
|
sleep(100);
|
|
try FTL.SaveToFile(AFilename) except end;
|
|
end;
|
|
finally
|
|
if not ANoLock then
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.SessionID: Cardinal;
|
|
begin
|
|
ProcessIdToSessionId(GetCurrentProcessID,Result);
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetAskFullProcessAccess(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FAskFullProcessAccess:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetAutoSuspend(const Value: Boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FAutoSuspend:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetCalcHash(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FCalcHash:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetEnumHandles(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FEnumHandles:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetEnumMods(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FEnumModules:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetEnumThrds(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FEnumThreads:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetEvalprocInfo(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FEvalProcInfo:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetEvalSecInfo(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FEvalSecInfo:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetEvalSym(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FEvalSym:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SkipFirstPass;
|
|
begin
|
|
FFirstPass:=False;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetInterval(const Value: Cardinal);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FInterval:=Value;
|
|
if (FSamplePeriod>0) and (FSamplePeriod<FInterval) then
|
|
FSamplePeriod:=FInterval;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetOnInterval(const Value: TSysProcMonNotifyEvent);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FOnInterval:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetOnSample(const Value: TSysProcMonSampleEvent);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FOnSample:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetPerfMeas(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FPerfMeas:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetRetrieveProcIcon(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FProcIcon:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetRetrieveProcVersionInfo(const Value: boolean);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FProcVerInfo:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetSampleMethod(const Value: TSampleMethod);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FSampleMethod:=Value;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetSamplePeriod(const Value: Cardinal);
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
FSamplePeriod:=Value;
|
|
if (FSamplePeriod>0) and (FSamplePeriod<FInterval) then
|
|
FSamplePeriod:=FInterval;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetThreadDesc(AID: Cardinal; const ADescription: string; const AFilename: string = '');
|
|
var
|
|
h: THandle;
|
|
begin
|
|
if Assigned(SetThreadDescription) then begin
|
|
h:=GetThreadHandle(AID);
|
|
try
|
|
SetThreadDescription(h,PWideChar(ADescription));
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end else begin
|
|
SetThreadText(AID,ADescription);
|
|
if AFilename<>'' then
|
|
SaveThreadTexts(AFilename);
|
|
end;
|
|
end;
|
|
|
|
class procedure TSysProcMonThread.SetThreadName(AID: Cardinal;
|
|
const ADescription: string);
|
|
var
|
|
h: THandle;
|
|
begin
|
|
if not Assigned(SetThreadDescription) then
|
|
Exit;
|
|
h:=GetThreadHandle(AID);
|
|
try
|
|
SetThreadDescription(h,PWideChar(ADescription));
|
|
finally
|
|
CloseHandle(h);
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetThreadText(AID: Cardinal; const AText: string);
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
idx:=FTL.IndexOfName(IntToStr(AID));
|
|
if (idx=-1) then
|
|
FTL.Add(Format('%d=%s',[AID,AText]))
|
|
else
|
|
FTL[idx]:=Format('%d=%s',[AID,AText]);
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.SetWatchedProcess(APID: Cardinal; AValue: boolean);
|
|
var
|
|
idx,i: Integer;
|
|
begin
|
|
InternalLock.Enter;
|
|
try
|
|
idx:=FWL.IndexOf(APID);
|
|
if not AValue then begin
|
|
if (idx>-1) then
|
|
FWL.Delete(idx);
|
|
end else if (idx=-1) then
|
|
FWL.Add(APID);
|
|
|
|
for i:=0 to FList.Count-1 do
|
|
if PProcessRecord(FList[i])^.PID=APID then begin
|
|
PProcessRecord(FList[i])^.Name:='';
|
|
PProcessRecord(FList[i])^.HandleList.Clear;
|
|
PProcessRecord(FList[i])^.ModuleList.Clear;
|
|
PProcessRecord(FList[i])^.ThreadList.Clear;
|
|
Break;
|
|
end;
|
|
finally
|
|
InternalLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.SystemCache: Int64;
|
|
var
|
|
pi: TPerformanceInformation;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(GetPerformanceInfo) or not GetPerformanceInfo(@pi,SizeOf(pi)) then
|
|
Exit;
|
|
Result:=Int64(pi.SystemCache)*Int64(pi.PageSize);
|
|
end;
|
|
|
|
class function TSysProcMonThread.SystemDisk: string;
|
|
begin
|
|
Result:=Copy(GetSysDir,1,2);
|
|
end;
|
|
|
|
class function TSysProcMonThread.SystemProductName: string;
|
|
var
|
|
f,m: string;
|
|
begin
|
|
m:='';
|
|
f:='';
|
|
Result:='';
|
|
with OpenRegistryReadOnly do
|
|
try
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey('HARDWARE\DESCRIPTION\System\BIOS',False) then begin
|
|
if ValueExists('SystemProductName') then
|
|
Result:=ReadString('SystemProductName');
|
|
if ValueExists('SystemFamily') then
|
|
f:=ReadString('SystemFamily');
|
|
if ValueExists('SystemManufacturer') then
|
|
m:=ReadString('SystemManufacturer');
|
|
if (Pos(f,Result)=0) and (Pos('=',f)=0) then
|
|
Result:=f+' '+Result;
|
|
if Pos(m,Result)=0 then
|
|
Result:=m+' '+Result;
|
|
CloseKey;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.ThreadCount: Cardinal;
|
|
var
|
|
pi: TPerformanceInformation;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(GetPerformanceInfo) or not GetPerformanceInfo(@pi,SizeOf(pi)) then
|
|
Exit;
|
|
Result:=pi.ThreadCount;
|
|
end;
|
|
|
|
class function TSysProcMonThread.TotalPageFile: int64;
|
|
var
|
|
wmiServices: ISWbemServices;
|
|
wmi: TInstances;
|
|
begin
|
|
Result:=0;
|
|
if not WMIConnect('','','',Rootnamespace,wmiServices) then
|
|
Exit;
|
|
try
|
|
WMICommand(wmiServices,'Win32_PageFileUsage',wmi);
|
|
Result:=GetFileSize(GetInstancePropertyValue(wmi,'Name'));
|
|
finally
|
|
WMIDisconnect(wmiServices);
|
|
Finalize(wmi);
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.TotalPhysMemory: Int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
begin
|
|
if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullTotalPhys;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwTotalPhys;
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.TotalVirtualMemory: Int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
begin
|
|
if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullTotalVirtual;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwTotalVirtual;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread.UpdateCPUCycleTime;
|
|
var
|
|
v,vi: TSamples;
|
|
begin
|
|
GetCPUCycles(v,vi);
|
|
FCPUCycle.Update(v.Sum);
|
|
FCPUIdleCycle.Update(vi.Sum);
|
|
end;
|
|
|
|
procedure TSysProcMonThread.UpdateCPUSysTime;
|
|
var
|
|
i: integer;
|
|
spt: Pointer;
|
|
t: Int64;
|
|
begin
|
|
try
|
|
spt:=AllocMem(FCPUCount*(SizeOf(TSystemProcessorTimes)+4));
|
|
try
|
|
NtQuerySystemInformation(SystemProcessorPerformanceInformation,spt,FCPUCount*(SizeOf(TSystemProcessorTimes)+4),nil);
|
|
t:=0;
|
|
for i:=0 to FCPUCount-1 do
|
|
with PSystemProcessorTimes(PAnsiChar(spt)+i*(sizeof(TSystemProcessorTimes)+4))^ do
|
|
t:=t+KernelTime.QuadPart+UserTime.QuadPart;
|
|
FCPUTotalTime.Update(t);
|
|
finally
|
|
FreeMem(spt);
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
class function TSysProcMonThread.UsedPhysMemory: Int64;
|
|
var
|
|
MSEX: TMemoryStatusEx;
|
|
MS: TMemoryStatus;
|
|
begin
|
|
if Assigned(GlobalMemoryStatusEx_) then begin
|
|
ResetMemory(MSEX,SizeOf(MSEX));
|
|
MSEX.dwLength:=SizeOf(MSEX);
|
|
GlobalMemoryStatusEx_(@MSEX);
|
|
Result:=MSEX.ullTotalPhys-MSEX.ullAvailPhys;
|
|
end else begin
|
|
ResetMemory(MS,SizeOf(MS));
|
|
MS.dwLength:=SizeOf(MS);
|
|
GlobalMemoryStatus(MS);
|
|
Result:=MS.dwTotalPhys-MS.dwAvailPhys;
|
|
end;
|
|
end;
|
|
|
|
function TSysProcMonThread._GetRecordByPID(APID: Cardinal): integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=-1;
|
|
for i:=0 to FList.Count-1 do
|
|
if PProcessRecord(FList[i])^.PID=APID then begin
|
|
Result:=i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TSysProcMonThread._GetRecordByPID(APID: Cardinal;
|
|
var ARecord: TProcessRecord);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
ResetMemory(ARecord,SizeOf(ARecord));
|
|
for i:=0 to FList.Count-1 do
|
|
if PProcessRecord(FList[i])^.PID=APID then begin
|
|
ARecord:=PProcessRecord(FList[i])^;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
{ TCPUData }
|
|
|
|
function TCPUData.GetNumberIndex(ANumber: byte): integer;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result:=-1;
|
|
for i:=0 to High(Items) do
|
|
if Items[i].Number=ANumber then begin
|
|
Result:=i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
InitNativeAPI;
|
|
InitPPAAPI;
|
|
end.
|
|
|
|
|
|
|