BSOne.SFC/Tocsg.Module/SocketMon/DSockMonMain.pas

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.