?? processlist.~pas
字號:
var Arow : Integer;
begin
result := -1;
for Arow := 0 to self.FItems.Count - 1 do begin
if self.FItems.Items[Arow].Handle = Prochandle then begin
result := Arow;
break;
end;
end;
end;
procedure add_programInfo(ProgramInfo : TProgram);
var tmp : TProgramItem;
begin
tmp := self.FItems.Add;
tmp.ExeName := ProgramInfo.ExeName;
tmp.Handle := ProgramInfo.Handle;
tmp.CheckngTime := ProgramInfo.CheckngTime;
tmp.CreateTime := ProgramInfo.CreateTime;
tmp.ExitTime := ProgramInfo.ExitTime;
tmp.KernelTime := ProgramInfo.KernelTime;
tmp.UserTime := ProgramInfo.UserTime;
end;
var retArow : integer;
ProgramInfo : TProgram;
Parentvalue : double;
NewPIDS : Array of DWORD;
function is_PID_NewPIDS(value : DWORD) : Boolean;
var Arow, datalength : integer;
begin
datalength := length(NewPIDS);
result := False;
for Arow := 0 to datalength - 1 do begin
if value = NewPIDS[Arow] then begin
result := True;
break;
end;
end;
end;
procedure Remove_ExitPID;
var Arow, datalength : integer;
begin
datalength := self.FItems.Count;
for Arow := 0 to datalength - 1 do begin
if Not is_PID_NewPIDS(self.FItems.Items[Arow].Handle) then begin
self.FItems.Delete(self.FItems.Items[Arow].index);
break;
end;
end;
end;
begin
self.FCheck := value;
if self.FCheck then begin
ZeroMemory(@PIDS, sizeof(DWORD) * 501);
dwSize := 0;
self.FCPURatio := 0;
if EnumProcesses(PDWORD(@PIDS), sizeof(PIDS), dwSize) then begin
ProcessCnt := dwSize div Sizeof(DWORD);
finalize(NewPIDS);
setlength(NewPIDS, ProcessCnt);
for ProcessIdx := 0 to ProcessCnt -1 do begin
ProcessHandle := OpenProcess(PROCESS_VM_READ or PROCESS_QUERY_INFORMATION,
false,PIDS[ProcessIdx]);
try
NewPIDS[ProcessIdx] := PIDS[ProcessIdx];
if ProcessHandle <> 0 then begin
if EnumProcessModules(ProcessHandle, @PModule, SizeOf(PModule),
dwSize) then begin
FillChar(ProcessName, 256, #0);
if GetModuleBaseName(ProcessHandle, PModule,ProcessName, 256) > 0 then begin
ProgramInfo.CheckngTime := now;
if (GetProcessTimes(ProcessHandle, ftCreation, ftExit, ftKernel, ftUser) = TRUE) then begin
FileTimeToSystemTime(ftCreation, tmpSysTime);
ProgramInfo.ExeName := ProcessName;
ProgramInfo.Handle := PIDS[ProcessIdx];
ProgramInfo.CreateTime := SystemtimetoDatetime(tmpSysTime);
FileTimeToSystemTime(ftExit, tmpSysTime);
ProgramInfo.ExitTime := SystemtimetoDatetime(tmpSysTime);
FileTimeToSystemTime(ftKernel, tmpSysTime);
ProgramInfo.KernelTime := SystemtimetoDatetime(tmpSysTime);
FileTimeToSystemTime(ftUser, tmpSysTime);
ProgramInfo.UserTime := SystemtimetoDatetime(tmpSysTime);
ProgramInfo.CPURatio := 0.0;
retArow := get_ProgramIndex(ProgramInfo.Handle);
if retArow < 0 then Add_ProgramInfo(ProgramInfo)
else begin
parentvalue := (millisecondsbetween(ProgramInfo.CheckngTime, self.FItems.Items[retArow].CheckngTime)/100);
if parentvalue = 0 then
ProgramInfo.CPURatio := 0.0 else
ProgramInfo.CPURatio :=
( millisecondsbetween(ProgramInfo.KernelTime, self.FItems.Items[retArow].KernelTime) +
millisecondsbetween(ProgramInfo.UserTime, self.FItems.Items[retArow].UserTime) )
/ Parentvalue;
self.FCPURatio := self.FCPURatio + ProgramInfo.CPURatio;
self.FItems.Items[retArow].CheckngTime := ProgramInfo.CheckngTime;
self.FItems.Items[retArow].CreateTime := ProgramInfo.CreateTime;
self.FItems.Items[retArow].ExitTime := ProgramInfo.ExitTime;
self.FItems.Items[retArow].KernelTime := ProgramInfo.KernelTime;
self.FItems.Items[retArow].UserTime := ProgramInfo.UserTime;
self.FItems.Items[retArow].CPURatio := ProgramInfo.CPURatio;
end;
end;
end;
end;
end;
finally
CloseHandle(ProcessHandle);
end;
end;
end;
Remove_ExitPID;
finalize(NewPIDS);
self.FCheck := False;
end;
end;
function TProcessList.get_FRAMQTY : integer;
var MemoryState : TMemoryStatus;
begin
MemoryState.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(MemoryState);
self.FRAMQTY := MemoryState.dwTotalPhys;
result := self.FRAMQTY;
end;
function TProcessList.get_FTotalPageSize : integer;
var MemoryState : TMemoryStatus;
begin
MemoryState.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(MemoryState);
self.FTotalPageSize := MemoryState.dwTotalPageFile;
result := self.FTotalPageSize;
end;
function TProcessList.get_FAvailPageSize : integer;
var MemoryState : TMemoryStatus;
begin
MemoryState.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(MemoryState);
self.FAvailPageSize := MemoryState.dwAvailPageFile;
result := self.FAvailPageSize;
end;
function TProcessList.get_FTotalVirtualSize : integer;
var MemoryState : TMemoryStatus;
begin
MemoryState.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(MemoryState);
self.FTotalVirtualSize := MemoryState.dwTotalVirtual;
result := self.FTotalVirtualSize;
end;
function TProcessList.get_FAvailVirtualSize : integer;
var MemoryState : TMemoryStatus;
begin
MemoryState.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(MemoryState);
self.FAvailVirtualSize := MemoryState.dwAvailVirtual;
result := self.FAvailVirtualSize;
end;
function TProcessList.get_FAvailRAMQTY : integer;
var MemoryState : TMemoryStatus;
begin
MemoryState.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(MemoryState);
self.FAvailRAMQTY := MemoryState.dwAvailPhys;
result := self.FAvailRAMQTY;
end;
{
It's all developed by Augustine Lee, in Korea.
Developer Site : http://www.appshop.net
Its' License policy is that
this package can be applied in all fields,
Commercial, Study, and other goals,
without removing this License comment.
The Reason of develping this package
is that Augustine Lee can not find the Source and Example of Object Pascal,
for checking CPU Usage Occupation Ratio.
This checking CPU package is used in MSSL development (Middleware SSL)
救崇竅技堪. 俺慣磊 技飯疙 Augustine 牢 撈霖柳 澇聰促.
膽頗撈肺 等 CPU 痢蠟啦 痢八竅綽 基錢 茫扁啊 距埃 塞甸促絆 積阿登絹
弊成 茄鍋 父甸絹 好嚼聰促.
困 康鞏俊輯 覽鞭茄巴鞍撈, 夯 歷累鼻 包訪等 林籍鞏闌 昏力竅瘤 臼綽促擱,
絹叼俊檔 葷儈竅寂檔 鄧聰促.
弊府絆, 泅犁 凱繳灑 父甸絆綽 樂瘤父, 個撈 蝶扼啊瘤 給竅絆 樂綽 歷銳 權其撈瘤綽
http://www.appshop.net 澇聰促.
弊府絆, 夯 盲歐 葛碘籃 MSSL 力累俊 葷儈登菌嚼聰促.
}
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -