一共就下面的两个模块,调用只使用到mWSProtocol模块,所有调用函数功能简单介绍一下:
建立连接后就开始握手,服务端用Handshake()验证,如果是客户端自己发送握手封包
接收数据,先用AnalyzeHeader()得到数据帧结构(DataFrame)
然后再用PickDataV()或PickData()得到源数据进行处理
发送数据需要先进行数据帧包装:
服务端向客户端发送无需掩码,用PackString()或PackData()
而模拟客户端向服务器的发送需要加掩码,用PackMaskString()或PackMaskData()
相关资料下载：《WebSocket协议中文版.pdf》
第二次写了,完全是为了分享...如果对你有帮助就支持一下吧
mWSProtocol:
1 Option Explicit 2 Option Compare Text 3 '============================================================== 4 'By: 悠悠然 5 'QQ: 2860898817 6 'E-mail: ur1986@foxmail.com 7 '完整运行示例放Q群文件共享:369088586 8 '============================================================== 9 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long) 10 Public Enum OpcodeType 11 opContin = 0 '连续消息片断 12 opText = 1 '文本消息片断 13 opBinary = 2 '二进制消息片断 14 '3 - 7 非控制帧保留 15 opClose = 8 '连接关闭 16 opPing = 9 '心跳检查的ping 17 opPong = 10 '心跳检查的pong 18 '11-15 控制帧保留 19 End Enum 20 Public Type DataFrame 21 FIN As Boolean '0表示不是当前消息的最后一帧，后面还有消息,1表示这是当前消息的最后一帧； 22 RSV1 As Boolean '1位，若没有自定义协议,必须为0,否则必须断开. 23 RSV2 As Boolean '1位，若没有自定义协议,必须为0,否则必须断开. 24 RSV3 As Boolean '1位，若没有自定义协议,必须为0,否则必须断开. 25 Opcode As OpcodeType '4位操作码，定义有效负载数据，如果收到了一个未知的操作码，连接必须断开. 26 MASK As Boolean '1位，定义传输的数据是否有加掩码,如果有掩码则存放在MaskingKey 27 MaskingKey(3) As Byte '32位的掩码 28 Payloadlen As Long '传输数据的长度 29 DataOffset As Long '数据源起始位 30 End Type 31 32 '============================================================== 33 '握手部分,只有一个开放调用函数 Handshake(requestHeader As String) As Byte() 34 '============================================================== 35 Private Const MagicKey = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11" 36 Private Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" 37 Public Function Handshake(requestHeader As String) As Byte() 38 Dim clientKey As String 39 clientKey = getHeaderValue(requestHeader, "Sec-WebSocket-Key:") 40 Dim AcceptKey As String 41 AcceptKey = getAcceptKey(clientKey) 42 Dim response As String 43 response = "HTTP/1.1 101 Web Socket Protocol Handshake" & vbCrLf 44 response = response & "Upgrade: WebSocket" & vbCrLf 45 response = response & "Connection: Upgrade" & vbCrLf 46 response = response & "Sec-WebSocket-Accept: " & AcceptKey & vbCrLf 47 response = response & "WebSocket-Origin: " & getHeaderValue(requestHeader, "Sec-WebSocket-Origin:") & vbCrLf 48 response = response & "WebSocket-Location: " & getHeaderValue(requestHeader, "Host:") & vbCrLf 49 response = response & vbCrLf 50 'Debug.Print response 51 Handshake = StrConv(response, vbFromUnicode) 52 End Function 53 Private Function getHeaderValue(str As String, pname As String) As String 54 Dim i As Long, j As Long 55 i = InStr(str, pname) 56 If i > 0 Then 57 j = InStr(i, str, vbCrLf) 58 If j > 0 Then 59 i = i + Len(pname) 60 getHeaderValue = Trim(Mid(str, i, j - i)) 61 End If 62 End If 63 End Function 64 Private Function getAcceptKey(key As String) As String 65 Dim b() As Byte 66 b = mSHA1.SHA1(StrConv(key & "258EAFA5-E914-47DA-95CA-C5AB0DC85B11", vbFromUnicode)) 67 getAcceptKey = EnBase64(b) 68 End Function 69 Private Function EnBase64(str() As Byte) As String 70 On Error GoTo over 71 Dim buf() As Byte, length As Long, mods As Long 72 mods = (UBound(str) + 1) Mod 3 73 length = UBound(str) + 1 - mods 74 ReDim buf(length / 3 * 4 + IIf(mods <> 0, 4, 0) - 1) 75 Dim i As Long 76 For i = 0 To length - 1 Step 3 77 buf(i / 3 * 4) = (str(i) And &HFC) / &H4 78 buf(i / 3 * 4 + 1) = (str(i) And &H3) * &H10 + (str(i + 1) And &HF0) / &H10 79 buf(i / 3 * 4 + 2) = (str(i + 1) And &HF) * &H4 + (str(i + 2) And &HC0) / &H40 80 buf(i / 3 * 4 + 3) = str(i + 2) And &H3F 81 Next 82 If mods = 1 Then 83 buf(length / 3 * 4) = (str(length) And &HFC) / &H4 84 buf(length / 3 * 4 + 1) = (str(length) And &H3) * &H10 85 buf(length / 3 * 4 + 2) = 64 86 buf(length / 3 * 4 + 3) = 64 87 ElseIf mods = 2 Then 88 buf(length / 3 * 4) = (str(length) And &HFC) / &H4 89 buf(length / 3 * 4 + 1) = (str(length) And &H3) * &H10 + (str(length + 1) And &HF0) / &H10 90 buf(length / 3 * 4 + 2) = (str(length + 1) And &HF) * &H4 91 buf(length / 3 * 4 + 3) = 64 92 End If 93 For i = 0 To UBound(buf) 94 EnBase64 = EnBase64 + Mid(B64_CHAR_DICT, buf(i) + 1, 1) 95 Next 96 over: 97 End Function 98 '============================================================== 99 '数据帧解析,返回帧结构 100 '============================================================== 101 Public Function AnalyzeHeader(byt() As Byte) As DataFrame 102 Dim DF As DataFrame 103 DF.FIN = IIf((byt(0) And &H80) = &H80, True, False) 104 DF.RSV1 = IIf((byt(0) And &H40) = &H40, True, False) 105 DF.RSV2 = IIf((byt(0) And &H20) = &H20, True, False) 106 DF.RSV3 = IIf((byt(0) And &H10) = &H10, True, False) 107 DF.Opcode = byt(0) And &H7F 108 DF.MASK = IIf((byt(1) And &H80) = &H80, True, False) 109 Dim plen As Byte 110 plen = byt(1) And &H7F 111 If plen < 126 Then 112 DF.Payloadlen = plen 113 If DF.MASK Then 114 CopyMemory DF.MaskingKey(0), byt(2), 4 115 DF.DataOffset = 6 116 Else 117 DF.DataOffset = 2 118 End If 119 ElseIf plen = 126 Then 120 Dim l(3) As Byte 121 l(0) = byt(3) 122 l(1) = byt(2) 123 CopyMemory DF.Payloadlen, l(0), 4 124 If DF.MASK Then 125 CopyMemory DF.MaskingKey(0), byt(4), 4 126 DF.DataOffset = 8 127 Else 128 DF.DataOffset = 4 129 End If 130 ElseIf plen = 127 Then 131 '这部分没有什么意义就不写了,因为VB没有64位的整型可供使用 132 '所以对长度设定为-1,自己再判断 133 DF.Payloadlen = -1 134 'If df.mask Then 135 ' CopyMemory df.MaskingKey(0), byt(10), 4 136 ' df.DataOffset = 14 137 'Else 138 ' df.DataOffset = 10 139 'End If 140 End If 141 AnalyzeHeader = DF 142 End Function 143 '============================================================== 144 '接收的数据处理,有掩码就反掩码 145 'PickDataV 方法是出于性能的考虑,用于有时数据只是为了接收,做一些逻辑判断,并不需要对数据块进行单独提炼 146 'PickData 不赘述了... 147 '============================================================== 148 Public Sub PickDataV(byt() As Byte, dataType As DataFrame) 149 Dim lenLimit As Long 150 lenLimit = dataType.DataOffset + dataType.Payloadlen - 1 151 If dataType.MASK And lenLimit <= UBound(byt) Then 152 Dim i As Long, j As Long 153 For i = dataType.DataOffset To lenLimit 154 byt(i) = byt(i) Xor dataType.MaskingKey(j) 155 j = j + 1 156 If j = 4 Then j = 0 157 Next i 158 End If 159 End Sub 160 Public Function PickData(byt() As Byte, dataType As DataFrame) As Byte() 161 Dim b() As Byte 162 PickDataV byt, dataType 163 ReDim b(dataType.Payloadlen - 1) 164 CopyMemory b(0), byt(dataType.DataOffset), dataType.Payloadlen 165 PickData = b 166 End Function 167 168 '============================================================== 169 '发送的数据处理,该部分未联网测试,使用下面的方式测试验证 170 'Private Sub Command1_Click() 171 ' Dim str As String, b() As Byte, bs() As Byte 172 ' Dim DF As DataFrame 173 ' str = "abc123" 174 ' Showlog "组装前数据:" & str 175 ' b = mWSProtocol.PackMaskString(str): Showlog "掩码后字节:" & BytesToHex(b) 176 ' DF = mWSProtocol.AnalyzeHeader(b): Showlog "结构体偏移:" & DF.DataOffset & " 长度:" & DF.Payloadlen 177 ' bs = mWSProtocol.PickData(b, DF): Showlog "还原后字节:" & BytesToHex(bs) 178 ' Showlog "还原后数据:" & StrConv(bs, vbUnicode) 179 'End Sub 180 '============================================================== 181 '无掩码数据的组装,用于服务端向客户端发送 182 '-------------------------------------------------------------- 183 Public Function PackString(str As String, Optional dwOpcode As OpcodeType = opText) As Byte() 184 Dim b() As Byte 185 b = StrConv(str, vbFromUnicode) 186 PackString = PackData(b, dwOpcode) 187 End Function 188 Public Function PackData(data() As Byte, Optional dwOpcode As OpcodeType = opText) As Byte() 189 Dim length As Long 190 Dim byt() As Byte 191 length = UBound(data) + 1 192 193 If length < 126 Then 194 ReDim byt(length + 1) 195 byt(1) = CByte(length) 196 CopyMemory byt(2), data(0), length 197 ElseIf length <= 65535 Then 198 ReDim byt(length + 3) 199 Dim l(1) As Byte 200 byt(1) = &H7E 201 CopyMemory l(0), length, 2 202 byt(2) = l(1) 203 byt(3) = l(0) 204 CopyMemory byt(4), data(0), length 205 'ElseIf length <= 999999999999999# Then 206 '这么长不处理了... 207 'VB6也没有这么大的整型 208 '有需要就根据上面调整来写吧 209 End If 210 '------------------------------ 211 '关于下面的 byt(0) = &H80 Or dwOpcode 中，&H80 对应的是 DataFrame 结构中的FIN + RSV1 + RSV2 + RSV3 212 'FIN 的中文解释是：指示这个是消息的最后片段，第一个片段可能也是最后的片段。 213 '这里我不是很理解，可能是自定义分包用到吧，但貌似分包应该不是自己可控的，所以我默认是 1。 214 '------------------------------ 215 byt(0) = &H80 Or dwOpcode 216 PackData = byt 217 End Function 218 '-------------------------------------------------------------- 219 '有掩码数据的组装,用于替代客户端想服务端发送 220 '-------------------------------------------------------------- 221 Public Function PackMaskString(str As String) As Byte() 222 Dim b() As Byte 223 b = StrConv(str, vbFromUnicode) 224 PackMaskString = PackMaskData(b) 225 End Function 226 Public Function PackMaskData(data() As Byte) As Byte() 227 '对源数据做掩码处理 228 Dim mKey(3) As Byte 229 mKey(0) = 108: mKey(1) = 188: mKey(2) = 98: mKey(3) = 208 '掩码,你也可以自己定义 230 Dim i As Long, j As Long 231 For i = 0 To UBound(data) 232 data(i) = data(i) Xor mKey(j) 233 j = j + 1 234 If j = 4 Then j = 0 235 Next i 236 '包装,和上面的无掩码包装PackData()大体相同 237 Dim length As Long 238 Dim byt() As Byte 239 length = UBound(data) + 1 240 If length < 126 Then 241 ReDim byt(length + 5) 242 byt(0) = &H81 '注意这里是按照OpcodeType里面的文本类型,其他类型,比如字节包应该是 byt(0) = &h80 or OpcodeType.opBinary 243 byt(1) = (CByte(length) Or &H80) 244 CopyMemory byt(2), mKey(0), 4 245 CopyMemory byt(6), data(0), length 246 ElseIf length <= 65535 Then 247 ReDim byt(length + 7) 248 Dim l(1) As Byte 249 byt(0) = &H81 '同上注意 250 byt(1) = &HFE '固定 掩码位+126 251 CopyMemory l(0), length, 2 252 byt(2) = l(1) 253 byt(3) = l(0) 254 CopyMemory byt(4), mKey(0), 4 255 CopyMemory byt(8), data(0), length 256 'ElseIf length <= 999999999999999# Then 257 '这么长不处理了...有需要就根据上面调整来写吧 258 End If 259 PackMaskData = byt 260 End Function 261 '============================================================== 262 '控制帧相关,Ping、Pong、Close 用于服务端向客户端发送未经掩码的信号 263 '我用的0长度,其实是可以包含数据的,但是附带数据客户端处理又麻烦了 264 ' 265 '* 如果有附带信息的需求,也可以用PackString或PackData,可选参数指定OpcodeType 266 '============================================================== 267 Public Function PingFrame() As Byte() 268 Dim b(1) As Byte 269 b(0) = &H89 270 b(1) = &H0 271 PingFrame = b 272 '发送一个包含"Hello"的Ping信号: 0x89 0x05 0x48 0x65 0x6c 0x6c 0x6f 273 End Function 274 Public Function PongFrame() As Byte() 275 Dim b(1) As Byte 276 b(0) = &H8A 277 b(1) = &H0 278 PongFrame = b 279 '发送一个包含"Hello"的Pong信号: 0x8A 0x05 0x48 0x65 0x6c 0x6c 0x6f 280 End Function 281 Public Function CloseFrame() As Byte() 282 Dim b(1) As Byte 283 b(0) = &H88 284 b(1) = &H0 285 CloseFrame = b 286 '发送一个包含"Close"的Pong信号: 0x8A 0x05 0x43 0x6c 0x6f 0x73 0x65 287 End Function
mSHA1:
1 Option Explicit 2 '============================================================== 3 '该模块来自网络资料,进行了小改动,源作者不详 4 '============================================================== 5 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long) 6 Private Type Word 7 B0 As Byte 8 B1 As Byte 9 B2 As Byte 10 B3 As Byte 11 End Type 12 Private Function AndW(w1 As Word, w2 As Word) As Word 13 AndW.B0 = w1.B0 And w2.B0 14 AndW.B1 = w1.B1 And w2.B1 15 AndW.B2 = w1.B2 And w2.B2 16 AndW.B3 = w1.B3 And w2.B3 17 End Function 18 19 Private Function OrW(w1 As Word, w2 As Word) As Word 20 OrW.B0 = w1.B0 Or w2.B0 21 OrW.B1 = w1.B1 Or w2.B1 22 OrW.B2 = w1.B2 Or w2.B2 23 OrW.B3 = w1.B3 Or w2.B3 24 End Function 25 26 Private Function XorW(w1 As Word, w2 As Word) As Word 27 XorW.B0 = w1.B0 Xor w2.B0 28 XorW.B1 = w1.B1 Xor w2.B1 29 XorW.B2 = w1.B2 Xor w2.B2 30 XorW.B3 = w1.B3 Xor w2.B3 31 End Function 32 33 Private Function NotW(w As Word) As Word 34 NotW.B0 = Not w.B0 35 NotW.B1 = Not w.B1 36 NotW.B2 = Not w.B2 37 NotW.B3 = Not w.B3 38 End Function 39 40 Private Function AddW(w1 As Word, w2 As Word) As Word 41 Dim i As Long, w As Word 42 i = CLng(w1.B3) + w2.B3 43 w.B3 = i Mod 256 44 i = CLng(w1.B2) + w2.B2 + (i 256) 45 w.B2 = i Mod 256 46 i = CLng(w1.B1) + w2.B1 + (i 256) 47 w.B1 = i Mod 256 48 i = CLng(w1.B0) + w2.B0 + (i 256) 49 w.B0 = i Mod 256 50 AddW = w 51 End Function 52 53 Private Function CircShiftLeftW(w As Word, n As Long) As Word 54 Dim d1 As Double, d2 As Double 55 d1 = WordToDouble(w) 56 d2 = d1 57 d1 = d1 * (2 ^ n) 58 d2 = d2 / (2 ^ (32 - n)) 59 CircShiftLeftW = OrW(DoubleToWord(d1), DoubleToWord(d2)) 60 End Function 61 62 Private Function WordToHex(w As Word) As String 63 WordToHex = Right$("0" & Hex$(w.B0), 2) & Right$("0" & Hex$(w.B1), 2) & Right$("0" & Hex$(w.B2), 2) & Right$("0" & Hex$(w.B3), 2) 64 End Function 65 66 Private Function HexToWord(H As String) As Word 67 HexToWord = DoubleToWord(Val("&H" & H & "#")) 68 End Function 69 70 Private Function DoubleToWord(n As Double) As Word 71 DoubleToWord.B0 = Int(DMod(n, 2 ^ 32) / (2 ^ 24)) 72 DoubleToWord.B1 = Int(DMod(n, 2 ^ 24) / (2 ^ 16)) 73 DoubleToWord.B2 = Int(DMod(n, 2 ^ 16) / (2 ^ 8)) 74 DoubleToWord.B3 = Int(DMod(n, 2 ^ 8)) 75 End Function 76 77 Private Function WordToDouble(w As Word) As Double 78 WordToDouble = (w.B0 * (2 ^ 24)) + (w.B1 * (2 ^ 16)) + (w.B2 * (2 ^ 8)) + w.B3 79 End Function 80 81 Private Function DMod(value As Double, divisor As Double) As Double 82 DMod = value - (Int(value / divisor) * divisor) 83 If DMod < 0 Then DMod = DMod + divisor 84 End Function 85 86 Private Function F(t As Long, b As Word, C As Word, D As Word) As Word 87 Select Case t 88 Case Is <= 19 89 F = OrW(AndW(b, C), AndW(NotW(b), D)) 90 Case Is <= 39 91 F = XorW(XorW(b, C), D) 92 Case Is <= 59 93 F = OrW(OrW(AndW(b, C), AndW(b, D)), AndW(C, D)) 94 Case Else 95 F = XorW(XorW(b, C), D) 96 End Select 97 End Function 98 Public Function StringSHA1(inMessage As String) As String 99 ' 计算字符串的SHA1摘要 100 Dim inLen As Long 101 Dim inLenW As Word 102 Dim padMessage As String 103 Dim numBlocks As Long 104 Dim w(0 To 79) As Word 105 Dim blockText As String 106 Dim wordText As String 107 Dim i As Long, t As Long 108 Dim temp As Word 109 Dim k(0 To 3) As Word 110 Dim H0 As Word 111 Dim H1 As Word 112 Dim H2 As Word 113 Dim H3 As Word 114 Dim H4 As Word 115 Dim A As Word 116 Dim b As Word 117 Dim C As Word 118 Dim D As Word 119 Dim E As Word 120 inMessage = StrConv(inMessage, vbFromUnicode) 121 inLen = LenB(inMessage) 122 inLenW = DoubleToWord(CDbl(inLen) * 8) 123 padMessage = inMessage & ChrB(128) _ 124 & StrConv(String((128 - (inLen Mod 64) - 9) Mod 64 + 4, Chr(0)), 128) _ 125 & ChrB(inLenW.B0) & ChrB(inLenW.B1) & ChrB(inLenW.B2) & ChrB(inLenW.B3) 126 numBlocks = LenB(padMessage) / 64 127 k(0) = HexToWord("5A827999") 128 k(1) = HexToWord("6ED9EBA1") 129 k(2) = HexToWord("8F1BBCDC") 130 k(3) = HexToWord("CA62C1D6") 131 H0 = HexToWord("67452301") 132 H1 = HexToWord("EFCDAB89") 133 H2 = HexToWord("98BADCFE") 134 H3 = HexToWord("10325476") 135 H4 = HexToWord("C3D2E1F0") 136 For i = 0 To numBlocks - 1 137 blockText = MidB$(padMessage, (i * 64) + 1, 64) 138 For t = 0 To 15 139 wordText = MidB$(blockText, (t * 4) + 1, 4) 140 w(t).B0 = AscB(MidB$(wordText, 1, 1)) 141 w(t).B1 = AscB(MidB$(wordText, 2, 1)) 142 w(t).B2 = AscB(MidB$(wordText, 3, 1)) 143 w(t).B3 = AscB(MidB$(wordText, 4, 1)) 144 Next 145 For t = 16 To 79 146 w(t) = CircShiftLeftW(XorW(XorW(XorW(w(t - 3), w(t - 8)), w(t - 14)), w(t - 16)), 1) 147 Next 148 A = H0 149 b = H1 150 C = H2 151 D = H3 152 E = H4 153 For t = 0 To 79 154 temp = AddW(AddW(AddW(AddW(CircShiftLeftW(A, 5), _ 155 F(t, b, C, D)), E), w(t)), k(t 20)) 156 E = D 157 D = C 158 C = CircShiftLeftW(b, 30) 159 b = A 160 A = temp 161 Next 162 H0 = AddW(H0, A) 163 H1 = AddW(H1, b) 164 H2 = AddW(H2, C) 165 H3 = AddW(H3, D) 166 H4 = AddW(H4, E) 167 Next 168 StringSHA1 = WordToHex(H0) & WordToHex(H1) & WordToHex(H2) & WordToHex(H3) & WordToHex(H4) 169 End Function 170 '计算字节数组的SHA1摘要 171 Public Function SHA1(inMessage() As Byte) As Byte() 172 Dim inLen As Long 173 Dim inLenW As Word 174 Dim numBlocks As Long 175 Dim w(0 To 79) As Word 176 Dim blockText As String 177 Dim wordText As String 178 Dim t As Long 179 Dim temp As Word 180 Dim k(0 To 3) As Word 181 Dim H0 As Word 182 Dim H1 As Word 183 Dim H2 As Word 184 Dim H3 As Word 185 Dim H4 As Word 186 Dim A As Word 187 Dim b As Word 188 Dim C As Word 189 Dim D As Word 190 Dim E As Word 191 Dim i As Long 192 Dim lngPos As Long 193 Dim lngPadMessageLen As Long 194 Dim padMessage() As Byte 195 inLen = UBound(inMessage) + 1 196 inLenW = DoubleToWord(CDbl(inLen) * 8) 197 lngPadMessageLen = inLen + 1 + (128 - (inLen Mod 64) - 9) Mod 64 + 8 198 ReDim padMessage(lngPadMessageLen - 1) As Byte 199 For i = 0 To inLen - 1 200 padMessage(i) = inMessage(i) 201 Next i 202 padMessage(inLen) = 128 203 padMessage(lngPadMessageLen - 4) = inLenW.B0 204 padMessage(lngPadMessageLen - 3) = inLenW.B1 205 padMessage(lngPadMessageLen - 2) = inLenW.B2 206 padMessage(lngPadMessageLen - 1) = inLenW.B3 207 numBlocks = lngPadMessageLen / 64 208 k(0) = HexToWord("5A827999") 209 k(1) = HexToWord("6ED9EBA1") 210 k(2) = HexToWord("8F1BBCDC") 211 k(3) = HexToWord("CA62C1D6") 212 H0 = HexToWord("67452301") 213 H1 = HexToWord("EFCDAB89") 214 H2 = HexToWord("98BADCFE") 215 H3 = HexToWord("10325476") 216 H4 = HexToWord("C3D2E1F0") 217 For i = 0 To numBlocks - 1 218 For t = 0 To 15 219 w(t).B0 = padMessage(lngPos) 220 w(t).B1 = padMessage(lngPos + 1) 221 w(t).B2 = padMessage(lngPos + 2) 222 w(t).B3 = padMessage(lngPos + 3) 223 lngPos = lngPos + 4 224 Next 225 For t = 16 To 79 226 w(t) = CircShiftLeftW(XorW(XorW(XorW(w(t - 3), w(t - 8)), w(t - 14)), w(t - 16)), 1) 227 Next 228 A = H0 229 b = H1 230 C = H2 231 D = H3 232 E = H4 233 For t = 0 To 79 234 temp = AddW(AddW(AddW(AddW(CircShiftLeftW(A, 5), _ 235 F(t, b, C, D)), E), w(t)), k(t 20)) 236 E = D 237 D = C 238 C = CircShiftLeftW(b, 30) 239 b = A 240 A = temp 241 Next 242 H0 = AddW(H0, A) 243 H1 = AddW(H1, b) 244 H2 = AddW(H2, C) 245 H3 = AddW(H3, D) 246 H4 = AddW(H4, E) 247 Next 248 Dim byt(19) As Byte 249 CopyMemory byt(0), H0, 4 250 CopyMemory byt(4), H1, 4 251 CopyMemory byt(8), H2, 4 252 CopyMemory byt(12), H3, 4 253 CopyMemory byt(16), H4, 4 254 SHA1 = byt 255 End Function
