VB封裝的WebSocket模塊,拿來即用

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

相關文章
相關標籤/搜索