unit DUrlIpMonMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, ThdUrlIpMon, Vcl.ExtCtrls,
  Vcl.StdCtrls, VirtualTrees, System.Generics.Collections, Tocsg.Trace;

type
  PUimData = ^TUimData;
  TUimData = record
    Info: PUimEnt;
  end;

  TDlgUrlIpMon = class(TForm)
    MainMenu: TMainMenu;
    miCollectIP: TMenuItem;
    miStart: TMenuItem;
    miStop: TMenuItem;
    N3: TMenuItem;
    miExit: TMenuItem;
    vtList: TVirtualStringTree;
    mmLog: TMemo;
    Splitter1: TSplitter;
    procedure miExitClick(Sender: TObject);
    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 vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
    procedure vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure miStartClick(Sender: TObject);
    procedure miCollectIPClick(Sender: TObject);
    procedure miStopClick(Sender: TObject);
  private
    { Private declarations }
    DcNode_: TDictionary<Pointer,PVirtualNode>;
    ThdUrlIpMon_: TThdUrlIpMon;
    Trace_: TTgTrace;
  public
    { Public declarations }
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;

    procedure process_WM_INIT_LIST(var msg: TMessage); Message WM_INIT_LIST;
    procedure process_WM_ADD_URLIP(var msg: TMessage); Message WM_ADD_URLIP;
  end;

var
  DlgUrlIpMon: TDlgUrlIpMon;

implementation

uses
  Tocsg.VirtualTreeViewUtil, VirtualTrees.Types, DSetUrlMon, Tocsg.Safe,
  Tocsg.Path;

{$R *.dfm}

