一共就下面的兩個模塊,調用只使用到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