Question

VB多人聊天室！！！

我想要一个VB多人聊天室！功能1.就1个程序！！！，只要打开客户端，然后上面写的可以创建一个房间，点击创建，就可以创建一个房间。然后别人可以加入！（在客户端的界面，有一个List可以自动查询当前的房间，然后双击就可以进入，此功能必须有），也可以输入IP进行查找（有没有都行，最好有）2.不需要服务器，只要1个程序，创建完房间的人，其实和正常人一样，一起聊天，他走了不是服务器就关闭了，是别人还可以继续聊！所有人都走了，房间就自动没了！ 就仅仅这点要求！请懂VB的人过来帮助一下！提供点线索！求你们了！

Answer 1

哇！这可是个大程序啊！创房间貌似很难啊！不需要服务器不太可能吧？服务器代码“注：文件中包含：保存聊天记录（mnuFileSave） 退出（mnuFileExit），窗体Name属性是 frmServerPrivate Sub Form_Load()
Dim i As Integer

'设置Winsock控件wsk(0)的协议和端口
wsk(0).Protocol = sckTCPProtocol
wsk(0).LocalPort = LOCAL_PORT
'让wsk(0)监听端口
wsk(0).Listen

'加载9个Winsocks控件，并分别设置其协议和端口
For i = 1 To MAX_NUM
Load wsk(i)
wsk(i).Protocol = sckTCPProtocol
wsk(i).LocalPort = LOCAL_PORT
Next

'调用refreshStatus过程，刷新状态栏
Call RefreshStatus
End SubPrivate Sub Form_Resize()
'设置窗体中控件的大小和位置
If Me.WindowState <> vbMinimized Then
lstUserName.Top = 10
lstUserName.Left = Me.ScaleWidth - lstUserName.Width - 10
lstUserName.Height = Me.ScaleHeight - Me.stsBar.Height

lstMess.Move 10, 10, Me.ScaleWidth - lstUserName.Width - 10, Me.ScaleHeight - Me.stsBar.Height
End If
End SubPrivate Sub mnuFileExit_Click()
Unload Me
End SubPrivate Sub mnuFileSave_Click()
Dim i As Integer

Open "聊天记录.txt" For Append As #1
For i = 0 To lstMess.ListCount - 1
Print #1, lstMess.List(i)
Next i
MsgBox "保存成功！", vbOKOnly + vbInformation, "提示"

Close #1 '关闭文件End SubPrivate Sub tmrRefreshSTS_Timer()
'每隔1秒钟，刷新状态栏
Call RefreshStatus
End SubPrivate Sub wsk_Close(Index As Integer)
wsk(Index).Close
'与客户端断开，刷新状态栏
Call RefreshStatus

'从用户列表删除连接断开的客户端
Call DeleUser(Index)

'向所有客户端传送新的用户列表
Call SendUserList
End SubPrivate Sub wsk_Connect(Index As Integer)
'连接成功，则刷新状态栏
Call RefreshStatus
End SubPrivate Sub wsk_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim msg As String
Dim i As Integer

If Index = 0 Then
'查寻Winsock控件数组中，没有连接客户端
'的控件，并将客户端的连入请求分配给数组中
'下标值最小的空闲Winsock控件
For i = 1 To MAX_NUM
With wsk(i)
If .State = sckClosed Then
'接收连入请求
.Accept requestID

'跳出循环
Exit For
End If
End With
Next
End If
End SubPrivate Sub wsk_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim msg As String
Dim i As Integer
Dim flag As Boolean '使用变量msg保存传输过来的信息
wsk(Index).GetData msg, , bytesTotal

'判断传输过来的是用户名还是聊天信息
'如果以@+开头则是用户名，否则是聊天信息
If Left(msg, 2) = "@+" Then

'判断是否到达聊天用户上线，如果是则发送@#
If lstUserName.ListCount = MAX_NUM - 1 Then
wsk(Index).SendData "@#"
Exit Sub
End If
'将真正的用户名从字符串msg中分离出来
msg = Mid(msg, 3)
For i = 0 To lstUserName.ListCount - 1

'判断传输过来的用户名是否已经在用户名列表中
'如果在列表中，则设置标记变量flag为真
'并跳出循环，否则设置为假
If msg = lstUserName.List(i) Then
flag = True
Exit For
Else
flag = False
End If
Next i

'如果标记为真，则传送用户名已经存在标记@1，
'并断开连接，如果为假则将用户名添加到用户名列表中，
'并用窗体级数组变量idxuser存放用户名，其中idxuser的
'下标Index就是Winsock控件数组的下标Index
If flag Then
wsk(Index).SendData "@1" Else
lstUserName.AddItem msg
idxuser(Index) = msg

'向所有客户端传送用户列表
Call SendUserList
End If

Else
'将聊天信息添加到列表框内
lstMess.AddItem msg

