vb6的服务器后端(Frm):
思路是通过for循环检测socket是否空闲，若为空闲则打开监听模式，若所有socket都处于忙碌状态则动态添加新的socket控件，当收到新的消息时，由byte数组转换为unchoice，并进行字符串处理写入服务器的“群聊.txt"中,使用for循环，让已经链接客户端的socket发送txt的内容，
gettext()都是封装在dll的函数可以到底部的gitee项目地址查看
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"
Begin VB.Form Form1
Caption = "基于tcp的即时通讯"
ClientHeight = 6105
ClientLeft = 60
ClientTop = 405
ClientWidth = 7950
LinkTopic = "Form1"
ScaleHeight = 6105
ScaleWidth = 7950
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "生成日志包"
Height = 615
Left = 2760
TabIndex = 1
Top = 5400
Width = 2055
End
Begin VB.Timer Timer2
Interval = 100
Left = 6240
Top = 720
End
Begin VB.Timer Timer1
Interval = 100
Left = 6720
Top = 2280
End
Begin RichTextLib.RichTextBox text1
Height = 4335
Left = 600
TabIndex = 0
Top = 720
Width = 5775
_ExtentX = 10186
_ExtentY = 7646
_Version = 393217
Enabled = -1 'True
TextRTF = $"Form1.frx":0000
End
Begin MSWinsockLib.Winsock Winsock1
Index = 0
Left = 7200
Top = 3360
_ExtentX = 741
_ExtentY = 741
_Version = 393216
LocalPort = 10000
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sockets As Long, socketpeo As Long
Private Sub cl(data1 As String, socknum As Integer)
GETI = Split(data1, "-")
id = Mid(GETI(1), 6)
gid = Mid(GETI(2), 7)
txt = Mid(GETI(3), 6)
Call SetText(App.Path + "\DATA\record\" & gid & ".txt", 3, id & ":" & txt)
End Sub
Private Sub Command1_Click()
Call SetText(App.Path + "\LOG.log", 1, text1.Text)
End Sub
Private Sub text1_Change()
text1.SelStart = Len(text1.Text) - 1
End Sub
Private Sub Timer1_Timer()
If socketpeo > sockets Then
sockets = sockets + 1
Load Winsock1(sockets)
End If
For i = 0 To sockets
If Winsock1(sockets).State <> 7 Then
Winsock1(sockets).Close
Winsock1(sockets).Listen
End If
Next
End Sub
Private Sub Winsock1_Close(Index As Integer)
socketpeo = socketpeo - 1
End Sub
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Winsock1(Index).State <> sckClosed Then
Winsock1(Index).Close
Winsock1(Index).Accept requestID
For i = 0 To sockets
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ":接受请求时的state winscok1(" & Index & ") state=" & Winsock1(Index).State
Next
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前socket服务端数量" & sockets & "客户机数量" & socketpeo
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ":" & requestID & "与服务端进行了连接 socket号:" & Index
socketpeo = socketpeo + 1
End If
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data1(50000000) As String
Dim bb() As Byte
Winsock1(Index).GetData bb()
data1(Index) = StrConv(bb(), vbUnicode)
If Left(data1(Index), 5) = "bind:" Then
Winsock1(Index).Tag = Mid(data1(Index), 6)
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ":接到命令绑定id:" & Winsock1(Index).Tag
Else
Call cl(data1(Index), Index)
End If
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前socket服务端数量" & sockets & "客户机数量" & socketpeo
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前接收到一个客户端socket传来的数据" & data1(1) & "服务器socket号" & Index & "接收的数据:" & data1(Index)
For i = 0 To sockets
If Winsock1(i).State = 7 And Dir(App.Path + "\data\record\" & Winsock1(i).Tag & ".txt") <> "" Then
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & "winsocket(" & i & ") 发送了数据包"
Winsock1(i).SendData (GetText(App.Path + "\data\record\" & Winsock1(i).Tag & ".txt"))
DoEvents
End If
Next
End Sub
Private Sub Winsock1_Error(Index As Integer, 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)
text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前" & Index & "号socket服务出现故障"
Call SetText(App.Path + "\Error.txt", 3, CStr(Date) & CStr(Time) & ":socket号:" & Index & "错误号" & Number & "描述" & Description)
End Sub
Client端(Frm):
login.frm:
这个文件只是简易的登录界面，并确认用户名和群聊号
VERSION 5.00
Begin VB.Form login
BorderStyle = 1 'Fixed Single
Caption = "login"
ClientHeight = 3135
ClientLeft = 45
ClientTop = 390
ClientWidth = 4680
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3135
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "请输入"
Height = 2535
Left = 240
TabIndex = 0
Top = 360
Width = 4335
Begin VB.CommandButton Command2
Caption = "退出"
Height = 375
Left = 2640
TabIndex = 6
Top = 2040
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "登录"
Height = 375
Left = 360
TabIndex = 5
Top = 2040
Width = 1095
End
Begin VB.TextBox Text2
Height = 495
Left = 960
TabIndex = 4
Top = 1200
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Left = 960
TabIndex = 1
Top = 360
Width = 3135
End
Begin VB.Label Label2
Caption = "聊天室号"
Height = 375
Left = 120
TabIndex = 3
Top = 1320
Width = 735
End
Begin VB.Label Label1
Caption = "用户名"
Height = 375
Left = 120
TabIndex = 2
Top = 480
Width = 615
End
End
End
Attribute VB_Name = "login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If TEXT1.Text <> "" And Text2.Text <> "" Then
gid = Text2.Text
username = TEXT1.Text
Me.Hide
chatroom.Show
Else
MsgBox "输入的不能为空", vbInformation, "提示"
End If
End Sub
Private Sub Command2_Click()
End
End Sub
chatroom.frm:
聊天室窗体
这个没啥好说的，发送的数据端格式基本为:-user:用户名-group:群号-text:内容
若发送的数据为bind:群号id 则是让服务器链接客户端的socket的tag为群号的id
接受数据与服务器相似
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"
Begin VB.Form chatroom
BorderStyle = 1 'Fixed Single
Caption = "基于tcp的即时通讯"
ClientHeight = 6450
ClientLeft = 45
ClientTop = 390
ClientWidth = 7950
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6450
ScaleWidth = 7950
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "发送数据"
Height = 1935
Left = 120
TabIndex = 1
Top = 4440
Width = 7695
Begin RichTextLib.RichTextBox TEXT1
Height = 1215
Left = 240
TabIndex = 3
Top = 480
Width = 5895
_ExtentX = 10398
_ExtentY = 2143
_Version = 393217
Appearance = 0
TextRTF = $"chatroom.frx":0000
End
Begin VB.CommandButton Command1
Caption = "发送"
Height = 735
Left = 6240
TabIndex = 2
Top = 720
Width = 1335
End
End
Begin VB.Timer Timer1
Interval = 100
Left = 4080
Top = 2400
End
Begin MSWinsockLib.Winsock Winsock1
Left = 120
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
RemoteHost = "192.168.0.40"
RemotePort = 10000
End
Begin RichTextLib.RichTextBox text3
Height = 3975
Left = 120
TabIndex = 0
Top = 360
Width = 7695
_ExtentX = 13573
_ExtentY = 7011
_Version = 393217
TextRTF = $"chatroom.frx":009D
End
End
Attribute VB_Name = "chatroom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If Winsock1.State = 7 Then
Winsock1.SendData "-user:" & username & "-group:" & gid & "-text:" & TEXT1.Text
TEXT1.Text = ""
DoEvents
Else
choice = MsgBox("连接服务器失败,是否重新连接", vbYesNo, "提示")
If choice = vbYes Then Call Form_Load Else End
End If
End Sub
Private Sub Form_Load()
text3.Locked = True
Winsock1.Close
Winsock1.Connect
End Sub
Private Sub text2_Change()
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Winsock1_Connect()
a = startT
Do While get_time(a) < 7
DoEvents
If Winsock1.State = 7 Then
Winsock1.SendData "bind:" & gid
Exit Do
End If
Loop
If Winsock1.State <> 7 Then
choice = MsgBox("连接服务器失败,是否重连", vbYesNo, "提示")
If choice = vbYes Then Call Form_Load Else End
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim bb() As Byte
Winsock1.GetData bb()
Data1 = StrConv(bb(), vbUnicode)
text3.Text = Data1
End Sub
dll库的源码和使用方法可到gitee项目地址查看
971
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
