永发信息网

VB写聊天室

答案:1  悬赏:30  手机版
解决时间 2021-07-26 00:54
  • 提问者网友:活着好累
  • 2021-07-25 18:01
服务器:

Option Explicit
Dim guest As Integer '在线客户数量计数器
Dim j As Integer '已接客户数量计数器
Dim k As Integer '向在线客户发送消息数量计数器
Dim t As Integer '关闭服务器时向在线客户发送消息数量计数器
Dim port As Integer '端口计数器
Dim msg As String '收发的消息文本
Dim newguest As Integer '新客户连接
Private Sub Form_Load()
If App.PrevInstance Then MsgBox "对不起!您已经创建了一个服务器^_^": End
j = 0
guest = 0
port = 9999
Text2 = Winsock1(0).LocalIP
Label3.Caption = "在线人数:" & guest
Label4.Caption = "已接人数:" & j
Winsock1(0).LocalPort = port 'Winsock控件数组第一个控件开始侦听
Winsock1(0).Listen
End Sub

Private Sub Form_Unload(Cancel As Integer) '关闭服务器时缓冲,发送断开信号
Cancel = 1
t = 0
Timer2.Enabled = 1
End Sub

Private Sub Timer1_Timer()
On Error Resume Next '错误处理
Winsock1(k).SendData msg '向所有客户发送即时收到的消息
k = k + 1
If k >= j Then Timer1.Enabled = 0
End Sub

Private Sub Timer2_Timer() '向客户发送断开信号
On Error Resume Next
msg = "closewinsock"
Winsock1(t).SendData msg
t = t + 1
If t > j Then End
End Sub

Private Sub Timer3_Timer() '向新客户发送欢迎信息
On Error Resume Next
If k = newguest Then Exit Sub
Winsock1(k).SendData msg
k = k + 1
If k >= j Then Timer3.Enabled = 0
End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error Resume Next
Dim onlineperson As String
msg = ""
If Winsock1(Index).State <> sckClosed Then Winsock1(Index).Close '成功连接
Winsock1(Index).Accept requestID
j = j + 1 '统计已接人数
If guest + 1 < 10 Then
onlineperson = "currentonlineperson00" + CStr(guest + 1) + msg
ElseIf guest + 1 < 100 Then
onlineperson = "currentonlineperson0" + CStr(guest + 1) + msg
End If
Winsock1(Index).SendData onlineperson & "您是第" & CStr(j) & "位进入本聊天室的客户^_^" + Chr(13) + Chr(10)
msg = onlineperson & "第" & CStr(j) & "位客户进入了本聊天室" + Chr(13) + Chr(10)
Text1 = Text1 +"第" & CStr(j) & "位客户进入了本聊天室" + Chr(13) + Chr(10)
k = 0
newguest = Index
Timer3.Enabled = 1
Text1.SelStart = Len(Text1)
guest = guest + 1 '统计在线人数
Label3.Caption = "在线人数:" & guest
Label4.Caption = "已接人数:" & j
Load Winsock1(j)
port = port - 1
Winsock1(j).LocalPort = port
Winsock1(j).Listen
End Sub

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim i As Integer
Dim onlineperson As String
msg = ""
Winsock1(Index).GetData msg '发送断开信号
If msg = "closewinsock" Then
msg = ""
Winsock1(Index).Close
If guest - 1 < 10 Then
onlineperson = "currentonlineperson00" + CStr(guest - 1)
ElseIf guest < 100 Then
onlineperson = "currentonlineperson0" + CStr(guest - 1)
End If
msg = "第" & CStr(Index + 1) & "位客户已经离开" + Chr(13) + Chr(10)
Text1 = Text1 + msg
msg = onlineperson & "第" & CStr(Index + 1) & "位客户已经离开" + Chr(13) + Chr(10)
Text1.SelStart = Len(Text1)
k = 0
Timer1.Enabled = 1
guest = guest - 1
Label3.Caption = "在线人数:" & guest
Label4.Caption = "已接人数:" & j
Exit Sub
End If
msg = "第" + CStr(Index + 1) + "位客户说:" + msg + Chr(13) + Chr(10)
Text1 = Text1 + msg
Text1.SelStart = Len(Text1)
k = 0
Timer1.Enabled = 1
End Sub

客户端:

Dim linkstate As Boolean '判断连接状态
Dim port As Integer '依次尝试连接的端口
Private Sub Cmdconnect_Click()
On Error Resume Next
Dim t As String
Dim x As String
Dim y As Integer
y = 0
If Len(Text1) = 0 Then Exit Sub '判断输入的IP地址是否合法
For i = 1 To Len(Text1)
If Mid(Text1, i, 1) <> "." Then
t = t + Mid(Text1, i, 1)
x = ""
Else
y = y + 1
x = x + Mid(Text1, i, 1)
t = ""
End If
If Len(t) > 3 Or x = ".." Or Left(Text1, 1) = "." Or Right(Text1, 1) = "." Then
MsgBox "请输入正确的IP地址^_^", vbOKOnly + vbInformation, "连接": Exit Sub
End If
Next i
If y <> 3 Then MsgBox "请输入正确的IP地址^_^", vbOKOnly + vbInformation, "连接": Exit Sub
If Text1 Like "*.*.*.*" Then
If Cmdconnect.Caption = "&Link" Then '用户选择连接
Cmdconnect.Caption = "&Break"
Timer1.Enabled = 1
Text1.Enabled = 0
Else '用户选择中断连接
Label4.Caption = "在线人数:0"
Text2 = Text2 + "连接中断" + Chr(13) + Chr(10)
Text2.SelStart = Len(Text2)
Timer1.Enabled = 0
Text1.Enabled = 1
Text1.SetFocus
Cmdconnect.Caption = "&Link"
Winsock1.SendData "closewinsock"
linkstate = False
port = 9999
Text3.Enabled = False
cmdsend.Enabled = False
End If
End If
End Sub
Private Sub cmdsend_Click()
On Error Resume Next '发送消息
Winsock1.SendData Text3
Text3 = ""
Text3.SetFocus
End Sub
Private Sub Form_Load()
linkstate = False
port = 9999
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Winsock1.SendData "closewinsock" '向服务器发送断开信号
Cancel = 1
Timer2.Enabled = 1
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer) '禁止用户输入非法IP地址
If KeyAscii < 48 Or KeyAscii > 57 Then
If KeyAscii <> 8 And KeyAscii <> 46 Then KeyAscii = 0
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If Text3.Enabled = False Then Exit Sub
If KeyAscii = 13 Then Call cmdsend_Click
Text3 = Text3 + Chr(KeyAscii)
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call cmdsend_Click
End Sub

Private Sub Timer1_Timer() '从9999端口依次尝试连接服务器
If linkstate = True Then Exit Sub
Winsock1.Close
Winsock1.RemoteHost = Text1.Text
Winsock1.RemotePort = port
Winsock1.Connect
port = port - 1
If port < 9000 Then '设置可供连接的端口上限
Timer1.Enabled = 0
Text1.Enabled = 1
Cmdconnect.Caption = "&Link"
port = 9999
MsgBox "无法连接到服务器,请检查网络连接状况", vbOKOnly + vbCritical, "连接"
End If
End Sub

Private Sub Timer2_Timer() '缓冲以发送断开信号
End
End Sub
Private Sub Winsock1_Connect()
port = port + 1
Timer1.Enabled = 0
linkstate = True
Text3.Enabled = 0
cmdsend.Enabled = 0
MsgBox "已经成功连接", vbOKOnly + vbInformation, "连接"
Text3.Enabled = 1
cmdsend.Enabled = 1
Text3.SetFocus
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim msg As String
Winsock1.GetData msg '接收服务器传来的的数据并进行相应处理
If Left(CStr(msg), 19) = "currentonlineperson" Then
Label4.Caption = "在线人数:" & Str(Val(Mid(CStr(msg), 20, 3)))
msg = Right(CStr(msg), Len(CStr(msg)) - 22)
End If
If CStr(msg) = "closewinsock" Then
Call Cmdconnect_Click
Text2.SelStart = Len(Text2)
Exit Sub
End If
Text2 = Text2 + msg
Text2.SelStart = Len(Text2)
End Sub

报错。。。

谁修复下。。

最佳答案
  • 五星知识达人网友:时间的尘埃
  • 2021-07-25 19:35
你好。
很幸运看到你的问题。
但是又很遗憾到现在还没有人回答你的问题。也可能你现在已经在别的地方找到了答案,那就得恭喜你啦。
可能是你问的问题有些专业了,没人会。或者别人没有遇到或者接触过你的问题,所以帮不了你。建议你去问题的相关论坛去求助,那里的人通常比较多,也比较热心,可能能快点帮你解决问题。
希望我的回答也能够帮到你!
祝你好运~!
我要举报
如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
点此我要举报以上问答信息
大家都在看
推荐资讯