'将聊天信息发送到其他客户端（聊友）
For i = 1 To MAX_NUM
With wsk(i)
If .State = sckConnected Then
'将聊天信息发送给具体的客户端
.SendData msg

'等待信息被发送出去
DoEvents
End If
End With
Next
End IfEnd Sub客户端：初始窗体：frmLogin代码：Private Sub Form_Load()
'设置服务器的IP地址，其中127.0.0.1代表本地
'计算机，即与客户端程序运行在同一台机器上
'
wsk1.RemoteHost = "127.0.0.1"
wsk1.RemotePort = 9999
flag = False
End SubPrivate Sub wsk1_Connect()
'连接成功后，马上发送用户名
wsk1.SendData "@+" & txtUserName.TextEnd SubPrivate Sub wsk1_DataArrival(ByVal bytesTotal As Long)
Dim msg As String
Dim username As String '使用msg存放传送过来的信息
wsk1.GetData msg, , bytesTotal

'判断传送过来的信息是何种信息，头两个字符为@#，
'表明聊天室用户已到上线，头两个字符为@1，
'则传递过来的是用户名已存在，拒绝连接的信息
'头两个字符为@2，则表明传过来的是用户名列表的内容，
'头两个字符为@e，则表明用户名列表传送结束
'除以上标记以外的，则表明传过来的是聊天信息
Select Case Left(msg, 2)
Case "@#"
wsk1.Close
MsgBox "聊天室已满！请稍候登录！"
Exit Sub
Case "@1"
wsk1.Close
MsgBox "您输入的用户名已经存在！请使用其他用户名"
txtUserName.Text = ""
txtUserName.SetFocus
Exit Sub Case "@2"

'判断标记变量flag是否为真，
'如果为真，则清楚用户名列表内的
'内容，以达到避免重复添加用户名
If flag Then
frmMain.lstUserName.Clear
flag = False
End If

'用变量username存放真正的用户名信息
username = Mid(msg, 3)
'将用户名信息添加到用户名列表框中
frmMain.lstUserName.AddItem username
Case "@e"

'用户名列表传送结束，将flag设置为真
flag = True Case Else

'将信息添加到聊天内容列表框
frmMain.lstMess.AddItem msg
End Select

'判断frmMain窗体是否显示，如果没有显示
'则显示该窗体，并隐藏登录窗体，
'给全局变量G_myname赋值,否则如果以显示
'则将其设置为可见
If IsShow("聊天客户端") = False Then
G_myname = txtUserName.Text
frmMain.Caption = "聊天室客户端程序" & "--我的用户名：" & G_myname
frmMain.Show
Me.Hide
Else
G_myname = txtUserName.Text
frmMain.Caption = "聊天室客户端程序" & "--我的用户名：" & G_myname
frmMain.Visible = True
Me.Hide
End If
End SubPrivate Sub wsk1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox "出现错误！" & vbCrLf & _
"错误号为:" & Number & vbCrLf & _
"错误描述为：" & Description & vbCrLf
End Sub
还剩下些，补充回答说

Answer 2

给你个概念，我的代码找不到了，但是只要你基础没问题，肯定看的懂，首先在服务器的connectionrequest事件下，用load winsock1(index)数组的方法，无限连接客户端。然后就开始了，服务器和客户端，每次发送时，都要加头字母，比如每个客户端form1.caption的名字就是senddata form1.capiton & @ & text1.text。 这个是最简单的，你如果要按头字母发送各种不同的信息就要再加上投字母，比如客户端上线发布用 senddata "up" & form1.caption & text1.text ,这样在服务器解读你发的这个信息时，当接收你的信息 getdata str 时， 会先aa=len(str,2） 通过select case aa, case aa="up" 就只要你这个信息是上线通知，服务器会把这个信息再senddata出去， 然后各个客户端都getdata 你这个上线信息， 然后再list1.additem到你的好友列表里。具体过程就是，判断服务器发布连接客户端的信息，遵从头字母协议，向各客户端发送数据， 各客户端根据头字母协议，比对好友列表并加入，好友列表已经存在的，服务器向各客户端发布一个客户端上线的信息时，好友列表变色。 说白了就是绕几个弯，你的信息是怎么发布比如上线信息（在connection事件里send），close下线信息（在close事件里send）， 发送信息（在command控件下 send）。 然后再减去前面的两个发布模式字母，就是各个客户端的用户名了，也就是各个客户端的form1.caption & @. 这样你也可以私聊，也可以群发。 说的比较乱，你多担待。

Answer 3

前面那个Private Sub txtSendData_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If frmLogin.wsk1.State = sckConnected Then
frmLogin.wsk1.SendData Now & " " & frmLogin.G_myname & "对" & _
Me.lstUserName.Text & _
"说：" & txtSendData.Text什么意思？