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('Ŭ¸³º¸µå¿¡ º¹»ç µÇ¾ú½À´Ï´Ù.'), 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('³»º¸³»±â ÇÒ ÇÁ·Î¼¼½º Á¤º¸°¡ ¾ø½À´Ï´Ù.'), 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('ÇÁ·Î¼¼½º ¸ñ·Ï Á¤º¸ ³»º¸³»±â¸¦ ¿Ï·áÇß½À´Ï´Ù.'), 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('¼±ÅÃÇÑ ÇÁ·Î¼¼½º¸¦ Á¾·áÇϽðڽÀ´Ï±î?'),
      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('¼±ÅÃÇÑ ÇÁ·Î¼¼½º¿Í µ¿ÀÏÇÑ À̸§ÀÇ ÇÁ·Î¼¼½º¸¦ ¸ðµÎ Á¾·áÇϽðڽÀ´Ï±î?'),
      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.