使用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.