278 lines
7.4 KiB
Plaintext
278 lines
7.4 KiB
Plaintext
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('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'), 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 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>۵Ǿ<DBB5><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), 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 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
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 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), 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<><64> <20>߰<EFBFBD>) 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.
|