userver.pas

基于Indy的网络聊天

unit UServer;

interface

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

type
  TfrmMain = class(TForm)
    lblPort: TLabel;
    edtPort: TEdit;
    lblData: TLabel;
    edtData: TEdit;
    lblLog: TLabel;
    lbLog: TListBox;
    btnStart: TButton;
    btnStop: TButton;
    btnExit: TButton;
    IdTCPServer: TIdTCPServer;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure IdTCPServerConnect(AThread: TIdPeerThread);
    procedure IdTCPServerExecute(AThread: TIdPeerThread);
  private
    procedure AddLogEntry;
    procedure DisplayData;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}
var
  FLogEntry,FReceived:string;
  
procedure TfrmMain.BtnStartClick(Sender: TObject);
begin
  IdTCPServer.DefaultPort := StrToInt(EdtPort.Text);
  IdTCPServer.Active := True;
  BtnStart.Enabled := False;
  BtnStop.Enabled := True;
  LbLog.Items.Add('服务器已成功启动！');
end;

procedure TfrmMain.BtnStopClick(Sender: TObject);
begin
  IdTCPServer.Active := False;
  BtnStart.Enabled := True;
  BtnStop.Enabled := False;
  LbLog.Items.Add('服务器已成功停止！');
end;

procedure TfrmMain.IdTCPServerConnect(AThread: TIdPeerThread);
begin
  LbLog.Items.Add('来自主机 '
    + AThread.Connection.Socket.Binding.PeerIP
    + ' 的连接请求已被接纳！');
  AThread.Connection.WriteLn('100: 欢迎连接到简单TCP服务器！');
end;

procedure TfrmMain.IdTCPServerExecute(AThread: TIdPeerThread);
var
  sCommand: string;
begin
  with AThread.Connection do
  begin
    sCommand := ReadLn();
    FLogEntry := sCommand + ' 来自于主机 '
      + AThread.Connection.Socket.Binding.PeerIP;
    AThread.Synchronize(AddLogEntry);
    if AnsiStartsText('DATA ', sCommand) then
    begin
      FReceived := RightStr(sCommand, Length(sCommand) - 5);
      WriteLn('200: 数据接收成功！');
      AThread.Synchronize(DisplayData);
    end
    else if SameText(sCommand, 'QUIT') then
    begin
      FLogEntry := '断开同主机 '
        + AThread.Connection.Socket.Binding.PeerIP
        + ' 的连接！';
      AThread.Synchronize(AddLogEntry);
      Disconnect;
    end
    else
    begin
      WriteLn('500: 无法识别的命令！');
      FLogEntry := '无法识别命令：' + sCommand;
      AThread.Synchronize(AddLogEntry);
    end; //endif
  end;
end;

procedure TfrmMain.DisplayData();
begin
  EdtData.Text := FReceived;
end;

procedure TfrmMain.AddLogEntry();
begin
  LbLog.Items.Add(FLogEntry);
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;

end.