MD5 转换模块～提取自《[PYG]算法分析入门第十一课》

野猫III

使用：Text2.Text = MD5(Text1.Text)
方法：VB工程菜单－添加模块－现存，找到Module1.bas添加即可！
以下为这个模块的源代码～Enjoy~

1. Option Explicit
   
2. 
   
3. ' Visual Basic MD5 Implementation
   
4. ' Robert Hubley and David Midkiff ([email]mdj2023@hotmail.com[/email])
   
5. ' modify by simonyan, Support chinese
   
6. ' Standard MD5 implementation optimised for the Visual Basic environment.
   
7. ' Conforms to all standards and can be used in digital signature or password
   
8. ' protection related schemes.
   
9. 
   
10. Private Const OFFSET_4 = 4294967296#
    
11. Private Const MAXINT_4 = 2147483647
    
12. Private State(4) As Long
    
13. Private ByteCounter As Long
    
14. Private ByteBuffer(63) As Byte
    
15. Private Const S11 = 7
    
16. Private Const S12 = 12
    
17. Private Const S13 = 17
    
18. Private Const S14 = 22
    
19. Private Const S21 = 5
    
20. Private Const S22 = 9
    
21. Private Const S23 = 14
    
22. Private Const S24 = 20
    
23. Private Const S31 = 4
    
24. Private Const S32 = 11
    
25. Private Const S33 = 16
    
26. Private Const S34 = 23
    
27. Private Const S41 = 6
    
28. Private Const S42 = 10
    
29. Private Const S43 = 15
    
30. Private Const S44 = 21
    
31. Property Get RegisterA() As String
    
32.     RegisterA = State(1)
    
33. End Property
    
34. Property Get RegisterB() As String
    
35.     RegisterB = State(2)
    
36. End Property
    
37. 
    
38. Property Get RegisterC() As String
    
39.     RegisterC = State(3)
    
40. End Property
    
41. 
    
42. Property Get RegisterD() As String
    
43.     RegisterD = State(4)
    
44. End Property
    
45. Public Function MD5(SourceString As String) As String
    
46.     MD5Init
    
47.     MD5Update LenB(StrConv(SourceString, vbFromUnicode)), StringToArray(SourceString)
    
48.     MD5Final
    
49.     MD5 = GetValues
    
50. End Function
    
51. Public Function Md5_File_Calc(InFile As String) As String
    
52. 
    
53. GoSub begin
    
54. 
    
55. begin:
    
56.     Dim FileO As Integer
    
57.     FileO = FreeFile
    
58.     Call FileLen(InFile)
    
59.     Open InFile For Binary Access Read As #FileO
    
60.     MD5Init
    
61.     Do While Not EOF(FileO)
    
62.         Get #FileO, , ByteBuffer
    
63.         If Loc(FileO) < LOF(FileO) Then
    
64.             ByteCounter = ByteCounter + 64
    
65.             MD5Transform ByteBuffer
    
66.         End If
    
67.     Loop
    
68.     ByteCounter = ByteCounter + (LOF(FileO) Mod 64)
    
69.     Close #FileO
    
70.     MD5Final
    
71.     Md5_File_Calc = GetValues
    
72. End Function
    
73. Private Function StringToArray(InString As String) As Byte()
    
74.     Dim I As Integer, bytBuffer() As Byte
    
75.     ReDim bytBuffer(LenB(StrConv(InString, vbFromUnicode)))
    
76.     bytBuffer = StrConv(InString, vbFromUnicode)
    
77.     StringToArray = bytBuffer
    
78. End Function
    
79. Public Function GetValues() As String
    
80.     GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
    
81. End Function
    
82. Private Function LongToString(Num As Long) As String
    
83.         Dim a As Byte, B As Byte, C As Byte, D As Byte
    
84.         a = Num And &HFF&
    
85.         If a < 16 Then LongToString = "0" & Hex(a) Else LongToString = Hex(a)
    
86.         B = (Num And &HFF00&) \ 256
    
87.         If B < 16 Then LongToString = LongToString & "0" & Hex(B) Else LongToString = LongToString & Hex(B)
    
88.         C = (Num And &HFF0000) \ 65536
    
89.         If C < 16 Then LongToString = LongToString & "0" & Hex(C) Else LongToString = LongToString & Hex(C)
    
