聊天室服务器客户机的编写

钱俊 
2001年 17期

#1　　服务器程序
　　    创建一个标准EXE工程，在控件工具栏中点击鼠标右键，选择部件，在控件选项卡中选中Microsoft Winsock Control 6.0就行了。接下来在新建的窗体上添加一个Winsock和一个Command控件，其参数分别设置如下：Winsock的caption属性设为sock1，protocol属性设为0-TCP，Command1的caption属性设为“关闭（&C）”，调整好各个控件和窗体的大小，界面如^17020503a^1。
　　#1    服务器程序代码如下
　　　　Option Explicit
　　　　Dim m As Integer   ＇作信息寄存器记数用
　　　　Dim tex（200） As String ＇信息寄存器
　　　　Dim n As Integer        ＇winsock用
　　　　＇关闭服务器
　　　　Private Sub Command1_Click（）　
　　　　End
　　　　End Sub
　　　　＇禁止同时运行两次程序
　　　　Private Sub Form_Initialize（）　
　　　　If App.PrevInstance Then
　　　　MsgBox "程序已经运行！"， vbOKOnly， "提示"
　　　　End
　　　　End If
　　　　End Sub
　　　　Private Sub Form_Load（）　
　　　　n = 0
　　　　m = 0
　　　　sock1（0）.LocalPort = 1024
　　　　sock1（0）.Listen
　　　　End Sub
　　　　Private Sub sock1_Close（Index As Integer）　
　　　　sock1（Index）.Close
　　　　End Sub
　　　　Private Sub sock1_ConnectionRequest（Index As Integer， ByVal requestID As Long）
　　　　n = n + 1
　　　　Load sock1（n）　
　　　　sock1（n）.Accept requestID
　　　　End Sub
　　　　Private Sub sock1_DataArrival（Index As Integer， ByVal requestID As Long）
　　　　Dim rec As String
　　　　Dim i As Integer
　　　　＇接受数据
　　　　sock1（Index）.GetData rec， vbString
　　　　If rec = "刷新数据" Then
　　　　Else        ＇存储数据
　　　　tex（m） = rec
　　　　m = m + 1
　　　　End If
　　　　＇转发数据
　　　　For i = m - 1 To 199
　　　　sock1（Index）.SendData tex（i） + Chr（13） + Chr（10）　
　　　　Next
　　　　For i = 0 To m
　　　　sock1（Index）.SendData tex（i） + Chr（13） + Chr（10）　　
　　　　Next
　　　　＇自动删除信息
　　　　If m = 200 Then m = 0
　　　　End Sub
　　#1    客户端程序
　　　　新建一个标准EXE工程，在新建的窗体上添加如下控件：winsock（sock2）、command1（退出）、label1（接受窗）、label2（发送窗）、label3、text1、text2。其中winsock的protocol属性设为0-TCP，label3的caption属性设为""，autosize设为True，text1的Multiline属性设为True，ScrollBars属性设为3-both，text1、text2的text属性设为""。调整好各控件大小，界面如^17020503b^2。
　　#1　　客户端程序代码如下
　　　　Option Explicit
　　　　Dim ip As String
　　　　＇记录服务器的IP地址
　　　　Dim nam As String  ＇记录本人姓名
　　　　＇禁止同时运行两次程序
　　　　Private Sub Form_Initialize　
　　　　If App.PrevInstance Then
　　　　MsgBox "程序已经运行！"， vbOKOnly， "提示"
　　　　End
　　　　End If
　　　　End Sub
　　　　＇程序初始化
　　　　Private Sub Form_Load（）　
　　　　ip = InputBox（"输入服务器的IP地址"， "登录框"）　
　　　　nam = InputBox（"输入您的姓名"， "登录框"）　
　　　　sock2.RemoteHost = ip
　　　　sock2.RemotePort = 1024
　　　　sock2.Connect
　　　　Label3.Caption = nam
　　　　＇将姓名显示出来
　　　　End Sub
　　　　＇禁止用"X"按钮退出
　　　　Private Sub Form_Unload（Cancel As Integer）　
　　　　Cancel = True
　　　　End Sub
　　　　Private Sub command1_Click（）　
　　　　sock2.SendData nam + "退出聊天室！"
　　　　End
　　　　End Sub
　　　　Private Sub sock2_Close（）　
　　　　sock2.Close
　　　　End Sub   ＇连接服务器
　　　　Private Sub sock2_Connect（）　
　　　　sock2.SendData nam + "进入聊天室！"
　　　　End Sub
　　　　＇数据接受并显示
　　　　Private Sub sock2_DataArrival（ByVal bytesTotal As Long）　
　　　　Dim rec As String
　　　　sock2.GetData rec， vbString
　　　　Text1.Text = rec
　　　　Text1.SelStart = Len（Text1.Text）　
　　　　End Sub    ＇发送窗
　　　　Private Sub Text2_KeyPress（KeyAscii As Integer）　
　　　　Dim msg As String
　　　　If KeyAscii = 13 Then
　　　　If Text2.Text = "" Then
　　　　MsgBox "说话内容不能为空"， vbExclamation + vbOKOnly， "提示"
　　　　Else
　　　　msg = nam + ": " + Text2.Text
　　　　Text2.Text = ""
　　　　sock2.SendData msg
　　　　End If
　　　　End If
　　　　End Sub
　　　　至此，整个程序已经完成，但还不完善，因为不能实时显示每个人的发言。要想实时显示，就必须做一些改动。方法是:在客户端窗体上添加一个时钟控件，其Interval属性设为1000（即1秒），Enabled属性设为False。
　　#1     在代码窗中添加如下代码：
　　　　在form_load过程的最后添加一行代码：Timer1.Enabled = True
　　　　＇定时刷新
　　　　Private Sub Timer1_Timer　
　　　　sock2.SendData "刷新数据"
　　　　End Sub
　　　　下面再在服务器程序中做以下改动：在sock1_DataArrival过程中将
　　　　tex（m） = rec
　　　　m = m + 1
　　　　改为
　　　　If rec = "刷新数据" Then
　　　　Else
　　　　tex（m） = rec
　　　　m = m + 1
　　　　End If
　　　　这样这个聊天室程序就具备了实时聊天的功能。另外大家还可以在此基础上添加其他功能，如改名、私聊、开设房间等。
　　
　　 
 