Constructor TDlgUrlIpMon.Create(aOwner: TComponent);
begin
  Inherited Create(aOwner);
  Trace_ := TTgTrace.Create(GetRunExePathDir + 'Log\', 'UrlIpMon.log', true);
  DcNode_ := TDictionary<Pointer,PVirtualNode>.Create;
  ThdUrlIpMon_ := nil;
end;

Destructor TDlgUrlIpMon.Destroy;
begin
  if ThdUrlIpMon_ <> nil then
    FreeAndNil(ThdUrlIpMon_);
  FreeAndNil(DcNode_);
  FreeAndNil(Trace_);
  Inherited;
end;

procedure TDlgUrlIpMon.miCollectIPClick(Sender: TObject);
begin
  miStart.Enabled := ThdUrlIpMon_ = nil;
  miStop.Enabled := not miStart.Enabled;
end;

procedure TDlgUrlIpMon.miExitClick(Sender: TObject);
begin
  if MessageBox(Handle, PChar('Á¾·áÇϽðڽÀ´Ï±î?'), PChar(Caption),
      MB_ICONQUESTION or MB_YESNO) = IDNO then exit;

  Close;
end;

procedure TDlgUrlIpMon.miStartClick(Sender: TObject);
var
  dlg: TDlgSetUrlMon;
begin
  if ThdUrlIpMon_ <> nil then
    exit;

  Guard(dlg, TDlgSetUrlMon.Create(Self));
  if dlg.ShowModal = mrOk then
  begin
    ThdUrlIpMon_ := TThdUrlIpMon.Create(Handle, dlg.mmUrls.Text,
        StrToIntDef(dlg.edTerm.Text, 60), dlg.chSaveLoad.Checked);
    ThdUrlIpMon_.StartThread;

    MessageBox(Handle, PChar('IP ¼öÁýÀÌ ½ÃÀ۵Ǿú½À´Ï´Ù.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
  end;
end;

procedure TDlgUrlIpMon.miStopClick(Sender: TObject);
begin
  if ThdUrlIpMon_ <> nil then
  begin
    if MessageBox(Handle, PChar('IP ¼öÁýÀ» ÁßÁöÇϽðڽÀ´Ï±î?'),
      PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;

    vtList.BeginUpdate;
    try
      FreeAndNil(ThdUrlIpMon_);
      DcNode_.Clear;
      VT_Clear(vtList);
    finally
      vtList.EndUpdate;
    end;

    MessageBox(Handle, PChar('IP ¼öÁýÀÌ ÁßÁöµÇ¾ú½À´Ï´Ù.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
  end;
end;

procedure TDlgUrlIpMon.process_WM_INIT_LIST(var msg: TMessage);
var
  EntList: TUimEntList;
  i: Integer;
  pNode: PVirtualNode;
  pData: PUimData;
begin
  EntList := TUimEntList(msg.LParam);
  vtList.BeginUpdate;
  try
    DcNode_.Clear;
    VT_Clear(vtList);

    for i := 0 to EntList.Count - 1 do
    begin
      pData := VT_AddChildDataN(vtList, pNode);
      pData.Info := EntList[i];
      DcNode_.Add(pData.Info, pNode);
    end;

    VT_SortAll(vtList, 1, sdAscending);
  finally
    vtList.EndUpdate;
  end;
end;

procedure TDlgUrlIpMon.vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  pData1, pData2: PUimData;
begin
  if Column = 2 then
  begin
    pData1 := Sender.GetNodeData(Node1);
    pData2 := Sender.GetNodeData(Node2);

    Result := pData1.Info.IpList.Count - pData2.Info.IpList.Count;
  end else
    Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]);
end;

procedure TDlgUrlIpMon.vtListFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  pData: PUimData;
begin
  pData := Sender.GetNodeData(Node);
  Finalize(pData^);
end;

procedure TDlgUrlIpMon.vtListGetHint(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex;
  var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
  HintText := vtList.Text[Node, Column];
end;

procedure TDlgUrlIpMon.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TUimData);
end;

procedure TDlgUrlIpMon.vtListGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  pData: PUimData;
begin
  pData := Sender.GetNodeData(Node);

  case Column of
    0 : CellText := IntToStr(Node.Index + 1);
    1 : CellText := pData.Info.sUrl;
    2 : CellText := IntToStr(pData.Info.IpList.Count);
    3 : CellText := pData.Info.IpList.CommaText;
  end;
end;

procedure TDlgUrlIpMon.vtListHeaderClick(Sender: TVTHeader;
  HitInfo: TVTHeaderHitInfo);
begin
  if HitInfo.Button = mbLeft then
  begin
    with Sender, Treeview, HitInfo do
    begin
      if HitInfo.Column < 0 then
        exit;

      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 <> Column) then
        begin
          SortColumn := Column;
          SortDirection := sdAscending;
        end else
        if SortDirection = sdAscending then
          SortDirection := sdDescending
        else
          SortDirection := sdAscending;

        Columns[SortColumn].Color := $00EFEFEF;
        TVirtualStringTree(Treeview).BeginUpdate;
        try
          TVirtualStringTree(Treeview).SortTree(SortColumn, SortDirection, False);
        finally
          TVirtualStringTree(Treeview).EndUpdate;
        end;
      end;
    end;
  end;
end;

procedure TDlgUrlIpMon.process_WM_ADD_URLIP(var msg: TMessage);
var
  pEnt: PUimEnt;
  nPos, nAddCnt: Integer;
  sAddIp, sLog: String;
begin
  pEnt := Pointer(msg.LParam);
  if DcNode_.ContainsKey(pEnt) then
  begin
    sAddIp := String(msg.WParam);
    nPos := Pos(':', sAddIp);
    if nPos > 0 then
    begin
      nAddCnt := StrToIntDef(Copy(sAddIp, 1, nPos - 1), -1);
      Delete(sAddIp, 1, nPos);
    end else
      nAddCnt := -2;

    sLog := Format('(%d°³ Ãß°¡) URL=%s, Added IPs=%s', [nAddCnt, pEnt.sUrl, sAddIp]);
    mmLog.Lines.Add(Format('[%s] %s', [DateTimeToStr(Now), sLog]));
    Trace_.T(sLog);
    vtList.RepaintNode(DcNode_[pEnt]);
  end;
end;

end.