unit uTCPHist;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, ComCtrls, ExtCtrls, IPHelper, Buttons, jpeg;

const
    Version = ' 1.0';
    MaxEntries = 1000;
type
  TMain = class(TForm)
    Timer: TTimer;
    sgConnHist: TStringGrid;
    StaticText1: TStaticText;
    GroupBox1: TGroupBox;
    sbClear: TSpeedButton;
    stStart: TStaticText;
    cbShowListeners: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure sbClearClick(Sender: TObject);
    procedure cbShowListenersClick(Sender: TObject);
  private
    { Private declarations }
    function IsNewConnection( Conn: TTcpConnStatus ): boolean;
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

{$R *.DFM}

//初始化窗體
procedure TMain.FormCreate(Sender: TObject);
begin
    Caption := Caption + Version;
    sbClearClick(Sender);
end;

//
function TMain.IsNewConnection( Conn: TTcpConnStatus ): boolean;
var
    i : integer;
begin
    //是否忽略正在征聽的連接
    if not (cbShowListeners.State = cbCHECKED)
        and (Conn.Status = TCPConnState[2]) then
    begin
        Result := false;
        EXIT;
    end;
    //
    Result := true;
    for i := 0 to pred(sgConnHist.RowCount) do
    with sgConnHist do
        if  ( Cells[3,i] = Conn.LocalPort)
        and (Cells[4,i] = Conn.RemoteIP)
        and ( Cells[5,i] = Conn.RemotePort)
        and (Cells[6,i]  = Conn.Status ) then
        begin
            Result := false;
            BREAK;
    end;
end;

//定時更新檢查連接狀態
procedure TMain.TimerTimer(Sender: TObject);
var
    List : TList;
    i    : integer;
begin
    Timer.Enabled := false;
    List := TList.Create;
    Get_OpenConnections( List );
    if List.Count > 0 then
    for i := 0 to pred(List.Count) do
    begin
        //判斷是否已經建立的TCP連接
        if IsNewConnection( TTcpConnStatus(List[i]^) ) then
        with TTcpConnStatus( List[i]^), sgConnHist do
        begin
            Cells[0,RowCount-1] := DateToStr(Now);
            Cells[1,RowCount-1] := TimeToStr(Now);
            Cells[2,RowCount-1] := LocalIP;
            Cells[3,RowCount-1] := LocalPort;
            Cells[4,RowCount-1] := RemoteIP;
            Cells[5,RowCount-1] := RemotePort;
            Cells[6,RowCount-1] := Status;
            RowCount := RowCount + 1;
        end;
        Dispose(List[i]);//釋放內存資源
    end;
    List.Free;
    if sgConnHist.RowCount > MaxEntries then
    if MessageDlg(' There are more then ' + IntToStr(MaxEntries)
                + ' entries in the table!' + #13
                + ' To avoid resource problems, table will be cleared',
                 mtWARNING, [mbOK], 0) = mrOK then
                              sbClearClick(Sender);
    Timer.Enabled := true;
end;

//清除歷史記錄
procedure TMain.sbClearClick(Sender: TObject);
var
 i : integer;
begin
  Timer.Enabled := false;
  with sgConnHist do
  begin
    for i := 0 to pred(RowCount) do
      Rows[i].Clear;
    RowCount := 1;
  end;
  Timer.Enabled := true;
  stStart.Caption := 'TCP connection history since : ' + DateTimeToStr(now);
  cbShowListenersClick(Sender);
end;

//------------------------------------------------------------------------------
procedure TMain.cbShowListenersClick(Sender: TObject);
begin
  with sgConnHist do
  begin
   Cells[0,RowCount-1] := DateToStr(Now);
   Cells[1,RowCount-1] := TimeToStr(Now);
   Cells[2,RowCount-1] := 'LISTENING PORTS';
   case cbShowListeners.State of
    cbCHECKED   : Cells[3,RowCount-1] := '  ON';
    cbUNCHECKED : Cells[3,RowCount-1] := '  OFF';
   end;
   RowCount := RowCount + 1;
  end;
end;

end.