实例——应用tidechoserver和tidecho组件.txt

Delphi 7组件应用实例 书籍语言： 简体中文 书籍类型： 程序设计 授权方式： 免费软件 书籍大小： 105 KB

(1) unit U_Echo_Client;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdEcho, StdCtrls;
type
  TEcho_Client = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    BConnect: TButton;
    BSend: TButton;
    BDisCon: TButton;
    EAddress: TEdit;
    EText: TEdit;
    LTime: TLabel;
    LReceive: TLabel;
    IdEcho1: TIdEcho;
    procedure BConnectClick(Sender: TObject);
    procedure BSendClick(Sender: TObject);
    procedure BDisConClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure EAddressChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Echo_Client: TEcho_Client;

implementation

{$R *.dfm}

procedure TEcho_Client.FormCreate(Sender: TObject);
begin
    BConnect.Enabled := True;  //激活“连接”按钮
    EText.Enabled := False;   //禁用发送文本框
    EText.color := clSilver;
    BSend.Enabled :=False;  //禁用“发送”按钮
    BDisCon.Enabled := False; //禁用“断开连接”按钮
end;

procedure TEcho_Client.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
   IdEcho1.Disconnect;
end;

procedure TEcho_Client.EAddressChange(Sender: TObject);
begin
  // 设置要连接的服务器的地址
 IdEcho1.Host := EAddress.Text;
end;

procedure TEcho_Client.BConnectClick(Sender: TObject);
begin
  try
    //建立与Echo服务器的连接
    IdEcho1.Connect;
    EText.Enabled := True;  //激活发送文本框
    EText.color := clWhite;
    BSend.Enabled := True;//激活“发送”按钮
    BDisCon.Enabled := True;//激活“断开连接”按钮
    BConnect.Enabled :=False;//禁用“连接”按钮
  except
    //断开与Echo服务器的连接
    IdEcho1.Disconnect;
    ShowMessage('连接失败，请检查服务器是否运行！');
  end; //try..except
end;

procedure TEcho_Client.BSendClick(Sender: TObject);
begin
  //对发送文本框的内容不为‘’的情况进行处理
  if EText.Text<>'' then
    begin
      //发送并接收回声数据
      lTime.Caption := IdEcho1.Echo ( EText.Text );
      //显示发送和接收回声数据所需的时间
      LReceive.Caption := IntToStr ( IdEcho1.EchoTime );
    end
  //对发送文本框的内容为‘’的情况进行处理
  else
    begin
      lTime.Caption :='';
      LReceive.Caption :='';
    end;      
end;

procedure TEcho_Client.BDisConClick(Sender: TObject);
begin
  //断开与Echo服务器的连接
  IdEcho1.Disconnect;
  BConnect.Enabled := True;  //激活“连接”按钮
  EText.Enabled := False;   //禁用发送文本框
  EText.color := clSilver;
  BSend.Enabled :=False;  //禁用“发送”按钮
  BDisCon.Enabled := False; //禁用“断开连接”按钮
end;

end.
(2) unit U_Echo_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
  IdEchoServer;

type
  TF_Echo_Server = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    IdECHOServer1: TIdECHOServer;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure IdECHOServer1Disconnect(AThread: TIdPeerThread);
    procedure IdECHOServer1Connect(AThread: TIdPeerThread);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_Echo_Server: TF_Echo_Server;

implementation

{$R *.dfm}
procedure TF_Echo_Server.FormActivate(Sender: TObject);
begin
 try
 //激活TIdECHOServer组件
  IdECHOServer1.Active := True;
 except
  ShowMessage('拒绝连接！由于安全的原因无法绑定到预定的端口！');
  Application.Terminate;
 end;
end;

procedure TF_Echo_Server.IdECHOServer1Disconnect(AThread: TIdPeerThread);
begin
  //更新窗体上显示的服务器状态
  Label2.caption := '[ 空闲－等待新用户 ]';
end;

procedure TF_Echo_Server.IdECHOServer1Connect(AThread: TIdPeerThread);
begin
 //更新窗体上显示的服务器状态
 Label2.caption := '[ 服务于客户 ]';
end;

procedure TF_Echo_Server.Button1Click(Sender: TObject);
begin
  if IdECHOServer1.active then
    IdECHOServer1.active := false;
  Application.terminate;
end;

end.