服务器程序
创建一个标准EXE工程，在控件工具栏中点击鼠标右键，选择部件，在控件选项卡中选中Microsoft Winsock Control 6.0就行了。接下来在新建的窗体上添加一个Winsock和一个Command控件，其参数分别设置如下：Winsock的caption属性设为sock1，protocol属性设为0-TCP，Command1的caption属性设为“关闭(&C)”，调整好各个控件和窗体的大小，界面如
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
客户端程序
新建一个标准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属性设为""。调整好各控件大小，界面如
2。
客户端程序代码如下
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。
在代码窗中添加如下代码：
在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
这样这个聊天室程序就具备了实时聊天的功能。另外大家还可以在此基础上添加其他功能，如改名、私聊、开设房间等。