unit DSockMonMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ThdSocketMon, Vcl.StdCtrls, Vcl.ExtCtrls, VirtualTrees; type TDlgSockMonMain = class(TForm) pnTop: TPanel; btnMon: TButton; pnBottom: TPanel; lbState: TLabel; vtList: TVirtualStringTree; tProg: TTimer; procedure btnMonClick(Sender: TObject); procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure tProgTimer(Sender: TObject); procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); private { Private declarations } ThdSocketMon_: TThdSocketMon; public { Public declarations } Constructor Create(aOwner: TComponent); override; Destructor Destroy; override; procedure process_WM_SOCKETMON_NOTIFICATION(var msg: TMessage); Message WM_SOCKETMON_NOTIFICATION; end; var DlgSockMonMain: TDlgSockMonMain; implementation uses Ics.Fmx.OverbyteIcsWSocket, Tocsg.Safe, MagentaPackhdrs, Tocsg.VTUtil; {$R *.dfm} procedure TDlgSockMonMain.btnMonClick(Sender: TObject); var IpList: TStringList; begin if ThdSocketMon_ = nil then begin btnMon.Caption := 'ÆÐŶ ¸ð´ÏÅ͸µ ÁßÁö'; Guard(IpList, TStringList.Create); IpList.AddStrings(LocalIPList); if IpList.Count = 0 then begin MessageBox(Handle, PChar('IP¸¦ ãÀ»¼ö ¾ø½À´Ï´Ù.'), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; ThdSocketMon_ := TThdSocketMon.Create(Handle, IpList[0]); ThdSocketMon_.StartThread; lbState.Caption := Format('%s ÆÐŶ ¼öÁýÁß...', [IpList[0]]); Application.ProcessMessages; tProg.Enabled := true; end else begin if MessageBox(Handle, PChar('ÁßÁöÇϽðڽÀ´Ï±î?'), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit; FreeAndNil(ThdSocketMon_); btnMon.Caption := 'ÆÐŶ ¸ð´ÏÅ͸µ ½ÃÀÛ'; end; Application.ProcessMessages; end; Constructor TDlgSockMonMain.Create(aOwner: TComponent); begin Inherited Create(aOwner); ThdSocketMon_ := nil; end; Destructor TDlgSockMonMain.Destroy; begin if ThdSocketMon_ <> nil then FreeAndNil(ThdSocketMon_); Inherited; end; procedure TDlgSockMonMain.process_WM_SOCKETMON_NOTIFICATION(var msg: TMessage); begin // mmLog.Lines.Add(String(msg.LParam)); end; procedure TDlgSockMonMain.tProgTimer(Sender: TObject); var pEnt: PSocketMonEnt; pData: PSocketMonEnt; begin if ThdSocketMon_ <> nil then begin try pEnt := ThdSocketMon_.GetSocketMonEnt; while pEnt <> nil do begin pData := VT_AddChildData(vtList); pData^ := pEnt^; Dispose(pEnt); pEnt := ThdSocketMon_.GetSocketMonEnt; end; except end; end else tProg.Enabled := false; end; procedure TDlgSockMonMain.vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var pData: PSocketMonEnt; begin pData := Sender.GetNodeData(Node); Finalize(pData^); end; procedure TDlgSockMonMain.vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); begin HintText := vtList.Text[Node, Column]; end; procedure TDlgSockMonMain.vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := SizeOf(TSocketMonEnt); end; procedure TDlgSockMonMain.vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var pData: PSocketMonEnt; begin pData := Sender.GetNodeData(Node); case Column of 0 : CellText := IntToStr(Node.Index + 1); 1 : CellText := DateTimeToStr(pData.PacketInfo.PacketDT); 2 : CellText := GetIPProtoName(pData.PacketInfo.ProtoType); 3 : CellText := IPToStr(pData.PacketInfo.AddrSrc); 4 : CellText := IntToStr(pData.PacketInfo.PortSrc); 5 : CellText := IPToStr(pData.PacketInfo.AddrDest); 6 : CellText := IntToStr(pData.PacketInfo.PortDest); 7 : CellText := ExtractFileName(pData.ConnInfo.ProcName); 8 : CellText := IntToStr(pData.ConnInfo.ProcessID); 9 : CellText := IntToStr(pData.PacketInfo.PacketLen); 10 : CellText := IntToStr(pData.PacketInfo.DataLen); 11 : if pData.PacketInfo.DataLen <> 0 then CellText := AnsiString(pData.PacketInfo.DataBuf) else CellText := GetFlags(pData.PacketInfo.TcpFlags); end; end; end.