utcphist.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

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;

//是否列出处于征听的TCP
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.