90.         If Num < 0 Then D = ((Num And &H7F000000) \ 16777216) Or &H80& Else D = (Num And &HFF000000) \ 16777216
    
91.         If D < 16 Then LongToString = LongToString & "0" & Hex(D) Else LongToString = LongToString & Hex(D)
    
92. End Function
    
93. 
    
94. Public Sub MD5Init()
    
95.     ByteCounter = 0
    
96.     State(1) = UnsignedToLong(1732584193#)
    
97.     State(2) = UnsignedToLong(4023233417#)
    
98.     State(3) = UnsignedToLong(2562383102#)
    
99.     State(4) = UnsignedToLong(271733878#)
    
100. End Sub
     
101. 
     
102. Public Sub MD5Final()
     
103.     Dim dblBits As Double, padding(72) As Byte, lngBytesBuffered As Long
     
104.     padding(0) = &H80
     
105.     dblBits = ByteCounter * 8
     
106.     lngBytesBuffered = ByteCounter Mod 64
     
107.     If lngBytesBuffered <= 56 Then MD5Update 56 - lngBytesBuffered, padding Else MD5Update 120 - ByteCounter, padding
     
108.     padding(0) = UnsignedToLong(dblBits) And &HFF&
     
109.     padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
     
110.     padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
     
111.     padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
     
112.     padding(4) = 0
     
113.     padding(5) = 0
     
114.     padding(6) = 0
     
115.     padding(7) = 0
     
116.     MD5Update 8, padding
     
117. End Sub
     
118. Public Sub MD5Update(InputLen As Long, InputBuffer() As Byte)
     
119.     Dim II As Integer, I As Integer, J As Integer, K As Integer, lngBufferedBytes As Long, lngBufferRemaining As Long, lngRem As Long
     
120. 
     
121.     lngBufferedBytes = ByteCounter Mod 64
     
122.     lngBufferRemaining = 64 - lngBufferedBytes
     
123.     ByteCounter = ByteCounter + InputLen
     
124. 
     
125.     If InputLen >= lngBufferRemaining Then
     
126.         For II = 0 To lngBufferRemaining - 1
     
127.             ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
     
128.         Next II
     
129.         MD5Transform ByteBuffer
     
130.         lngRem = (InputLen) Mod 64
     
131.         For I = lngBufferRemaining To InputLen - II - lngRem Step 64
     
132.             For J = 0 To 63
     
133.                 ByteBuffer(J) = InputBuffer(I + J)
     
134.             Next J
     
135.             MD5Transform ByteBuffer
     
136.         Next I
     
137.         lngBufferedBytes = 0
     
138.     Else
     
139.       I = 0
     
140.     End If
     
141.     For K = 0 To InputLen - I - 1
     
142.         ByteBuffer(lngBufferedBytes + K) = InputBuffer(I + K)
     
143.     Next K
     
144. End Sub
     
145. Private Sub MD5Transform(Buffer() As Byte)
     
146.     Dim X(16) As Long, a As Long, B As Long, C As Long, D As Long
     
147.    
     
148.     a = State(1)
     
149.     B = State(2)
     
150.     C = State(3)
     
151.     D = State(4)
     
152.     Decode 64, X, Buffer
     
153.     FF a, B, C, D, X(0), S11, -680876936
     
154.     FF D, a, B, C, X(1), S12, -389564586
     
155.     FF C, D, a, B, X(2), S13, 606105819
     
156.     FF B, C, D, a, X(3), S14, -1044525330
     
157.     FF a, B, C, D, X(4), S11, -176418897
     
158.     FF D, a, B, C, X(5), S12, 1200080426
     
159.     FF C, D, a, B, X(6), S13, -1473231341
     
160.     FF B, C, D, a, X(7), S14, -45705983
     
161.     FF a, B, C, D, X(8), S11, 1770035416
     
162.     FF D, a, B, C, X(9), S12, -1958414417
     
163.     FF C, D, a, B, X(10), S13, -42063
     
164.     FF B, C, D, a, X(11), S14, -1990404162
     
165.     FF a, B, C, D, X(12), S11, 1804603682
     
166.     FF D, a, B, C, X(13), S12, -40341101
     
167.     FF C, D, a, B, X(14), S13, -1502002290
     
168.     FF B, C, D, a, X(15), S14, 1236535329
     
169. 
     
170.     GG a, B, C, D, X(1), S21, -165796510
     
171.     GG D, a, B, C, X(6), S22, -1069501632
     
172.     GG C, D, a, B, X(11), S23, 643717713
     
173.     GG B, C, D, a, X(0), S24, -373897302
     
174.     GG a, B, C, D, X(5), S21, -701558691
     
175.     GG D, a, B, C, X(10), S22, 38016083
     
176.     GG C, D, a, B, X(15), S23, -660478335
     
177.     GG B, C, D, a, X(4), S24, -405537848
     
178.     GG a, B, C, D, X(9), S21, 568446438
     
179.     GG D, a, B, C, X(14), S22, -1019803690
     
180.     GG C, D, a, B, X(3), S23, -187363961
     
181.     GG B, C, D, a, X(8), S24, 1163531501
     
182.     GG a, B, C, D, X(13), S21, -1444681467
     
183.     GG D, a, B, C, X(2), S22, -51403784
     
184.     GG C, D, a, B, X(7), S23, 1735328473
     
185.     GG B, C, D, a, X(12), S24, -1926607734
     
186. 
     
187.     HH a, B, C, D, X(5), S31, -378558
     
188.     HH D, a, B, C, X(8), S32, -2022574463
     
189.     HH C, D, a, B, X(11), S33, 1839030562
     
190.     HH B, C, D, a, X(14), S34, -35309556
     
191.     HH a, B, C, D, X(1), S31, -1530992060
     
192.     HH D, a, B, C, X(4), S32, 1272893353
     
193.     HH C, D, a, B, X(7), S33, -155497632
     
194.     HH B, C, D, a, X(10), S34, -1094730640
     
195.     HH a, B, C, D, X(13), S31, 681279174
     
196.     HH D, a, B, C, X(0), S32, -358537222
     
197.     HH C, D, a, B, X(3), S33, -722521979
     
198.     HH B, C, D, a, X(6), S34, 76029189
     
199.     HH a, B, C, D, X(9), S31, -640364487
     
200.     HH D, a, B, C, X(12), S32, -421815835
     
201.     HH C, D, a, B, X(15), S33, 530742520
     
202.     HH B, C, D, a, X(2), S34, -995338651
     
203. 
     
204.     II a, B, C, D, X(0), S41, -198630844
     
205.     II D, a, B, C, X(7), S42, 1126891415
     
206.     II C, D, a, B, X(14), S43, -1416354905
     
207.     II B, C, D, a, X(5), S44, -57434055
     
208.     II a, B, C, D, X(12), S41, 1700485571
     
209.     II D, a, B, C, X(3), S42, -1894986606
     
210.     II C, D, a, B, X(10), S43, -1051523
     
211.     II B, C, D, a, X(1), S44, -2054922799
     
212.     II a, B, C, D, X(8), S41, 1873313359
     
213.     II D, a, B, C, X(15), S42, -30611744
     
214.     II C, D, a, B, X(6), S43, -1560198380
     
215.     II B, C, D, a, X(13), S44, 1309151649
     
216.     II a, B, C, D, X(4), S41, -145523070
     
217.     II D, a, B, C, X(11), S42, -1120210379
     
218.     II C, D, a, B, X(2), S43, 718787259
     
219.     II B, C, D, a, X(9), S44, -343485551
     
220. 
     
221.     State(1) = LongOverflowAdd(State(1), a)
     
222.     State(2) = LongOverflowAdd(State(2), B)
     
223.     State(3) = LongOverflowAdd(State(3), C)
     
224.     State(4) = LongOverflowAdd(State(4), D)
     
225. End Sub
     
226. 
     
227. Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte)
     
228.     Dim intDblIndex As Integer, intByteIndex As Integer, dblSum As Double
     
229.     For intByteIndex = 0 To Length - 1 Step 4
     
230.         dblSum = InputBuffer(intByteIndex) + InputBuffer(intByteIndex + 1) * 256# + InputBuffer(intByteIndex + 2) * 65536# + InputBuffer(intByteIndex + 3) * 16777216#
     
231.         OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
     
232.         intDblIndex = intDblIndex + 1
     
233.     Next intByteIndex
     
234. End Sub
     
235. Private Function FF(a As Long, B As Long, C As Long, D As Long, X As Long, S As Long, ac As Long) As Long
     
236.     a = LongOverflowAdd4(a, (B And C) Or (Not (B) And D), X, ac)
     
237.     a = LongLeftRotate(a, S)
     
238.     a = LongOverflowAdd(a, B)
     
239. End Function
     
240. Private Function GG(a As Long, B As Long, C As Long, D As Long, X As Long, S As Long, ac As Long) As Long
     
241.     a = LongOverflowAdd4(a, (B And D) Or (C And Not (D)), X, ac)
     
242.     a = LongLeftRotate(a, S)
     
243.     a = LongOverflowAdd(a, B)
     
244. End Function
     
245. Private Function HH(a As Long, B As Long, C As Long, D As Long, X As Long, S As Long, ac As Long) As Long
     
246.     a = LongOverflowAdd4(a, B Xor C Xor D, X, ac)
     
247.     a = LongLeftRotate(a, S)
     
248.     a = LongOverflowAdd(a, B)
     
249. End Function
     
250. Private Function II(a As Long, B As Long, C As Long, D As Long, X As Long, S As Long, ac As Long) As Long
     
251.     a = LongOverflowAdd4(a, C Xor (B Or Not (D)), X, ac)
     
252.     a = LongLeftRotate(a, S)
     
253.     a = LongOverflowAdd(a, B)
     
254. End Function
     
255. 
     
256. Function LongLeftRotate(value As Long, Bits As Long) As Long
     
257.     Dim lngSign As Long, lngI As Long
     
258.     Bits = Bits Mod 32
     
259.     If Bits = 0 Then LongLeftRotate = value: Exit Function
     
260.     For lngI = 1 To Bits
     
261.         lngSign = value And &HC0000000
     
262.         value = (value And &H3FFFFFFF) * 2
     
263.         value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
     
264.     Next
     
265.     LongLeftRotate = value
     
266. End Function
     
267. Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
     
268.     Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
     
269.     lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
     
270.     lngOverflow = lngLowWord \ 65536
     
271.     lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
     
272.     LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
     
273. End Function
     
274. Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
     
275.     Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
     
276.     lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
     
277.     lngOverflow = lngLowWord \ 65536
     
278.     lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + ((val3 And &HFFFF0000) \ 65536) + ((val4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
     
279.     LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
     
280. End Function
     
281. 
     
282. Private Function UnsignedToLong(value As Double) As Long
     
283.     If value < 0 Or value >= OFFSET_4 Then Error 6
     
284.     If value <= MAXINT_4 Then UnsignedToLong = value Else UnsignedToLong = value - OFFSET_4
     
285. End Function
     
286. Private Function LongToUnsigned(value As Long) As Double
     
287.     If value < 0 Then LongToUnsigned = value + OFFSET_4 Else LongToUnsigned = value
     
288. End Function

复制代码

[ 本帖最后由 野猫III 于 2006-7-31 15:16 编辑 ]

快雪时晴

下了以备将来做注册机用，谢谢

寒湖鹤影

好东西正需要，猫兄有其它的加密算法模板吗？

网游难民

最近学VB，下来收藏啊~~

886788

谢谢分享/:good

cbcbcbbbc

多谢楼主了，我现在想实现这个功能：用MD5对固定字符（假设为abcd)以及Text1（假设输入１２３４）和Text2（假设输入opq)所组成的新字符串(即abcd１２３４opq)进行加密，并在Text3中显示出来，请问该如何写？我试过Text３.Text = MD5(abcdText１.TextText２.Text)，可是提示出错了．

tianxj

原帖由 cbcbcbbbc 于 2008-3-29 23:21 发表
多谢楼主了，我现在想实现这个功能：用MD5对固定字符（假设为abcd)以及Text1（假设输入１２３４）和Text2（假设输入opq)所组成的新字符串(即abcd１２３４opq)进行加密，并在Text3中显示出来，请问该如何写？我试过Te ...

好久没有用VB了,Text３.Text = MD5("abcd"&Text１.Text&Text２.Text),不知道对吗

moyelin

辛苦了！！学习下`~

qwaszxcd

VB的MD5模块。。不错！支持个