• 新浪微博:
  • 微信 :
按键精灵电脑版
立即下载

软件版本:2014.05
软件大小:21.6M
更新时间:07-04

按键精灵安卓版
立即下载

软件版本:3.3.5
软件大小:62.5M
更新时间:9-25

按键精灵iOS版
立即下载

软件版本:1.3.5
软件大小:29.2M
更新时间:06-14

最新企业版UiBot
立即下载

软件版本:3.3
软件大小:282M
更新时间:08-06

快捷导航

登录 后使用快捷导航
没有帐号? 注册

登录 注册
发新话题 回复该主题

【VB源码】MD5模块 [复制链接]

1#
MD5_Mod.bas
  1. Option Explicit

  2. Private Const OFFSET_4 = 4294967296#
  3. Private Const MAXINT_4 = 2147483647
  4. Private Const S11 = 7
  5. Private Const S12 = 12
  6. Private Const S13 = 17
  7. Private Const S14 = 22
  8. Private Const S21 = 5
  9. Private Const S22 = 9
  10. Private Const S23 = 14
  11. Private Const S24 = 20
  12. Private Const S31 = 4
  13. Private Const S32 = 11
  14. Private Const S33 = 16
  15. Private Const S34 = 23
  16. Private Const S41 = 6
  17. Private Const S42 = 10
  18. Private Const S43 = 15
  19. Private Const S44 = 21

  20. Private State(4) As Long
  21. Private ByteCounter As Long
  22. Private ByteBuffer(63) As Byte
  23. Property Get RegisterA() As String
  24. RegisterA = State(1)
  25. End Property
  26. Property Get RegisterB() As String
  27. RegisterB = State(2)
  28. End Property
  29. Property Get RegisterC() As String
  30. RegisterC = State(3)
  31. End Property
  32. Property Get RegisterD() As String
  33. RegisterD = State(4)
  34. End Property
  35. Public Function DigestFileToHexStr(FileName As String) As String
  36. Open FileName For Binary Access Read As #1
  37. MD5Init
  38. Do While Not EOF(1)
  39. Get #1, , ByteBuffer
  40. If Loc(1) < LOF(1) Then
  41. ByteCounter = ByteCounter + 64
  42. MD5Transform ByteBuffer
  43. End If
  44. Loop
  45. ByteCounter = ByteCounter + (LOF(1) Mod 64)
  46. Close #1
  47. MD5Final
  48. DigestFileToHexStr = GetValues
  49. End Function

  50. Public Function DigestStrToHexStr(SourceString As String) As String
  51. MD5Init
  52. MD5Update Len(SourceString), StringToArray(SourceString)
  53. MD5Final
  54. DigestStrToHexStr = GetValues
  55. End Function

  56. Private Function StringToArray(InString As String) As Byte()
  57. Dim i As Integer
  58. Dim bytBuffer() As Byte
  59. ReDim bytBuffer(Len(InString))
  60. For i = 0 To Len(InString) - 1
  61. bytBuffer(i) = Asc(Mid(InString, i + 1, 1))
  62. Next i
  63. StringToArray = bytBuffer
  64. End Function
  65. Public Function GetValues() As String
  66. GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
  67. End Function

  68. Private Function LongToString(Num As Long) As String
  69. Dim a As Byte
  70. Dim B As Byte
  71. Dim c As Byte
  72. Dim d As Byte
  73. a = Num And &HFF&
  74. If a < 16 Then
  75. LongToString = "0" & Hex(a)
  76. Else
  77. LongToString = Hex(a)
  78. End If
  79. B = (Num And &HFF00&) \ 256
  80. If B < 16 Then
  81. LongToString = LongToString & "0" & Hex(B)
  82. Else
  83. LongToString = LongToString & Hex(B)
  84. End If
  85. c = (Num And &HFF0000) \ 65536
  86. If c < 16 Then
  87. LongToString = LongToString & "0" & Hex(c)
  88. Else
  89. LongToString = LongToString & Hex(c)
  90. End If
  91. If Num < 0 Then
  92. d = ((Num And &H7F000000) \ 16777216) Or &H80&
  93. Else
  94. d = (Num And &HFF000000) \ 16777216
  95. End If
  96. If d < 16 Then
  97. LongToString = LongToString & "0" & Hex(d)
  98. Else
  99. LongToString = LongToString & Hex(d)
  100. End If
  101. End Function
  102. '
  103. ' Initialize the class
  104. ' This must be called before a digest calculation is started
  105. '
  106. Public Sub MD5Init()
  107. ByteCounter = 0
  108. State(1) = UnsignedToLong(1732584193#)
  109. State(2) = UnsignedToLong(4023233417#)
  110. State(3) = UnsignedToLong(2562383102#)
  111. State(4) = UnsignedToLong(271733878#)
  112. End Sub
  113. '
  114. ' MD5 Final
  115. '
  116. Public Sub MD5Final()
  117. Dim dblBits As Double
  118. Dim padding(72) As Byte
  119. Dim lngBytesBuffered As Long
  120. padding(0) = &H80
  121. dblBits = ByteCounter * 8
  122. ' Pad out
  123. lngBytesBuffered = ByteCounter Mod 64
  124. If lngBytesBuffered <= 56 Then
  125. MD5Update 56 - lngBytesBuffered, padding
  126. Else
  127. MD5Update 120 - ByteCounter, padding
  128. End If

  129. padding(0) = UnsignedToLong(dblBits) And &HFF&
  130. padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
  131. padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
  132. padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
  133. padding(4) = 0
  134. padding(5) = 0
  135. padding(6) = 0
  136. padding(7) = 0
  137. MD5Update 8, padding
  138. End Sub
  139. '
  140. ' Break up input stream into 64 byte chunks
  141. '
  142. Public Sub MD5Update(InputLen As Long, InputBuffer() As Byte)
  143. Dim II As Integer
  144. Dim i As Integer
  145. Dim j As Integer
  146. Dim K As Integer
  147. Dim lngBufferedBytes As Long
  148. Dim lngBufferRemaining As Long
  149. Dim lngRem As Long
  150. lngBufferedBytes = ByteCounter Mod 64
  151. lngBufferRemaining = 64 - lngBufferedBytes
  152. ByteCounter = ByteCounter + InputLen
  153. ' Use up old buffer results first
  154. If InputLen >= lngBufferRemaining Then
  155. For II = 0 To lngBufferRemaining - 1
  156. ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
  157. Next II
  158. MD5Transform ByteBuffer
  159. lngRem = (InputLen) Mod 64
  160. ' The transfer is a multiple of 64 lets do some transformations
  161. For i = lngBufferRemaining To InputLen - II - lngRem Step 64
  162. For j = 0 To 63
  163. ByteBuffer(j) = InputBuffer(i + j)
  164. Next j
  165. MD5Transform ByteBuffer
  166. Next i
  167. lngBufferedBytes = 0
  168. Else
  169. i = 0
  170. End If
  171. ' Buffer any remaining input
  172. For K = 0 To InputLen - i - 1
  173. ByteBuffer(lngBufferedBytes + K) = InputBuffer(i + K)
  174. Next K
  175. End Sub
  176. '
  177. ' MD5 Transform
  178. '
  179. Private Sub MD5Transform(Buffer() As Byte)
  180. Dim x(16) As Long
  181. Dim a As Long
  182. Dim B As Long
  183. Dim c As Long
  184. Dim d As Long
  185. a = State(1)
  186. B = State(2)
  187. c = State(3)
  188. d = State(4)
  189. Decode 64, x, Buffer
  190. ' Round 1
  191. fF a, B, c, d, x(0), S11, -680876936
  192. fF d, a, B, c, x(1), S12, -389564586
  193. fF c, d, a, B, x(2), S13, 606105819
  194. fF B, c, d, a, x(3), S14, -1044525330
  195. fF a, B, c, d, x(4), S11, -176418897
  196. fF d, a, B, c, x(5), S12, 1200080426
  197. fF c, d, a, B, x(6), S13, -1473231341
  198. fF B, c, d, a, x(7), S14, -45705983
  199. fF a, B, c, d, x(8), S11, 1770035416
  200. fF d, a, B, c, x(9), S12, -1958414417
  201. fF c, d, a, B, x(10), S13, -42063
  202. fF B, c, d, a, x(11), S14, -1990404162
  203. fF a, B, c, d, x(12), S11, 1804603682
  204. fF d, a, B, c, x(13), S12, -40341101
  205. fF c, d, a, B, x(14), S13, -1502002290
  206. fF B, c, d, a, x(15), S14, 1236535329
  207. ' Round 2
  208. GG a, B, c, d, x(1), S21, -165796510
  209. GG d, a, B, c, x(6), S22, -1069501632
  210. GG c, d, a, B, x(11), S23, 643717713
  211. GG B, c, d, a, x(0), S24, -373897302
  212. GG a, B, c, d, x(5), S21, -701558691
  213. GG d, a, B, c, x(10), S22, 38016083
  214. GG c, d, a, B, x(15), S23, -660478335
  215. GG B, c, d, a, x(4), S24, -405537848
  216. GG a, B, c, d, x(9), S21, 568446438
  217. GG d, a, B, c, x(14), S22, -1019803690
  218. GG c, d, a, B, x(3), S23, -187363961
  219. GG B, c, d, a, x(8), S24, 1163531501
  220. GG a, B, c, d, x(13), S21, -1444681467
  221. GG d, a, B, c, x(2), S22, -51403784
  222. GG c, d, a, B, x(7), S23, 1735328473
  223. GG B, c, d, a, x(12), S24, -1926607734
  224. ' Round 3
  225. HH a, B, c, d, x(5), S31, -378558
  226. HH d, a, B, c, x(8), S32, -2022574463
  227. HH c, d, a, B, x(11), S33, 1839030562
  228. HH B, c, d, a, x(14), S34, -35309556
  229. HH a, B, c, d, x(1), S31, -1530992060
  230. HH d, a, B, c, x(4), S32, 1272893353
  231. HH c, d, a, B, x(7), S33, -155497632
  232. HH B, c, d, a, x(10), S34, -1094730640
  233. HH a, B, c, d, x(13), S31, 681279174
  234. HH d, a, B, c, x(0), S32, -358537222
  235. HH c, d, a, B, x(3), S33, -722521979
  236. HH B, c, d, a, x(6), S34, 76029189
  237. HH a, B, c, d, x(9), S31, -640364487
  238. HH d, a, B, c, x(12), S32, -421815835
  239. HH c, d, a, B, x(15), S33, 530742520
  240. HH B, c, d, a, x(2), S34, -995338651
  241. ' Round 4
  242. II a, B, c, d, x(0), S41, -198630844
  243. II d, a, B, c, x(7), S42, 1126891415
  244. II c, d, a, B, x(14), S43, -1416354905
  245. II B, c, d, a, x(5), S44, -57434055
  246. II a, B, c, d, x(12), S41, 1700485571
  247. II d, a, B, c, x(3), S42, -1894986606
  248. II c, d, a, B, x(10), S43, -1051523
  249. II B, c, d, a, x(1), S44, -2054922799
  250. II a, B, c, d, x(8), S41, 1873313359
  251. II d, a, B, c, x(15), S42, -30611744
  252. II c, d, a, B, x(6), S43, -1560198380
  253. II B, c, d, a, x(13), S44, 1309151649
  254. II a, B, c, d, x(4), S41, -145523070
  255. II d, a, B, c, x(11), S42, -1120210379
  256. II c, d, a, B, x(2), S43, 718787259
  257. II B, c, d, a, x(9), S44, -343485551

  258. State(1) = LongOverflowAdd(State(1), a)
  259. State(2) = LongOverflowAdd(State(2), B)
  260. State(3) = LongOverflowAdd(State(3), c)
  261. State(4) = LongOverflowAdd(State(4), d)
  262. ' /* Zeroize sensitive information.
  263. '*/
  264. ' MD5_memset ((POINTER)x, 0, sizeof (x));
  265. End Sub
  266. Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte)
  267. Dim intDblIndex As Integer
  268. Dim intByteIndex As Integer
  269. Dim dblSum As Double
  270. intDblIndex = 0
  271. For intByteIndex = 0 To Length - 1 Step 4
  272. dblSum = InputBuffer(intByteIndex) + _
  273. InputBuffer(intByteIndex + 1) * 256# + _
  274. InputBuffer(intByteIndex + 2) * 65536# + _
  275. InputBuffer(intByteIndex + 3) * 16777216#
  276. OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
  277. intDblIndex = intDblIndex + 1
  278. Next intByteIndex
  279. End Sub
  280. '
  281. ' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
  282. ' Rotation is separate from addition to prevent recomputation.
  283. '
  284. Private Function fF(a As Long, _
  285. B As Long, _
  286. c As Long, _
  287. d As Long, _
  288. x As Long, _
  289. S As Long, _
  290. ac As Long) As Long
  291. a = LongOverflowAdd4(a, (B And c) Or (Not (B) And d), x, ac)
  292. a = LongLeftRotate(a, S)
  293. a = LongOverflowAdd(a, B)
  294. End Function
  295. Private Function GG(a As Long, _
  296. B As Long, _
  297. c As Long, _
  298. d As Long, _
  299. x As Long, _
  300. S As Long, _
  301. ac As Long) As Long
  302. a = LongOverflowAdd4(a, (B And d) Or (c And Not (d)), x, ac)
  303. a = LongLeftRotate(a, S)
  304. a = LongOverflowAdd(a, B)
  305. End Function
  306. Private Function HH(a As Long, _
  307. B As Long, _
  308. c As Long, _
  309. d As Long, _
  310. x As Long, _
  311. S As Long, _
  312. ac As Long) As Long
  313. a = LongOverflowAdd4(a, B Xor c Xor d, x, ac)
  314. a = LongLeftRotate(a, S)
  315. a = LongOverflowAdd(a, B)
  316. End Function
  317. Private Function II(a As Long, _
  318. B As Long, _
  319. c As Long, _
  320. d As Long, _
  321. x As Long, _
  322. S As Long, _
  323. ac As Long) As Long
  324. a = LongOverflowAdd4(a, c Xor (B Or Not (d)), x, ac)
  325. a = LongLeftRotate(a, S)
  326. a = LongOverflowAdd(a, B)
  327. End Function
  328. Private Function LongLeftRotate(Value As Long, bits As Long) As Long
  329. Dim lngSign As Long
  330. Dim lngI As Long
  331. bits = bits Mod 32
  332. If bits = 0 Then LongLeftRotate = Value: Exit Function
  333. For lngI = 1 To bits
  334. lngSign = Value And &HC0000000
  335. Value = (Value And &H3FFFFFFF) * 2
  336. Value = Value Or ((lngSign < 0) And 1) Or (CBool(lngSign And _
  337. &H40000000) And &H80000000)
  338. Next
  339. LongLeftRotate = Value
  340. End Function
  341. Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
  342. Dim lngHighWord As Long
  343. Dim lngLowWord As Long
  344. Dim lngOverflow As Long
  345. lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
  346. lngOverflow = lngLowWord \ 65536
  347. lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
  348. LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
  349. End Function
  350. Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
  351. Dim lngHighWord As Long
  352. Dim lngLowWord As Long
  353. Dim lngOverflow As Long
  354. lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
  355. lngOverflow = lngLowWord \ 65536
  356. lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + _
  357. ((Val2 And &HFFFF0000) \ 65536) + _
  358. ((val3 And &HFFFF0000) \ 65536) + _
  359. ((val4 And &HFFFF0000) \ 65536) + _
  360. lngOverflow) And &HFFFF&
  361. LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
  362. End Function
  363. Private Function UnsignedToLong(Value As Double) As Long
  364. If Value < 0 Or Value >= OFFSET_4 Then Error 6
  365. If Value <= MAXINT_4 Then
  366. UnsignedToLong = Value
  367. Else
  368. UnsignedToLong = Value - OFFSET_4
  369. End If
  370. End Function
  371. Private Function LongToUnsigned(Value As Long) As Double
  372. If Value < 0 Then
  373. LongToUnsigned = Value + OFFSET_4
  374. Else
  375. LongToUnsigned = Value
  376. End If
  377. End Function

  378. '上面为MD5的函数方法



复制代码
以下是MD5的应用


  1. '以下是MD5的应用
  2. Test_Num = "I LOVE ASP"
  3. '随便定义了一个变量
  4. MsgBox "I LOVE ASP 经过MD5加密后的结果为[" & DigestStrToHexStr(Test_Num) & "]"
复制代码

2#

学习学习。。

3#
4#


发新话题 回复该主题