使用Socket的“网上对话”程序

    Unit Uclient_Chat；
{该程序采用异步非阻塞方式工作，使用1024端口，在客户程序与服务程序之间实现信息交换。它既可独立在同一台机器上运行，也可在两台机器上运行，即一台作为服务器，另一台作为客户机。}
interface
uses
      //定义使用系统的单元文件
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, Buttons, Menus, ScktComp, ComCtrls, StdCtrls, FileCtrl；
type
      //定义窗体使用组件和菜单
      TChatForm = class(TForm)
      ConnectBtn: TSpeedButton；
      ClientSocket: TClientSocket；
      ServerSocket: TServerSocket；
      Label1: TLabel；
      Label2: TLabel；
      Label3: TLabel；
      MainMenu1: TMainMenu；
      File1: TMenuItem；
      FileListenItem: TMenuItem；
      FileConnectItem: TMenuItem；
      Disconnect1: TMenuItem；
      N1: TMenuItem；
      Exit1: TMenuItem；
      ReceiveMemo: TMemo；
      SendMemo: TMemo；
      StatusBar1: TStatusBar；
      SaveReceiveBtn: TBitBtn；
      //保存接收数据按钮
      SaveSendBtn: TBitBtn；
      //保存发送数据按钮
      SaveDialog1: TSaveDialog；
      //保存信息对话框
      SaveDialog2: TSaveDialog；
      //如下定义事件处理过程
      procedure FileConnectItemClick(Sender: TObject)；
      procedure ClientSocketConnect(Sender: TObject；Socket: TCustomWinSocket)；
    procedure ClientSocketDisconnect(Sender: TObject；Socket:TCustomWinSocket)；
      procedure ClientSocketError(Sender: TObject； Socket: TCustomWinSocket；
                            ErrorEvent: TErrorEvent； var ErrorCode: Integer)；
      procedure ClientSocketRead(Sender: TObject； Socket: TCustomWinSocket)；
      procedure ServerSocketAccept(Sender: TObject；Socket: TCustomWinSocket)；
procedure ServerSocketClientConnect(Sender: TObject；
Socket: TCustomWinSocket)；
      procedure ServerSocketClientDisconnect(Sender: TObject；
                                             Socket: TCustomWinSocket)；
      procedure ServerSocketClientRead(Sender: TObject；
                                       Socket: TCustomWinSocket)；
      procedure Disconnect1Click(Sender: TObject)；
      procedure FileListenItemClick(Sender: TObject)；
      procedure FormCreate(Sender: TObject)；
      procedure ServerSocketError(Sender: TObject； Number: Smallint；
      var Description: string； Scode: Integer； const Source,
      HelpFile: string； HelpContext: Integer； var CancelDisplay: Wordbool)；
      procedure SaveSendBtnClick(Sender: TObject)；
      procedure SaveReceiveBtnClick(Sender: TObject)；
      procedure SendMemoKeyDown(Sender: TObject； var Key: Word；
      Shift: TShiftState)；
    private
      { Private declarations }
    public
      { Public declarations }
    protected
      IsServer: Boolean；
    end；
var
  ChatForm: TChatForm；
      Server: String；
implementation
{$R *.dfm}

procedure TChatForm.FileConnectItemClick(Sender: TObject)；
    //选择了Connect菜单项或单击了SpeedButton1按钮调用该过程
begin
     if ClientSocket.Active then ClientSocket.Active := False；
     if InputQuery('Computer to connect to', 'Address Name:', Server) then
     //输入将要连接的作为Server计算机的IP地址,该地址既可以是本机，
     //也可以是另一台机器的IP地址
       if Length(Server) > 0 then
      with ClientSocket do
      begin
        Host := Server；
        //获取将要通信的IP地址
        Active := True；
        //打开Socket的连接状态
        FileListenItem.Checked := False；
        //置监听菜单项为不选择
      end；
end；

procedure TChatForm.ClientSocketConnect(Sender: TObject；
Socket: TCustomWinSocket)；
    //当Tclientsocket连接到打开的TserverSocket后，该事件发生。
begin
      Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteHost；
end；

procedure TChatForm.ClientSocketDisconnect(Sender: TObject；
    Socket: TCustomWinSocket)；
//客户解除连接时，调用该过程
begin
      FileListenItemClick(nil)；
     //解除连接时，清除监听选项
end；

procedure TChatForm.ClientSocketError(Sender: TObject；Socket:
 TCustomWinSocket； ErrorEvent: TErrorEvent；var ErrorCode: Integer)；
//出现错误时，调用该过程
begin
      //出现错误时，显示连接错误的IP地址
      ReceiveMemo.Lines.Add('Error connecting to : ' + Server)；
      ErrorCode := 0；
end；

