用vb编写websocket客户端示例（每秒百万弹幕吞吐量）
2024-05-18 16:38:06
《websocket协议详解》教程分三篇：
- 什么是websocket
- websocket协议规范
- 用vb编写websocket客户端示例（每秒百万弹幕吞吐量）
文章上方有详细的规范、源码链接，你有任何问题可以联系我：邮箱：952125505@qq.com ，QQ交流群：715895604
根据前面两节讲解，我们了解了websocket是做什么，并详细的了解了websocket的协议规范，下面我们就用vb制作一个websocket控件。
首先打开vb,建立一个自定义控件,命名为WebSock
Option Explicit'★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★ 。。
'│ 。。。。 │
'☆ 。。 。。 ☆
'│ 。。 。。 │
'★ 。。 。。 ★
'│ 。。 。。 │
'☆ 。。 。。 ☆
'│ 。。 OOO 。。 │
'★ 。。 QQQQQQQ 。。 ★
'│ 。。 88888888888 。。 │
'☆ 。。 8 。 8 。。 ☆
'│ 。。 H - - H 。。 . │
'★ 。。 0│ │0 。。 ★
'│ 。。 │ ╰-╯ │ 。。 . │
'☆ 。。 ╰-------╯ 。。 . ☆
'│ 。。 。。。 。。 . │
'★ 。。╭ ╮。。 . ★
'│ ╭ ╰ ╯ ╮ . │
'☆ ╭ ╰ ╯ ╮ . ☆
'│ ╭ ╰ ╯ ╮ . │
'★ ( ╰ v╯ ) . ★
'│ ╭ ╮ . │
'☆ ╭ ╮ . ☆
'│ ( ) . │
'★ (。)(。)(。)(。)(。)(。)(。)(。) . ★
'│ (。)(。)(。)(。)(。)(。)(。)(。)(。) . │
'☆ [0][0][0][0][0][0][0][0][0][0][0][0][0] . ☆
'│ [0][0][0][0][0][0][0][0][0][0][0][0][0] │
'★ . ★
'│ ******************************************************* │
'☆ 佛祖保佑 永无BUG ☆
'│ │
'★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★─☆─★
'****************************************************************************************'* 模块名称： 二郎websocket完美客户端'* 功能描述：'****************************************************************************************
'创建：2019-09-01；作 者：二郎666 QQ：952125505；版本：Version 1.0.1（2019-09-01） . .'连接参数
Private Type urlTypeurl As StringProc As StringHost As StringPort As StringPath As StringHeader As StringwsKey As StringAccept As StringEnd Type'基本帧协议
Private Type abnfTypeFIN As BooleanRSV1 As BooleanRSV2 As BooleanRSV3 As BooleanOPCode As LongFrameCode As LongMaskBool As BooleanMaskKey() As ByteDataLenL As LongDataLenS As LongDataStart As LongDataByte() As ByteALen As LongEnd Type'websocket状态
Enum stateEnumoff = 0onConnect = 1Busy = 2End EnumEnum opcodeEnumopContin = 0opText = 1opBinary = 2'3 - 7 非控制帧保留opclose = 8opping = 9oppong = 10'11-15 控制帧保留End EnumPublic Enum opMsgenummsgContin = 0msgtext = 1msgBinary = 2End EnumPrivate Declare Function timeGetTime Lib "winmm.dll" () As LongPrivate Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Const CP_UTF8 = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As LongPrivate Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As LongPrivate Declare Function send Lib "ws2_32.DLL" (ByVal socket As Long, Buf As Any, ByVal buflen As Long, ByVal Flags As Long) As LongPrivate Const wsGUID = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"Private SendUrl As urlTypePrivate OPCode As opcodeEnumPrivate ABNF As abnfTypeDim isConnect As Boolean'缺省属性值:
Private Const m_def_State = 0'属性变量:
Dim m_State As stateEnum'事件声明:
Event OnMessage(ByVal RecvData As Variant, ByVal GetMsg As Long, sFIN As Boolean)Event OnOpen()Event OnClose()Event SendComplete()Event OnError(Number As Long, Str As String)
'
'
'
'
Public Sub Connect(ByVal url As String)m_State = onConnectIf Winsock1.State <> 0 ThenWinsock1.CloseSleep2 10End IfSendUrl = jiexiUrl(url)Winsock1.Connect SendUrl.Host, SendUrl.Port'
End SubPrivate Sub Winsock1_Connect()isConnect = TrueCall GetHeadersWinsock1.SendData (SendUrl.Header)End SubPrivate Sub Winsock1_SendComplete()RaiseEvent SendCompleteIf m_State = Busy Then m_State = onConnectEnd SubPublic Sub OnClose()Dim B(1) As Byte, tempStart As Stringm_State = BusyB(0) = &H88B(1) = &H0send Winsock1.SocketHandle, B(0), 2, 0If Winsock1.State <> 0 ThenWinsock1.CloseSleep2 10End Ifm_State = offRaiseEvent OnCloseEnd SubPrivate Sub Winsock1_Close()m_State = offRaiseEvent OnCloseEnd SubPrivate Sub Winsock1_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)RaiseEvent OnError(3000, "Winsock错误描述：" & Description)End Sub'注意！不要删除或修改下列被注释的行！
'MemberInfo=22,1,1,0
Public Property Get State() As stateEnumState = m_State
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=Winsock1,Winsock1,-1,LocalHostName
Public Property Get LocalHostName() As StringLocalHostName = Winsock1.LocalHostName
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=Winsock1,Winsock1,-1,LocalIP
Public Property Get LocalIP() As StringLocalIP = Winsock1.LocalIP
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=Winsock1,Winsock1,-1,LocalPort
Public Property Get LocalPort() As LongLocalPort = Winsock1.LocalPort
End PropertyPublic Property Let LocalPort(ByVal New_LocalPort As Long)Winsock1.LocalPort() = New_LocalPortPropertyChanged "LocalPort"
End Property'为用户控件初始化属性
Private Sub UserControl_InitProperties()m_State = m_def_StateSendUrl.wsKey = Base64Encode(RandB(16))End Sub
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)Winsock1.LocalPort = PropBag.ReadProperty("LocalPort", 0)
End Sub
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)Call PropBag.WriteProperty("LocalPort", Winsock1.LocalPort, 0)
End Sub
Public Sub SendData(ByRef SendMsg As Variant, Optional opMsg As Long, Optional FinB As Boolean = True) '/byt数组么Dim I As Long, L As Long, byt1() As Byte, byt2() As Byte, Byt3() As Byte, S As String, tempB() As Byte, ABMaskKey() As ByteIf TypeName(SendMsg) = "Byte()" ThenIf opMsg = msgtext ThenRaiseEvent OnError(3009, "sendMsg与opMsg冲突")Exit SubEnd IftempB = SendMsgElseIf opMsg = msgBinary ThenRaiseEvent OnError(3009, "sendMsg与opMsg冲突")Exit SubEnd IftempB = UTF8Encode(CStr(SendMsg))End IfIf SafeArrayGetDim(tempB) <= 0 ThenRaiseEvent OnError(3001, "没检测到发送数据")Exit SubEnd IfABMaskKey = RandB(4)AddMask tempB, ABMaskKeym_State = BusyL = UBound(tempB) + 1If L < 126 ThenReDim byt1(L + 5)byt1(0) = &H80 Xor CByte(opMsg)byt1(1) = CByte(L) Xor &H80CopyMemory byt1(2), ABMaskKey(0), 4CopyMemory byt1(6), tempB(0), LElseIf L >= 126 And L <= 65535 ThenReDim byt1(L + 7)byt1(0) = &H80 Xor CByte(opMsg)byt1(1) = &HFES = Right("0000" & Hex(L), 4)byt1(2) = CLng("&h" & Left(S, 2))byt1(3) = CLng("&h" & Right(S, 2))CopyMemory byt1(4), ABMaskKey(0), 4CopyMemory byt1(8), tempB(0), LElseIf Str(L) > 65535 ThenRaiseEvent OnError(3002, "发送数据长度超过限制，>65535")m_State = onConnectExit SubEnd Ifsend Winsock1.SocketHandle, byt1(0), UBound(byt1) + 1, 0m_State = onConnectEnd SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)Dim GetMsg() As Byte, S1 As String, S2 As String, S3 As String, I As LongStatic GetData() As ByteStatic ALen As LongWinsock1.GetData GetMsg, vbByteIf isConnect = True ThenS1 = "HTTP/1.1 101"S2 = ToUnicodeStr(GetMsg)If InStr(S2, S1) > 0 ThenisConnect = FalseSendUrl.Accept = BASE64SHA1(SendUrl.wsKey & wsGUID, True)S3 = MidStr(S2, "Sec-WebSocket-Accept:", Chr(13) & Chr(10))If Trim(S3) <> SendUrl.Accept ThenRaiseEvent OnError(3003, "服务器未通过客户端验证，返回:" & S2)End Ifm_State = onConnectALen = 0RaiseEvent OnOpen'Call sendPong(20)ElseRaiseEvent OnError(3004, "连接握手错误：" & S2)Call OnCloseEnd IfExit SubEnd IfAA:If ALen = 0 ThenCall SSRP_ABNF(GetMsg)Erase GetDataGetData = GetMsgALen = UBound(GetMsg) + 1ElseReDim Preserve GetData(ALen + UBound(GetMsg))CopyMemory GetData(ALen), GetMsg(0), UBound(GetMsg) + 1ALen = ALen + UBound(GetMsg) + 1End IfIf ALen < ABNF.ALen Then Exit SubIf ABNF.DataLenL > 0 ThenReDim Preserve ABNF.DataByte(ABNF.DataLenL - 1)CopyMemory ABNF.DataByte(0), GetData(ABNF.DataStart), ABNF.DataLenLEnd IfSelect Case ABNF.OPCodeCase 8RaiseEvent OnError(3005, "服务器关闭连接，关闭代码：" & ToUnicodeStr(ABNF.DataByte))Call OnCloseExit SubCase 9Dim P() As ByteReDim Preserve P(6 + ABNF.DataLenL - 1)P(0) = &H8AP(1) = (CByte(ABNF.DataLenL) Or &H80)Dim ABMaskKey() As ByteABMaskKey = RandB(4)CopyMemory P(2), ABMaskKey(0), 4If ABNF.DataLenL > 0 ThenAddMask ABNF.DataByte, ABMaskKeyCopyMemory P(6), ABNF.DataByte(0), ABNF.DataLenLEnd Ifsend Winsock1.SocketHandle, P(0), UBound(P) + 1, 0Case 10Case ElseIf ABNF.DataLenL > 0 ThenIf ABNF.FrameCode = 1 ThenRaiseEvent OnMessage(ToUnicodeStr(ABNF.DataByte), ABNF.FrameCode, ABNF.FIN)ElseRaiseEvent OnMessage(ABNF.DataByte, ABNF.FrameCode, ABNF.FIN)End IfEnd IfEnd SelectIf ABNF.DataLenL > 0 Then Erase ABNF.DataByteALen = ALen - ABNF.ALenIf ALen > 0 ThenReDim Preserve GetMsg(ALen - 1)CopyMemory GetMsg(0), GetData(ABNF.ALen), ALenALen = 0GoTo AAEnd IfALen = 0End SubPrivate Sub SSRP_ABNF(Byt() As Byte)Dim I As Long, L As IntegerABNF.FIN = IIf((Byt(0) And &H80) = &H80, True, False)ABNF.RSV1 = IIf((Byt(0) And &H40) = &H40, True, False)ABNF.RSV2 = IIf((Byt(0) And &H20) = &H20, True, False)ABNF.RSV3 = IIf((Byt(0) And &H10) = &H10, True, False)ABNF.OPCode = Byt(0) And &H7FIf ABNF.OPCode > 0 And ABNF.OPCode <> 8 And ABNF.OPCode <> 9 And ABNF.OPCode <> 10 Then ABNF.FrameCode = CLng(ABNF.OPCode)If UBound(Byt) < 1 ThenABNF.DataStart = 0ABNF.DataLenL = 0ABNF.MaskBool = FalseExit SubEnd IfABNF.MaskBool = IIf((Byt(1) And &H80) = &H80, True, False)L = Byt(1) And &H7FIf ABNF.MaskBool = False ThenIf L < 126 ThenABNF.DataLenL = LABNF.DataStart = 2ABNF.ALen = ABNF.DataStart + ABNF.DataLenLElseIf L = 126 ThenIf UBound(Byt) >= 3 ThenABNF.DataLenL = (Byt(2) * &H100) + Byt(3)ElseABNF.DataLenL = (Byt(2) * &H100)End IfABNF.DataStart = 4ABNF.ALen = ABNF.DataStart + ABNF.DataLenLElseIf L = 127 ThenABNF.DataLenL = -1ABNF.DataStart = 10Dim HexN As StringFor I = 2 To 9If UBound(Byt) >= I ThenHexN = HexN & Right("00" & Hex(Byt(I)), 2)ElseExit SubEnd IfNextABNF.ALen = -1ABNF.DataLenS = Hex2Dec(HexN)End IfEnd IfEnd SubPrivate Sub sendPong(t As Long)Dim TimerNum As Long, P(5) As ByteP(0) = &H8AP(1) = &H80Dim ABMaskKey() As ByteABMaskKey = RandB(4)CopyMemory P(2), ABMaskKey(0), 4On Error Resume NextDo Until Winsock1.State = 0TimerNum = TimerNum + 1Sleep2 10If TimerNum >= t Thensend Winsock1.SocketHandle, P(0), 6, 0TimerNum = 0End IfSleep2 (1000)LoopEnd SubPrivate Sub AddMask(DataB() As Byte, TKey() As Byte)Dim I As LongFor I = 0 To UBound(DataB)DataB(I) = DataB(I) Xor TKey(I Mod 4)Next'AddMask = DataBEnd SubPrivate Function MidStr(Str1 As String, S1 As String, S2 As String) As StringDim N1 As Long, N2 As LongOn Error Resume NextN1 = InStrB(Str1, S1) + LenB(S1)N2 = InStrB(N1, Str1, S2)MidStr = MidB(Str1, N1, N2 - N1)If Err <> 0 ThenMidStr = ""Err.ClearDebug.Print "截取字符串失败：" & S1 & vbCrLf & Str1End IfEnd FunctionPrivate Function RandB(N As Long) As Byte()Dim I As Long, tempB() As ByteReDim tempB(N - 1)RandomizeFor I = 0 To N - 1tempB(I) = CByte(Rnd * 127 + 1)NextRandB = tempBEnd FunctionPrivate Function Sleep2(t As Long)Dim Savetime As LongSavetime = timeGetTimeWhile timeGetTime < Savetime + tDoEventsWendEnd FunctionPublic Function BASE64SHA1(ByVal sTextToHash As String, Optional IsB64 As Boolean = False)Dim Asc As Object, Enc As Object, TextToHash() As Byte, SharedSecretKey() As Byte, ByteS() As ByteConst cutoff As Integer = 5Set Asc = CreateObject("System.Text.UTF8Encoding")'Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")Set Enc = CreateObject("System.Security.Cryptography.SHA1Managed")TextToHash = Asc.Getbytes_4(sTextToHash)'SharedSecretKey = asc.GetBytes_4(sTextToHash)'enc.Key = SharedSecretKeyByteS = Enc.ComputeHash_2((TextToHash))If IsB64 = True ThenBASE64SHA1 = Base64Encode(ByteS)ElseBASE64SHA1 = CStr(ByteS) '//End IfSet Asc = NothingSet Enc = NothingEnd FunctionPrivate Function Base64Encode(Str() As Byte) As StringOn Error Resume NextDim Buf() As Byte, length As Long, mods As Long, TempS As StringConst B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="mods = (UBound(Str) + 1) Mod 3length = UBound(Str) + 1 - modsReDim Preserve Buf(length / 3 * 4 + IIf(mods <> 0, 4, 0) - 1)Dim I As LongFor I = 0 To length - 1 Step 3Buf(I / 3 * 4) = (Str(I) And &HFC) / &H4Buf(I / 3 * 4 + 1) = (Str(I) And &H3) * &H10 + (Str(I + 1) And &HF0) / &H10Buf(I / 3 * 4 + 2) = (Str(I + 1) And &HF) * &H4 + (Str(I + 2) And &HC0) / &H40Buf(I / 3 * 4 + 3) = Str(I + 2) And &H3FNextIf mods = 1 ThenBuf(length / 3 * 4) = (Str(length) And &HFC) / &H4Buf(length / 3 * 4 + 1) = (Str(length) And &H3) * &H10Buf(length / 3 * 4 + 2) = 64Buf(length / 3 * 4 + 3) = 64ElseIf mods = 2 ThenBuf(length / 3 * 4) = (Str(length) And &HFC) / &H4Buf(length / 3 * 4 + 1) = (Str(length) And &H3) * &H10 + (Str(length + 1) And &HF0) / &H10Buf(length / 3 * 4 + 2) = (Str(length + 1) And &HF) * &H4Buf(length / 3 * 4 + 3) = 64End IfFor I = 0 To UBound(Buf)TempS = TempS + Mid(B64_CHAR_DICT, Buf(I) + 1, 1)NextBase64Encode = TempSEnd FunctionPrivate Function Hex2Dec(H As String) As StringDim a As Long, C As LongDim I As Long, N As LongDim j As Long, K As LongH = Kill0(H)N = (Len(H) - 1) \ 4 + 1ReDim B(N) As LongReDim d(Int(N * 1.20412 + 1)) As Long'j = Len(H) + 1For I = 1 To Nj = j - 4If j < 1 ThenB(I) = Val("&H" + Mid(H, 1, 3 + j))ElseB(I) = Val("&H" + Mid(H, j, 4) + "&")End IfNext I'j = N: K = 0Do Until j = 0C = 0For I = j To 1 Step -1a = C * 65536 + B(I)B(I) = a \ 10000C = a Mod 10000Next Id(K) = C: K = K + 1If B(j) = 0 Then j = j - 1LoopK = K - 1ReDim Preserve d(K)'Hex2Dec = CStr(d(K))For I = K - 1 To 0 Step -1Hex2Dec = Hex2Dec + Right("000" + CStr(d(I)), 4)Next IEnd FunctionPrivate Function ToUnicodeByt(ByRef Utf() As Byte) As Byte()Dim lret As Long, lLength As Long, lBufferSize As Long, BT() As BytelLength = UBound(Utf) + 1If lLength <= 0 Then Exit FunctionlBufferSize = lLength * 2 - 1ReDim Preserve BT(lBufferSize)lret = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, VarPtr(BT(0)), lBufferSize + 1)If lret <> 0 ThenReDim Preserve BT(lret - 1)ToUnicodeByt = BTEnd IfEnd FunctionPrivate Function ToUnicodeStr(ByRef Utf() As Byte) As StringDim lret As Long, lLength As Long, lBufferSize As LongOn Error GoTo errline:lLength = UBound(Utf) + 1If lLength <= 0 Then Exit FunctionlBufferSize = lLength * 2ToUnicodeStr = String$(lBufferSize, Chr(0))lret = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(ToUnicodeStr), lBufferSize)If lret <> 0 ThenToUnicodeStr = Left(ToUnicodeStr, lret)End IfExit Functionerrline:ToUnicodeStr = ""End FunctionPrivate Function UTF8Encode(ByVal strUnicode As String, Optional ByVal CodePage As Long = 65001) As Byte()Dim TLen As Long, lngBufferSize As Long, lngResult As Long, Arr() As Byte, I As IntegerTLen = Len(strUnicode)If TLen = 0 Then Exit FunctionlngBufferSize = TLen * 3 + 1ReDim Arr(lngBufferSize - 1)lngResult = WideCharToMultiByte(CodePage, 0, StrPtr(strUnicode), TLen, Arr(0), lngBufferSize, vbNullString, 0)If lngResult ThenlngResult = lngResult - 1ReDim Preserve Arr(lngResult)UTF8Encode = ArrEnd IfEnd FunctionPrivate Function Url编码(url As String) As StringDim obj As Object, Code As String, S As StringDim TValue As Stringurl = Replace(Replace(Replace(Replace(Replace(Replace(Replace(url, "\", "\\"), """", "\"""), Chr(8), "\b"), Chr(12), "\f"), Chr(10), "\n"), Chr(13), "\r"), Chr(9), "\t")Code = "function urlbm(s){ return encodeURI(s);}" & "urlbm('" & url & "');"Set obj = CreateObject("MSScriptControl.ScriptControl")obj.Language = "JavaScript"S = obj.Eval(Code)Url编码 = SSet obj = NothingEnd FunctionPrivate Function IsUTF8(ByteS() As Byte) As BooleanOn Error GoTo CuoWuDim I As Long, AscN As Long, length As Longlength = UBound(ByteS) + 1If length < 3 ThenIsUTF8 = FalseExit FunctionElseIf ByteS(0) = &HEF And ByteS(1) = &HBB And ByteS(2) = &HBF ThenIsUTF8 = TrueExit FunctionEnd IfDo While I <= length - 1If ByteS(I) < 128 ThenI = I + 1AscN = AscN + 1ElseIf (ByteS(I) And &HE0) = &HC0 And (ByteS(I + 1) And &HC0) = &H80 ThenI = I + 2ElseIf I + 2 < length ThenIf (ByteS(I) And &HF0) = &HE0 And (ByteS(I + 1) And &HC0) = &H80 And (ByteS(I + 2) And &HC0) = &H80 ThenI = I + 3ElseIsUTF8 = FalseExit FunctionEnd IfElseIsUTF8 = FalseExit FunctionEnd IfLoopIf AscN = length ThenIsUTF8 = FalseElseIsUTF8 = TrueEnd IfExit FunctionCuoWu:IsUTF8 = FalseEnd FunctionPrivate Function GetErr(Num As Long) As StringDim S As StringSelect Case NumCase 1000S = "正常关闭; 无论为何目的而创建, 该链接都已成功完成任务"Case 1001S = "终端离开, 可能因为服务端错误, 也可能因为浏览器正从打开连接的页面跳转离开"Case 1002S = "由于协议错误而中断连接"Case 1003S = "由于接收到不允许的数据类型而断开连接 (如仅接收文本数据的终端接收到了二进制数据)。"Case 1004S = "保留。 其意义可能会在未来定义。"Case 1005S = "保留。 表示没有收到预期的状态码。"Case 1006S = "保留。 用于期望收到状态码时连接非正常关闭 (也就是说, 没有发送关闭帧)。"Case 1007S = "由于收到了格式不符的数据而断开连接 (如文本消息中包含了非 UTF-8 数据)。"Case 1008S = "由于收到不符合约定的数据而断开连接。 这是一个通用状态码, 用于不适合使用 1003 和 1009 状态码的场景。"Case 1009S = "由于收到过大的数据帧而断开连接"Case 1010S = "客户端由于遇到没有预料的情况阻止其完成请求, 因此服务端断开连接。"Case 1012S = "服务器由于重启而断开连接。"Case 1013S = "服务器由于临时原因断开连接, 如服务器过载因此断开一部分客户端连接。"Case 1014S = "标准保留以便未来使用。"Case 1015S = "保留。 表示连接由于无法完成 TLS 握手而关闭 (例如无法验证服务器证书)。"End SelectGetErr = SEnd FunctionPrivate Function jiexiUrl(url As String) As urlTypeDim RegExp As Object, tempUrl As StringtempUrl = urltempUrl = Replace(tempUrl, "/#", "%23")If Not (LCase(tempUrl) Like "wss://*" Or LCase(tempUrl) Like "ws://*" Or LCase(tempUrl) Like "https://*" Or LCase(tempUrl) Like "http://*") ThentempUrl = "http://" & tempUrlEnd IfSet RegExp = CreateObject("vbscript.regexp")RegExp.Global = TrueRegExp.Pattern = "(https?|http|wss|ws)://[-A-Za-z0-9+&@#/%?=~_|!:,.;]+[-A-Za-z0-9+&@#/%=~_|]"If (RegExp.Test(tempUrl)) = True ThenRegExp.Pattern = "(?:([^:/?#]+):)?(?://([^/:?#]*))?(?:\:(\d*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?"'RegExp.Pattern = "(\w+)://([^/:]+):(\d*)?([^# ]*)"Dim S As StringjiexiUrl.Proc = RegExp.Replace(tempUrl, "$1")S = jiexiUrl.Proc & "://"jiexiUrl.Host = RegExp.Replace(tempUrl, "$2")S = S & jiexiUrl.HostjiexiUrl.Port = RegExp.Replace(tempUrl, "$3")If Len(jiexiUrl.Port) > 0 ThenS = S & ":" & jiexiUrl.PortElsejiexiUrl.Port = "-1"End IfIf CLng(jiexiUrl.Port) < 0 Or CLng(jiexiUrl.Port) > 65535 ThenIf LCase(jiexiUrl.Proc) = "https" Or LCase(jiexiUrl.Proc) = "wss" ThenjiexiUrl.Port = "443"ElsejiexiUrl.Port = "80"End IfEnd IfS = Replace(tempUrl, S, "")jiexiUrl.Path = SIf Len(jiexiUrl.Path) = 0 Then jiexiUrl.Path = "/"jiexiUrl.url = tempUrlElseRaiseEvent OnError(3007, "描述：Url地址格式错误")'1009 表示端点因接收到的消息对它的处理来说太大而终止连接。Call OnCloseEnd IfSet RegExp = NothingEnd FunctionPrivate Sub GetHeaders()Dim Str As StringStr = "GET " & SendUrl.Path & " HTTP/1.1" & vbCrLfStr = Str & "Upgrade: WebSocket" & vbCrLfStr = Str & "Connection: Upgrade" & vbCrLfStr = Str & "Host: " & SendUrl.Host & vbCrLfStr = Str & "Origin: " & Winsock1.LocalIP & vbCrLfStr = Str & "Pragma: no -cache" & vbCrLfStr = Str & "cache -Control: no -cache" & vbCrLfStr = Str & "Sec-WebSocket-Key: " & SendUrl.wsKey & vbCrLfStr = Str & "Sec-WebSocket-Version: 13" & vbCrLfStr = Str & "Sec -WebSocket - Extensions: x -webkit - deflate - Frame;permessage-deflate; client_max_window_bits" & vbCrLfStr = Str & "User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/69.0.2171.99 Safari/537.36" & vbCrLf & vbCrLfSendUrl.Header = StrEnd Sub第二步新建一个窗体，添加WebSock控件，命名WebSocket1。添加三个按钮，分别命名cmdConn，cmdSend,Command1
Private Sub Showlog(Str As String)If Len(txtLog.Text) > 15000 Then txtLog.Text = ""txtLog.Text = txtLog.Text & Time & " " & Str & vbCrLftxtLog.SelStart = Len(txtLog.Text)
End SubPrivate Sub cmdConn_Click()WebSocket1.Connect txtUrl.TextEnd SubPrivate Sub cmdSend_Click()WebSocket1.SendData txtSend.Text, 1, True
End SubPrivate Sub Command1_Click()WebSocket1.OnClose
End SubPrivate Sub Form_Load()End SubPrivate Sub WebSocket1_OnClose()Showlog "已经关闭"
End SubPrivate Sub WebSocket1_OnError(Number As Long, Str As String)Showlog Number & Str
End SubPrivate Sub WebSocket1_OnMessage(ByVal RecvData As Variant, ByVal GetMsg As Long, sFIN As Boolean)If GetMsg = 1 ThenShowlog CStr(RecvData)ElseShowlog StrConv(RecvData, vbFromUnicode)End If
End SubPrivate Sub WebSocket1_OnOpen()Showlog Timer & "已经连接"
End Sub用vb编写websocket客户端示例（每秒百万弹幕吞吐量）相关推荐
- java编写websocket客户端
前言 webSocket 使得客户端和服务器之间的数据交换变得更加简单,允许服务端主动向客户端推送数据. 本次介绍的是websocket客户端的编写,至于websocket服务端的编写可以看我之前写的 ...
- android java websocket client_websocket服务端，android客户端示例
服务端库依赖详见章末 #####spring websocket服务端代码(会话过程) public class HandshakeInterceptor extends HttpSessionHan ...
- 使用linux c开源库libwebsockets编写的websocket客户端
<一>: 背景 19年中旬做的一个嵌入式项目, 应用层需要有一个心跳的功能, 当时决定用websocket协议, 所以当时就研究了下libwebsockets的使用. 网上的资料并不多, ...
- ESP32 单片机学习笔记 - 08 - WebSocket客户端
前言,终于要到网络模型的最后一层,第四层,应用层,http.websocket的实践了. 文章目录 ESP32 单片机学习笔记 - 08 - WebSocket客户端 一.应用层协议 科普概念 二.编 ...
- python编写ftp客户端_用Python写FTP客户端程序
0 前言: ftp客户端相信大家都用过,那么我们为什么还要用Python写ftp客户端呢? 我想有两个原因: 一是写出更好的ftp客户端应用程序,方便大家使用: 二是定制一些特殊服务,例如每天定时下载 ...
- websocket客户端和服务器开发总结
文章目录 前言 一.websocket资料 1.什么是websocket 2.websocket优缺点 3.WebSocket 原理 4.WebSocket 源码下载 二.客户端 1.开发 2.测试 ...
- 关于一个用VB编写的PING工具的问题
我在互联网上找到一个用VB编写的程序,是PING一个计算机的IP是否能通的工具,我改了改,使用ADO重数据库中循环读取IP地址,并将测试后的状态写入到数据库,作完后运行是可以测试,但是速度太慢了,每循 ...
- c++ websocket客户端_你要的websocket都在这，收好不谢~~~
此号已经沉寂多时,似乎已经忘了上一次更新是什么时候了!这一次重拾旧爱,希望能够一直保持下去,坚持写作,快乐你我他 今天的主题是websocket,相信搞研发的兄弟对websocket并不陌生,都202 ...
- 使用swoole进行消息推送通知，配合vb.net进行客户端开发一样爽[开发篇]
在以前的项目中,就曾听说过swoole的大名,想用来进行消息推送,但是当时只是有了初步的了解,并不敢大胆的运用到线上产品.所谓 识不足则多虑,威不足则多怒.所以就是怕,只能跟领导说了运用极光的推送功能 ...
最新文章
- java web中文乱码处理笔记
- 导弹拦截(pascal)
- [Android] Android开发优化之——对界面UI的优化（2）
- python 安装echarts
- 行业看点 | 量子计算时代即将到来？华人科学家揭秘“天使粒子”背后故事……...
- ZZULIOJ 1124: 两个有序数组合并
- 使用nohup以守护进程方式启动程序
- jquery停止动画排队stop
- EMNLP2021 | 实体关系抽取新SoTA - 对NER和RE任务进行联合编码
- vs2013 命名空间“Microsoft.Office”中不存在类型或命名空间名称“Interop”。是否缺少程序集引用?...
- 图像语义分割(13)-OCNet: 用于场景解析的目标语义网络
- 机器学习中优化算法论文合集
- 【100个 Unity小知识点】☀️ | Unity 可以在编辑器中读取Excel，打包成exe后就无法读取的问题
- 计算机专业英语教程第七版,经典_计算机专业英语教程.pdf
- 苹果账号的分类以及注册免费苹果账号
- python如何写简历_python简历—你可以这么写！
- c语言数据流量换算算法,流量累积计算.doc
- 第六届中国多式联运合作与发展大会暨多式联运示范成果展在京举办
- 建广数科(文思海辉)招聘
- [ 网络协议篇 ] IGP 详解之 OSPF 详解（二）--- 四种网络类型 虚链路 详解