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

posted @ 2017-07-08 01:14  JustXIII  阅读(7317)  评论(11编辑  收藏  举报