procedure TChatForm.ClientSocketRead(Sender: TObject；
    Socket: TCustomWinSocket)；
    //当TclientSocket将要从socket连接中读信息时，该事件发生。
begin
      ReceiveMemo.Lines.Add(Socket.ReceiveText)；
     //ReceiveText是TCustomWinSocket的方法,读取接收到的数据。
end；

procedure TChatForm.ServerSocketAccept(Sender: TObject；
    Socket: TCustomWinSocket)；
    //当Server sockets从队列中接受请求后，该事件发生。
begin
      {Server sockets为监听打开一个socket连接，并建立一个队列以保持客户的请求。      当Server sockets接受连接后，client socket完成连接，同时client socket的OnConnect事件发生。}
      IsServer := True；
      Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress；
  //在状态栏显示连接机器的IP地址
end；

procedure TChatForm.ServerSocketClientConnect(Sender: TObject；
    Socket: TCustomWinSocket)；
    //当client socket完成了由server socket认可的连接后，该事件发生。
begin
      //清除以前客户发来的信息
      ReceiveMemo.Lines.Clear；
end；

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject；
    Socket: TCustomWinSocket)；
    //当TServerSocket与TclientSocket的连接之一被关闭时，该事件发生。
begin
      Statusbar1.Panels[0].Text := 'Listening...'；
  //在状态栏显示目前处于监听状态
end；

procedure TChatForm.ServerSocketClientRead(Sender: TObject；
    Socket: TCustomWinSocket)；
    //当监视到指定端口有客户请求时，产生该事件。
begin
      ReceiveMemo.Lines.Add(Socket.ReceiveText)；
     //获取用户传送过来的数据
end；

procedure TChatForm.Disconnect1Click(Sender: TObject)；
    //选择Disconnect菜单项后，该事件发生
begin
      ClientSocket.Active := False；
      //关闭TClientSocket的连接
      ServerSocket.Active := True；
      //将TServerSocket的连接打开
      Statusbar1.Panels[0].Text := 'Listening...'；
      //在状态条上，显示监听状态
end；

procedure TChatForm.FileListenItemClick(Sender: TObject)；
begin
      // 由于该程序既可作为服务程序工作，又可作为客户程序工作
      //所以要根据Listen菜单项确定该应用是作为服务程序还是客户程序工作
      FileListenItem.Checked := not FileListenItem.Checked；
     //获取Listen菜单项是否选中的相反值，如果选中其值为True,否则为False。
     if FileListenItem.Checked then
     //未选中监听菜单项
     begin
       ClientSocket.Active := False；
       ServerSocket.Active := True；
       //打开Socket的连接状态，开始监视操作
       Statusbar1.Panels[0].Text := 'Listening...'；
     end
     else
     //选中Listen菜单项
     begin
        if ServerSocket.Active then
        ServerSocket.Active := False；
        //关闭Socket的连接状态
        Statusbar1.Panels[0].Text := ''；
        //清除状态条的显示信息
     end；
end；

procedure TChatForm.FormCreate(Sender: TObject)；
    //建立窗体时，调用FileListenItemClick事件处理过程，初始化菜单项
begin
       FileListenItemClick(nil)；
end；

procedure TChatForm.ServerSocketError(Sender: TObject； Number: Smallint；
    var Description: string； Scode: Integer； const Source, HelpFile: string；
    HelpContext: Integer； var CancelDisplay: Wordbool)；
begin
ShowMessage(Description)；
//显示出错信息
end；

procedure TChatForm.SaveSendBtnClick(Sender: TObject)；
    //在单击了“保存发送数据”按钮后调用该过程
begin
      SaveDialog2.Execute；
//显示保存文件对话框
if SaveDialog2.Execute then
SendMemo.Lines.SaveToFile(SaveDialog1.FileName)；
//将发送信息区的内容写入用户指定的文件中
end；

procedure TChatForm.SaveReceiveBtnClick(Sender: TObject)；
    //在单击了“保存接收数据”按钮后调用该过程
begin
      SaveDialog1.Execute；
      if SaveDialog1.Execute then
ReceiveMemo.Lines.SaveToFile(SaveDialog1.FileName)；
//将接收信息区的内容写入用户指定的文件中
end；

procedure TChatForm.SendMemoKeyDown(Sender: TObject； var Key: Word；
    Shift: TShiftState)；
    //当用户在发送数据区中输入信息并按回车后，该事件发生。
begin
      if Key = VK_Return then
      if IsServer then
ServerSocket.Socket.Connections[0].SendText(SendMemo.Lines[SendMemo.Lines.Count - 1])
       //SendText则为TCustomWinSocket的方法，其作用是往socket连接发送信息
       //，即将用户在SendMemo框中输入的最后一行信息发出。
      else
        ClientSocket.Socket.SendText(SendMemo.Lines[SendMemo.Lines.Count - 1])；
end；
end.