frmmain.pas

Delphi网络应用开发的源代码

unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdUDPServer, IdTCPServer, Sockets, IdUDPBase, IdUDPClient,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls,
  StdCtrls, Buttons, ComCtrls, IdThreadMgr, IdThreadMgrDefault;

type

  TCommBlock = record        // 通讯结构
    SenderName,              // 发信方名字
    Msg      : string[100];  // 消息
  end;

  TFrmChat = class(TForm)
    Panel1: TPanel;
    RemoteIP: TLabeledEdit;
    RemotePort: TLabeledEdit;
    NickName: TLabeledEdit;
    LocalPort: TLabeledEdit;
    Panel2: TPanel;
    IdTCPClient: TIdTCPClient;
    IdTCPServer: TIdTCPServer;
    BitConnect: TBitBtn;
    BitLogin: TBitBtn;
    InputBox: TEdit;
    BitSend: TBitBtn;
    ChatLog: TMemo;
    procedure BitConnectClick(Sender: TObject);
    procedure BitSendClick(Sender: TObject);
    procedure IdTCPServerConnect(AThread: TIdPeerThread);
    procedure IdTCPServerDisconnect(AThread: TIdPeerThread);
    procedure IdTCPServerExecute(AThread: TIdPeerThread);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitLoginClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TClientHandleThread = class(TThread)
  private
    CB: TCommBlock;
    procedure HandleInput;
  protected
    procedure Execute; override;
  end;


var
  FrmChat  : TFrmChat;
  ClientHandleThread: TClientHandleThread;   // variable (type see above)

implementation

{$R *.dfm}

procedure TFrmChat.BitConnectClick(Sender: TObject);
begin
  if trim(RemoteIP.Text)='' then
  begin
    ShowMessage('服务器IP不能为空');
    Exit;
  end;

  if trim(RemotePort.Text)='' then
  begin
    ShowMessage('服务器端口不能为空');
    Exit;
  end;

  IdTCPClient.Port:=StrToInt(RemotePort.Text);
  IdTCPClient.Host:=RemoteIP.Text;
  try
    IdTCPClient.Connect;  // in Indy < 8.1 leave the parameter away
    ClientHandleThread := TClientHandleThread.Create(True);
    ClientHandleThread.FreeOnTerminate:=True;
    ClientHandleThread.Resume;
  except
      on E: Exception do MessageDlg ('链接错误:'+#13+E.Message, mtError, [mbOk], 0);
  end;
  BitSend.Enabled := true;
end;

procedure TFrmChat.BitSendClick(Sender: TObject);
var
  CommBlock : TCommBlock;
begin
  CommBlock.SenderName   := NickName.Text;
  CommBlock.Msg          := InputBox.Text;
  IdTCPClient.WriteBuffer (CommBlock, SizeOf (CommBlock), true);
  ChatLog.Lines.Add(CommBlock.SenderName+':'+CommBlock.Msg);
end;

procedure TFrmChat.IdTCPServerConnect(AThread: TIdPeerThread);
begin
  AThread.Data:=TObject(AThread.Connection.LocalName);
  ChatLog.Lines.Add(TimeToStr(Time)+' 来自计算机 "' +
      AThread.Connection.LocalName+'的呼叫');
end;

procedure TFrmChat.IdTCPServerDisconnect(AThread: TIdPeerThread);
begin
  ChatLog.Lines.Add(TimeToStr(Time)+' 断开的链接'+String(AThread.Data));
  AThread.Data := nil;
end;

procedure TFrmChat.IdTCPServerExecute(AThread: TIdPeerThread);
var
  CommBlock : TCommBlock;
begin
  if not AThread.Terminated and AThread.Connection.Connected then
  begin
    AThread.Connection.ReadBuffer(CommBlock, SizeOf (CommBlock));
    ChatLog.Lines.Add(CommBlock.SenderName+'：'+CommBlock.Msg);
  end;
end;

procedure TFrmChat.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if IdTCPClient.Connected then
  begin
    ClientHandleThread.Terminate;
    IdTCPClient.Disconnect;
  end;
end;

procedure TClientHandleThread.HandleInput;
begin
  FrmChat.ChatLog.Lines.Add (CB.SenderName + '：' + CB.Msg);
end;

procedure TClientHandleThread.Execute;
begin
  while not Terminated do
  begin
    if not frmChat.IdTCPClient.Connected then
      Terminate
    else
    try
      FrmChat.IdTCPClient.ReadBuffer(CB, SizeOf (CB));
      Synchronize(HandleInput);
    except
    end;
  end;
end;


procedure TFrmChat.BitLoginClick(Sender: TObject);
begin
  if trim(LocalPort.Text)='' then
  begin
    ShowMessage('本地端口不能为空');
    Exit;
  end;

  IdTCPServer.DefaultPort:=StrToInt(LocalPort.Text);
  IdTCPServer.Active := true;
end;

end.