381 lines
11 KiB
Plaintext
381 lines
11 KiB
Plaintext
unit FProcessList;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
|
||
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ThdProcessMon,
|
||
VirtualTrees, Vcl.ExtCtrls, Vcl.Menus;
|
||
|
||
type
|
||
PProcEnt = ^TProcEnt;
|
||
TProcEnt = record
|
||
Data: TProcMonEnt;
|
||
nImgIdx: Integer;
|
||
end;
|
||
|
||
TFrmProcessList = class(TFrame)
|
||
vtList: TVirtualStringTree;
|
||
tUpdate: TTimer;
|
||
popFun: TPopupMenu;
|
||
miCopyCB: TMenuItem;
|
||
miTerminate: TMenuItem;
|
||
N3: TMenuItem;
|
||
miFilter: TMenuItem;
|
||
miTerminateName: TMenuItem;
|
||
N2: TMenuItem;
|
||
miExportJson: TMenuItem;
|
||
SaveDialog: TSaveDialog;
|
||
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
|
||
var HintText: string);
|
||
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
||
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||
procedure tUpdateTimer(Sender: TObject);
|
||
procedure vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
|
||
procedure vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||
procedure vtListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
|
||
var ImageIndex: TImageIndex);
|
||
procedure miCopyCBClick(Sender: TObject);
|
||
procedure miFilterClick(Sender: TObject);
|
||
procedure vtListContextPopup(Sender: TObject; MousePos: TPoint;
|
||
var Handled: Boolean);
|
||
procedure popFunPopup(Sender: TObject);
|
||
procedure miTerminateClick(Sender: TObject);
|
||
procedure miTerminateNameClick(Sender: TObject);
|
||
procedure miExportJsonClick(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
FileImageList_: TImageList;
|
||
ThdProcMon_: TThdProcessMon;
|
||
VtFilter_: Pointer; // TVtFilterEdit;
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.VirtualTreeViewUtil, Tocsg.Convert, Tocsg.DateTime, VirtualTrees.Types,
|
||
System.Math, System.DateUtils, Tocsg.Shell, Tocsg.Process,
|
||
VirtualTrees.Filter, Define, superobject, Tocsg.Safe;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TFrmProcessList.Create(aOwner: TComponent);
|
||
|
||
procedure InitCtrls;
|
||
var
|
||
hSysIcons: THandle;
|
||
begin
|
||
VtFilter_ := nil;
|
||
FileImageList_ := TImageList.Create(Self);
|
||
FileImageList_.ShareImages := true;
|
||
FileImageList_.BlendColor := clHighlight;
|
||
hSysIcons := GetShellImageHandle;
|
||
if hSysIcons <> 0 then
|
||
begin
|
||
FileImageList_.Handle := hSysIcons;
|
||
vtList.Images := FileImageList_;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Inherited Create(aOwner);
|
||
InitCtrls;
|
||
ThdProcMon_ := TThdProcessMon.Create;
|
||
tUpdate.Enabled := true;
|
||
end;
|
||
|
||
Destructor TFrmProcessList.Destroy;
|
||
begin
|
||
FreeAndNil(ThdProcMon_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TFrmProcessList.miCopyCBClick(Sender: TObject);
|
||
begin
|
||
if VT_CopyToClipboardSelectedInfo(vtList) = 0 then
|
||
MessageBox(Handle, PChar('Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD>忡 <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONINFORMATION or MB_OK);
|
||
end;
|
||
|
||
procedure TFrmProcessList.miExportJsonClick(Sender: TObject);
|
||
var
|
||
ProcList: TProcessEntList;
|
||
O: ISuperObject;
|
||
begin
|
||
if vtList.RootNodeCount = 0 then
|
||
begin
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
|
||
SaveDialog.FileName := '';
|
||
if SaveDialog.Execute(Handle) then
|
||
begin
|
||
Guard(ProcList, TProcessEntList.Create);
|
||
ProcList.UpdateProcessList;
|
||
|
||
O := SO;
|
||
O.O['ProcList'] := ProcList.ToJsonObjHE;
|
||
SaveJsonObjToFile(O, SaveDialog.FileName);
|
||
MessageBox(Handle, PChar('<27><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>⸦ <20>Ϸ<EFBFBD><CFB7>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONINFORMATION or MB_OK);
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.miFilterClick(Sender: TObject);
|
||
begin
|
||
if miFilter.Checked then
|
||
begin
|
||
vtList.DestroyFilterEdit;
|
||
VtFilter_ := nil;
|
||
end else
|
||
VtFilter_ := vtList.CreateFilterEdit;
|
||
end;
|
||
|
||
procedure TFrmProcessList.miTerminateClick(Sender: TObject);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PProcEnt;
|
||
begin
|
||
if vtList.SelectedCount = 0 then
|
||
exit;
|
||
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
APP_TITLE, MB_ICONWARNING or MB_YESNO) = IDNO then exit;
|
||
|
||
pNode := vtList.GetFirstSelected;
|
||
while pNode <> nil do
|
||
begin
|
||
pData := vtList.GetNodeData(pNode);
|
||
TerminateProcessByPid(pData.Data.Info.dwPid);
|
||
pNode := vtList.GetNextSelected(pNode);
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.miTerminateNameClick(Sender: TObject);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PProcEnt;
|
||
begin
|
||
if vtList.SelectedCount = 0 then
|
||
exit;
|
||
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD> <20><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
APP_TITLE, MB_ICONWARNING or MB_YESNO) = IDNO then exit;
|
||
|
||
pNode := vtList.GetFirstSelected;
|
||
while pNode <> nil do
|
||
begin
|
||
pData := vtList.GetNodeData(pNode);
|
||
TerminateProcessByName(ExtractFileName(pData.Data.Info.sModuleFileName));
|
||
pNode := vtList.GetNextSelected(pNode);
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.popFunPopup(Sender: TObject);
|
||
begin
|
||
miFilter.Checked := VtFilter_ <> nil;
|
||
end;
|
||
|
||
procedure TFrmProcessList.tUpdateTimer(Sender: TObject);
|
||
|
||
procedure AddData(pEnt: PProcMonEnt);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PProcEnt;
|
||
begin
|
||
if pEnt.bTerminated then
|
||
exit;
|
||
|
||
pData := VT_AddChildDataN(vtList, pNode);
|
||
pEnt.pNode := pNode;
|
||
pData.Data := pEnt^;
|
||
pData.nImgIdx := -1;
|
||
|
||
if VtFilter_ <> nil then
|
||
vtList.IsVisible[pNode] := TVtFilterEdit(VtFilter_).IsNodeVisible(pNode);
|
||
end;
|
||
|
||
var
|
||
i: Integer;
|
||
pEnt: PProcMonEnt;
|
||
pData: PProcEnt;
|
||
begin
|
||
vtList.BeginUpdate;
|
||
ThdProcMon_.LockThread;
|
||
try
|
||
if vtList.RootNodeCount = 0 then
|
||
begin
|
||
for i := 0 to ThdProcMon_.EntList.Count - 1 do
|
||
AddData(ThdProcMon_.EntList[i]);
|
||
VT_SortAll(vtList, 1, sdAscending);
|
||
end else begin
|
||
for i := 0 to ThdProcMon_.EntList.Count - 1 do
|
||
begin
|
||
pEnt := ThdProcMon_.EntList[i];
|
||
if pEnt.bTerminated then
|
||
begin
|
||
vtList.DeleteNode(pEnt.pNode);
|
||
pEnt.pNode := nil;
|
||
continue;
|
||
end;
|
||
|
||
if pEnt.pNode <> nil then
|
||
begin
|
||
pData := vtList.GetNodeData(pEnt.pNode);
|
||
pData.Data := pEnt^;
|
||
end else
|
||
AddData(ThdProcMon_.EntList[i]);
|
||
end;
|
||
end;
|
||
finally
|
||
ThdProcMon_.UnlockThread;
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||
var
|
||
pData1, pData2: PProcEnt;
|
||
begin
|
||
pData1 := Sender.GetNodeData(Node1);
|
||
pData2 := Sender.GetNodeData(Node2);
|
||
|
||
case Column of
|
||
1, 7, 9, 10, 11, 12, 13 : Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]);
|
||
2 : Result := CompareValue(pData1.Data.Info.dwPid, pData2.Data.Info.dwPid);
|
||
3 : Result := CompareValue(pData1.Data.Res.fCpu, pData2.Data.Res.fCpu);
|
||
4 : Result := CompareValue(pData1.Data.Res.llMemSize, pData2.Data.Res.llMemSize);
|
||
5, 6: Result := CompareDateTime(pData1.Data.Info.dtStart, pData2.Data.Info.dtStart);
|
||
8 : Result := CompareDateTime(pData1.Data.Info.nPriority, pData2.Data.Info.nPriority);
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListContextPopup(Sender: TObject; MousePos: TPoint;
|
||
var Handled: Boolean);
|
||
begin
|
||
miCopyCB.Visible := vtList.GetNodeAt(MousePos) <> nil;
|
||
miTerminate.Visible := miCopyCB.Visible;
|
||
miTerminateName.Visible := miCopyCB.Visible;
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PProcEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListGetHint(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex;
|
||
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
||
begin
|
||
HintText := vtList.Text[Node, Column];
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListGetImageIndex(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||
var Ghosted: Boolean; var ImageIndex: TImageIndex);
|
||
var
|
||
pData: PProcEnt;
|
||
begin
|
||
if Column = 1 then
|
||
begin
|
||
case Kind of
|
||
ikNormal,
|
||
ikSelected:
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
if pData.nImgIdx = -1 then
|
||
pData.nImgIdx := GetShellImageIndex_path(pData.Data.Info.sModuleFileName);
|
||
ImageIndex := pData.nImgIdx;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TProcEnt);
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PProcEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
|
||
case Column of
|
||
0 : CellText := IntToStr(Node.Index + 1);
|
||
1 : CellText := ExtractFileName(pData.Data.Info.sModuleFileName);
|
||
2 : CellText := IntToStr(pData.Data.Info.dwPid);
|
||
3 : CellText := Format('%.2f%%', [pData.Data.Res.fCpu]);
|
||
4 : CellText := ByteSizeToStr(pData.Data.Res.llMemSize);
|
||
5 : CellText := ConvSecBetweenToProgTime(pData.Data.Info.dtStart, Now);
|
||
6 : CellText := DateTimeToStr(pData.Data.Info.dtStart);
|
||
7 : CellText := pData.Data.Info.sOwner;
|
||
8 : CellText := PriorityStrByClass(pData.Data.Info.nPriority);
|
||
9 : CellText := pData.Data.Info.sDescription;
|
||
10 : CellText := pData.Data.Info.sCompany;
|
||
11 : CellText := pData.Data.Info.sVersion;
|
||
12 : CellText := pData.Data.Info.sCopyright;
|
||
13 : CellText := ExtractFilePath(pData.Data.Info.sModuleFileName);
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmProcessList.vtListHeaderClick(Sender: TVTHeader;
|
||
HitInfo: TVTHeaderHitInfo);
|
||
begin
|
||
if HitInfo.Button = mbLeft then
|
||
begin
|
||
if HitInfo.Column < 0 then
|
||
exit;
|
||
|
||
with Sender, Treeview do
|
||
begin
|
||
if SortColumn > NoColumn then
|
||
Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
|
||
|
||
if HitInfo.Column = 0 then
|
||
SortColumn := NoColumn
|
||
else
|
||
begin
|
||
if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
|
||
begin
|
||
SortColumn := HitInfo.Column;
|
||
SortDirection := sdAscending;
|
||
end else
|
||
if SortDirection = sdAscending then
|
||
SortDirection := sdDescending
|
||
else
|
||
SortDirection := sdAscending;
|
||
|
||
Columns[SortColumn].Color := $00EFEFEF;
|
||
|
||
vtList.BeginUpdate;
|
||
try
|
||
vtList.SortTree(SortColumn, SortDirection, False);
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
end.
|