关键词搜索

源码搜索 ×
×

纯vb6开发基于tcp通信协议的即时通讯的聊天室

发布2022-07-24浏览1167次

详情内容

 

vb6的服务器后端(Frm):

思路是通过for循环检测socket是否空闲，若为空闲则打开监听模式，若所有socket都处于忙碌状态则动态添加新的socket控件，当收到新的消息时，由byte数组转换为unchoice，并进行字符串处理写入服务器的“群聊.txt"中,使用for循环，让已经链接客户端的socket发送txt的内容，

gettext()都是封装在dll的函数可以到底部的gitee项目地址查看

  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"
  4. Begin VB.Form Form1 
  5.    Caption         =   "基于tcp的即时通讯"
  6.    ClientHeight    =   6105
  7.    ClientLeft      =   60
  8.    ClientTop       =   405
  9.    ClientWidth     =   7950
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   6105
  12.    ScaleWidth      =   7950
  13.    StartUpPosition =   3  '窗口缺省
  14.    Begin VB.CommandButton Command1 
  15.       Caption         =   "生成日志包"
  16.       Height          =   615
  17.       Left            =   2760
  18.       TabIndex        =   1
  19.       Top             =   5400
  20.       Width           =   2055
  21.    End
  22.    Begin VB.Timer Timer2 
  23.       Interval        =   100
  24.       Left            =   6240
  25.       Top             =   720
  26.    End
  27.    Begin VB.Timer Timer1 
  28.       Interval        =   100
  29.       Left            =   6720
  30.       Top             =   2280
  31.    End
  32.    Begin RichTextLib.RichTextBox text1 
  33.       Height          =   4335
  34.       Left            =   600
  35.       TabIndex        =   0
  36.       Top             =   720
  37.       Width           =   5775
  38.       _ExtentX        =   10186
  39.       _ExtentY        =   7646
  40.       _Version        =   393217
  41.       Enabled         =   -1  'True
  42.       TextRTF         =   $"Form1.frx":0000
  43.    End
  44.    Begin MSWinsockLib.Winsock Winsock1 
  45.       Index           =   0
  46.       Left            =   7200
  47.       Top             =   3360
  48.       _ExtentX        =   741
  49.       _ExtentY        =   741
  50.       _Version        =   393216
  51.       LocalPort       =   10000
  52.    End
  53. End
  54. Attribute VB_Name = "Form1"
  55. Attribute VB_GlobalNameSpace = False
  56. Attribute VB_Creatable = False
  57. Attribute VB_PredeclaredId = True
  58. Attribute VB_Exposed = False
  59. Dim sockets As Long, socketpeo As Long
  60.  
  61. Private Sub cl(data1 As String, socknum As Integer)
  62.     GETI = Split(data1, "-")
  63.     id = Mid(GETI(1), 6)
  64.     gid = Mid(GETI(2), 7)
  65.     txt = Mid(GETI(3), 6)
  66.     Call SetText(App.Path + "\DATA\record\" & gid & ".txt", 3, id & ":" & txt)
  67. End Sub
  68.  
  69. Private Sub Command1_Click()
  70.     Call SetText(App.Path + "\LOG.log", 1, text1.Text)
  71. End Sub
  72.  
  73. Private Sub text1_Change()
  74.     text1.SelStart = Len(text1.Text) - 1
  75. End Sub
  76.  
  77. Private Sub Timer1_Timer()
  78.     If socketpeo > sockets Then
  79.         sockets = sockets + 1
  80.         Load Winsock1(sockets)
  81.     End If
  82.      For i = 0 To sockets
  83.         If Winsock1(sockets).State <> 7 Then
  84.             Winsock1(sockets).Close
  85.             Winsock1(sockets).Listen
  86.         End If
  87.     Next
  88. End Sub
  89.  
  90. Private Sub Winsock1_Close(Index As Integer)
  91.     socketpeo = socketpeo - 1
  92. End Sub
  93.  
  94.  
  95.  
  96. Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  97.      If Winsock1(Index).State <> sckClosed Then
  98.             Winsock1(Index).Close
  99.             Winsock1(Index).Accept requestID
  100.              For i = 0 To sockets
  101.                  text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ":接受请求时的state winscok1(" & Index & ") state=" & Winsock1(Index).State
  102.              Next
  103.              text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前socket服务端数量" & sockets & "客户机数量" & socketpeo
  104.             text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ":" & requestID & "与服务端进行了连接 socket号:" & Index
  105.             socketpeo = socketpeo + 1
  106.        End If
  107. End Sub
  108.  
  109. Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  110.         Dim data1(50000000) As String
  111.         Dim bb() As Byte
  112.         Winsock1(Index).GetData bb()
  113.         data1(Index) = StrConv(bb(), vbUnicode)
  114.         If Left(data1(Index), 5) = "bind:" Then
  115.             Winsock1(Index).Tag = Mid(data1(Index), 6)
  116.             text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ":接到命令绑定id:" & Winsock1(Index).Tag
  117.         Else
  118.             Call cl(data1(Index), Index)
  119.         End If
  120.         text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前socket服务端数量" & sockets & "客户机数量" & socketpeo
  121.         text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前接收到一个客户端socket传来的数据" & data1(1) & "服务器socket号" & Index & "接收的数据:" & data1(Index)
  122.       For i = 0 To sockets
  123.         If Winsock1(i).State = 7 And Dir(App.Path + "\data\record\" & Winsock1(i).Tag & ".txt") <> "" Then
  124.             text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & "winsocket(" & i & ") 发送了数据包"
  125.             Winsock1(i).SendData (GetText(App.Path + "\data\record\" & Winsock1(i).Tag & ".txt"))
  126.             DoEvents
  127.         End If
  128.     Next
  129. End Sub
  130.  
  131. 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)
  132.      text1.Text = text1.Text & vbCrLf & CStr(Date) & CStr(Time) & ": 当前" & Index & "号socket服务出现故障"
  133.      Call SetText(App.Path + "\Error.txt", 3, CStr(Date) & CStr(Time) & ":socket号:" & Index & "错误号" & Number & "描述" & Description)
  134. End Sub
  135.

Client端(Frm):

login.frm:

这个文件只是简易的登录界面，并确认用户名和群聊号

  1. VERSION 5.00
  2. Begin VB.Form login 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "login"
  5.    ClientHeight    =   3135
  6.    ClientLeft      =   45
  7.    ClientTop       =   390
  8.    ClientWidth     =   4680
  9.    LinkTopic       =   "Form2"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   3135
  13.    ScaleWidth      =   4680
  14.    StartUpPosition =   3  '窗口缺省
  15.    Begin VB.Frame Frame1 
  16.       Caption         =   "请输入"
  17.       Height          =   2535
  18.       Left            =   240
  19.       TabIndex        =   0
  20.       Top             =   360
  21.       Width           =   4335
  22.       Begin VB.CommandButton Command2 
  23.          Caption         =   "退出"
  24.          Height          =   375
  25.          Left            =   2640
  26.          TabIndex        =   6
  27.          Top             =   2040
  28.          Width           =   1095
  29.       End
  30.       Begin VB.CommandButton Command1 
  31.          Caption         =   "登录"
  32.          Height          =   375
  33.          Left            =   360
  34.          TabIndex        =   5
  35.          Top             =   2040
  36.          Width           =   1095
  37.       End
  38.       Begin VB.TextBox Text2 
  39.          Height          =   495
  40.          Left            =   960
  41.          TabIndex        =   4
  42.          Top             =   1200
  43.          Width           =   3135
  44.       End
  45.       Begin VB.TextBox Text1 
  46.          Height          =   495
  47.          Left            =   960
  48.          TabIndex        =   1
  49.          Top             =   360
  50.          Width           =   3135
  51.       End
  52.       Begin VB.Label Label2 
  53.          Caption         =   "聊天室号"
  54.          Height          =   375
  55.          Left            =   120
  56.          TabIndex        =   3
  57.          Top             =   1320
  58.          Width           =   735
  59.       End
  60.       Begin VB.Label Label1 
  61.          Caption         =   "用户名"
  62.          Height          =   375
  63.          Left            =   120
  64.          TabIndex        =   2
  65.          Top             =   480
  66.          Width           =   615
  67.       End
  68.    End
  69. End
  70. Attribute VB_Name = "login"
  71. Attribute VB_GlobalNameSpace = False
  72. Attribute VB_Creatable = False
  73. Attribute VB_PredeclaredId = True
  74. Attribute VB_Exposed = False
  75.  
  76. Private Sub Command1_Click()
  77.         If TEXT1.Text <> "" And Text2.Text <> "" Then
  78.             gid = Text2.Text
  79.             username = TEXT1.Text
  80.             Me.Hide
  81.             chatroom.Show
  82.         Else
  83.             MsgBox "输入的不能为空", vbInformation, "提示"
  84.         End If
  85. End Sub
  86.  
  87. Private Sub Command2_Click()
  88.     End
  89. End Sub

chatroom.frm:

聊天室窗体

这个没啥好说的，发送的数据端格式基本为:-user:用户名-group:群号-text:内容

若发送的数据为bind:群号id 则是让服务器链接客户端的socket的tag为群号的id

接受数据与服务器相似

  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"
  4. Begin VB.Form chatroom 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "基于tcp的即时通讯"
  7.    ClientHeight    =   6450
  8.    ClientLeft      =   45
  9.    ClientTop       =   390
  10.    ClientWidth     =   7950
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   6450
  15.    ScaleWidth      =   7950
  16.    StartUpPosition =   3  '窗口缺省
  17.    Begin VB.Frame Frame1 
  18.       Caption         =   "发送数据"
  19.       Height          =   1935
  20.       Left            =   120
  21.       TabIndex        =   1
  22.       Top             =   4440
  23.       Width           =   7695
  24.       Begin RichTextLib.RichTextBox TEXT1 
  25.          Height          =   1215
  26.          Left            =   240
  27.          TabIndex        =   3
  28.          Top             =   480
  29.          Width           =   5895
  30.          _ExtentX        =   10398
  31.          _ExtentY        =   2143
  32.          _Version        =   393217
  33.          Appearance      =   0
  34.          TextRTF         =   $"chatroom.frx":0000
  35.       End
  36.       Begin VB.CommandButton Command1 
  37.          Caption         =   "发送"
  38.          Height          =   735
  39.          Left            =   6240
  40.          TabIndex        =   2
  41.          Top             =   720
  42.          Width           =   1335
  43.       End
  44.    End
  45.    Begin VB.Timer Timer1 
  46.       Interval        =   100
  47.       Left            =   4080
  48.       Top             =   2400
  49.    End
  50.    Begin MSWinsockLib.Winsock Winsock1 
  51.       Left            =   120
  52.       Top             =   120
  53.       _ExtentX        =   741
  54.       _ExtentY        =   741
  55.       _Version        =   393216
  56.       RemoteHost      =   "192.168.0.40"
  57.       RemotePort      =   10000
  58.    End
  59.    Begin RichTextLib.RichTextBox text3 
  60.       Height          =   3975
  61.       Left            =   120
  62.       TabIndex        =   0
  63.       Top             =   360
  64.       Width           =   7695
  65.       _ExtentX        =   13573
  66.       _ExtentY        =   7011
  67.       _Version        =   393217
  68.       TextRTF         =   $"chatroom.frx":009D
  69.    End
  70. End
  71. Attribute VB_Name = "chatroom"
  72. Attribute VB_GlobalNameSpace = False
  73. Attribute VB_Creatable = False
  74. Attribute VB_PredeclaredId = True
  75. Attribute VB_Exposed = False
  76.  
  77.  
  78. Private Sub Command1_Click()
  79.     If Winsock1.State = 7 Then
  80.         Winsock1.SendData "-user:" & username & "-group:" & gid & "-text:" & TEXT1.Text
  81.         TEXT1.Text = ""
  82.         DoEvents
  83.     Else
  84.          choice = MsgBox("连接服务器失败,是否重新连接", vbYesNo, "提示")
  85.          If choice = vbYes Then Call Form_Load Else End
  86.     End If
  87. End Sub
  88.  
  89. Private Sub Form_Load()
  90.     text3.Locked = True
  91.     Winsock1.Close
  92.     Winsock1.Connect
  93. End Sub
  94.  
  95. Private Sub text2_Change()
  96.  
  97. End Sub
  98.  
  99. Private Sub Form_Unload(Cancel As Integer)
  100.     End
  101. End Sub
  102.  
  103. Private Sub Winsock1_Connect()
  104.     a = startT
  105.     Do While get_time(a) < 7
  106.         DoEvents
  107.         
  108.         If Winsock1.State = 7 Then
  109.             Winsock1.SendData "bind:" & gid
  110.             Exit Do
  111.         End If
  112.     Loop
  113.     If Winsock1.State <> 7 Then
  114.          choice = MsgBox("连接服务器失败,是否重连", vbYesNo, "提示")
  115.          If choice = vbYes Then Call Form_Load Else End
  116.     End If
  117. End Sub
  118.  
  119. Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  120.     Dim bb() As Byte
  121.     Winsock1.GetData bb()
  122.     Data1 = StrConv(bb(), vbUnicode)
  123.     text3.Text = Data1
  124. End Sub
  125.

dll库的源码和使用方法可到gitee项目地址查看

相关技术文章

最新源码

下载排行榜
点击QQ咨询
开通会员
返回顶部
×
微信扫码支付 元
微信扫码支付
确定支付下载
请使用微信描二维码支付
×

提示信息

×

选择支付方式

  • 微信支付
  • 支付宝付款
确定支付下载