home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / VPS_-_Vari179129992004.psc / Modules / MD5.bas next >
BASIC Source File  |  2004-08-27  |  13KB  |  396 lines
  1. Attribute VB_Name = "modMD5"
  2. Option Explicit
  3.  
  4. Private lngTrack As Long
  5. Private arrLongConversion(4) As Long
  6. Private arrSplit64(63) As Byte
  7.  
  8. Private Const OFFSET_4 = 4294967296#
  9. Private Const MAXINT_4 = 2147483647
  10.  
  11. Private Const S11 = 7
  12. Private Const S12 = 12
  13. Private Const S13 = 17
  14. Private Const S14 = 22
  15. Private Const S21 = 5
  16. Private Const S22 = 9
  17. Private Const S23 = 14
  18. Private Const S24 = 20
  19. Private Const S31 = 4
  20. Private Const S32 = 11
  21. Private Const S33 = 16
  22. Private Const S34 = 23
  23. Private Const S41 = 6
  24. Private Const S42 = 10
  25. Private Const S43 = 15
  26. Private Const S44 = 21
  27.  
  28. Private Function MD5Round(strRound As String, a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long) As Long
  29.  
  30.     Select Case strRound
  31.     
  32.         Case Is = "FF"
  33.             a = MD5LongAdd4(a, (b And c) Or (Not (b) And d), X, ac)
  34.             a = MD5Rotate(a, s)
  35.             a = MD5LongAdd(a, b)
  36.         
  37.         Case Is = "GG"
  38.             a = MD5LongAdd4(a, (b And d) Or (c And Not (d)), X, ac)
  39.             a = MD5Rotate(a, s)
  40.             a = MD5LongAdd(a, b)
  41.             
  42.         Case Is = "HH"
  43.             a = MD5LongAdd4(a, b Xor c Xor d, X, ac)
  44.             a = MD5Rotate(a, s)
  45.             a = MD5LongAdd(a, b)
  46.             
  47.         Case Is = "II"
  48.             a = MD5LongAdd4(a, c Xor (b Or Not (d)), X, ac)
  49.             a = MD5Rotate(a, s)
  50.             a = MD5LongAdd(a, b)
  51.             
  52.     End Select
  53.     
  54. End Function
  55.  
  56. Private Function MD5Rotate(lngValue As Long, lngBits As Long) As Long
  57.     
  58.     Dim lngSign As Long
  59.     Dim lngI As Long
  60.     
  61.     lngBits = (lngBits Mod 32)
  62.     
  63.     If lngBits = 0 Then MD5Rotate = lngValue: Exit Function
  64.     
  65.     For lngI = 1 To lngBits
  66.         lngSign = lngValue And &HC0000000
  67.         lngValue = (lngValue And &H3FFFFFFF) * 2
  68.         lngValue = lngValue Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
  69.     Next
  70.     
  71.     MD5Rotate = lngValue
  72.  
  73. End Function
  74.  
  75. Private Function TRID() As String
  76.  
  77.     Dim sngNum As Single, lngnum As Long
  78.     Dim strResult As String
  79.    
  80.     sngNum = Rnd(2147483648#)
  81.     strResult = CStr(sngNum)
  82.     
  83.     strResult = Replace(strResult, "0.", "")
  84.     strResult = Replace(strResult, ".", "")
  85.     strResult = Replace(strResult, "E-", "")
  86.     
  87.     TRID = strResult
  88.  
  89. End Function
  90.  
  91. Private Function MD564Split(lngLength As Long, bytBuffer() As Byte) As String
  92.  
  93.     Dim lngBytesTotal As Long, lngBytesToAdd As Long
  94.     Dim intLoop As Integer, intLoop2 As Integer, lngTrace As Long
  95.     Dim intInnerLoop As Integer, intLoop3 As Integer
  96.     
  97.     lngBytesTotal = lngTrack Mod 64
  98.     lngBytesToAdd = 64 - lngBytesTotal
  99.     lngTrack = (lngTrack + lngLength)
  100.     
  101.     If lngLength >= lngBytesToAdd Then
  102.         For intLoop = 0 To lngBytesToAdd - 1
  103.             arrSplit64(lngBytesTotal + intLoop) = bytBuffer(intLoop)
  104.         Next intLoop
  105.         
  106.         MD5Conversion arrSplit64
  107.         
  108.         lngTrace = (lngLength) Mod 64
  109.  
  110.         For intLoop2 = lngBytesToAdd To lngLength - intLoop - lngTrace Step 64
  111.             For intInnerLoop = 0 To 63
  112.                 arrSplit64(intInnerLoop) = bytBuffer(intLoop2 + intInnerLoop)
  113.             Next intInnerLoop
  114.             
  115.             MD5Conversion arrSplit64
  116.         
  117.         Next intLoop2
  118.         
  119.         lngBytesTotal = 0
  120.     Else
  121.     
  122.       intLoop2 = 0
  123.     
  124.     End If
  125.     
  126.     For intLoop3 = 0 To lngLength - intLoop2 - 1
  127.         
  128.         arrSplit64(lngBytesTotal + intLoop3) = bytBuffer(intLoop2 + intLoop3)
  129.     
  130.     Next intLoop3
  131.      
  132. End Function
  133.  
  134. Private Function MD5StringArray(strInput As String) As Byte()
  135.     
  136.     Dim intLoop As Integer
  137.     Dim bytBuffer() As Byte
  138.     ReDim bytBuffer(Len(strInput))
  139.     
  140.     For intLoop = 0 To Len(strInput) - 1
  141.         bytBuffer(intLoop) = Asc(Mid(strInput, intLoop + 1, 1))
  142.     Next intLoop
  143.     
  144.     MD5StringArray = bytBuffer
  145.     
  146. End Function
  147.  
  148. Private Sub MD5Conversion(bytBuffer() As Byte)
  149.  
  150.     Dim X(16) As Long, a As Long
  151.     Dim b As Long, c As Long
  152.     Dim d As Long
  153.     
  154.     a = arrLongConversion(1)
  155.     b = arrLongConversion(2)
  156.     c = arrLongConversion(3)
  157.     d = arrLongConversion(4)
  158.     
  159.     MD5Decode 64, X, bytBuffer
  160.     
  161.     MD5Round "FF", a, b, c, d, X(0), S11, -680876936
  162.     MD5Round "FF", d, a, b, c, X(1), S12, -389564586
  163.     MD5Round "FF", c, d, a, b, X(2), S13, 606105819
  164.     MD5Round "FF", b, c, d, a, X(3), S14, -1044525330
  165.     MD5Round "FF", a, b, c, d, X(4), S11, -176418897
  166.     MD5Round "FF", d, a, b, c, X(5), S12, 1200080426
  167.     MD5Round "FF", c, d, a, b, X(6), S13, -1473231341
  168.     MD5Round "FF", b, c, d, a, X(7), S14, -45705983
  169.     MD5Round "FF", a, b, c, d, X(8), S11, 1770035416
  170.     MD5Round "FF", d, a, b, c, X(9), S12, -1958414417
  171.     MD5Round "FF", c, d, a, b, X(10), S13, -42063
  172.     MD5Round "FF", b, c, d, a, X(11), S14, -1990404162
  173.     MD5Round "FF", a, b, c, d, X(12), S11, 1804603682
  174.     MD5Round "FF", d, a, b, c, X(13), S12, -40341101
  175.     MD5Round "FF", c, d, a, b, X(14), S13, -1502002290
  176.     MD5Round "FF", b, c, d, a, X(15), S14, 1236535329
  177.  
  178.     MD5Round "GG", a, b, c, d, X(1), S21, -165796510
  179.     MD5Round "GG", d, a, b, c, X(6), S22, -1069501632
  180.     MD5Round "GG", c, d, a, b, X(11), S23, 643717713
  181.     MD5Round "GG", b, c, d, a, X(0), S24, -373897302
  182.     MD5Round "GG", a, b, c, d, X(5), S21, -701558691
  183.     MD5Round "GG", d, a, b, c, X(10), S22, 38016083
  184.     MD5Round "GG", c, d, a, b, X(15), S23, -660478335
  185.     MD5Round "GG", b, c, d, a, X(4), S24, -405537848
  186.     MD5Round "GG", a, b, c, d, X(9), S21, 568446438
  187.     MD5Round "GG", d, a, b, c, X(14), S22, -1019803690
  188.     MD5Round "GG", c, d, a, b, X(3), S23, -187363961
  189.     MD5Round "GG", b, c, d, a, X(8), S24, 1163531501
  190.     MD5Round "GG", a, b, c, d, X(13), S21, -1444681467
  191.     MD5Round "GG", d, a, b, c, X(2), S22, -51403784
  192.     MD5Round "GG", c, d, a, b, X(7), S23, 1735328473
  193.     MD5Round "GG", b, c, d, a, X(12), S24, -1926607734
  194.   
  195.     MD5Round "HH", a, b, c, d, X(5), S31, -378558
  196.     MD5Round "HH", d, a, b, c, X(8), S32, -2022574463
  197.     MD5Round "HH", c, d, a, b, X(11), S33, 1839030562
  198.     MD5Round "HH", b, c, d, a, X(14), S34, -35309556
  199.     MD5Round "HH", a, b, c, d, X(1), S31, -1530992060
  200.     MD5Round "HH", d, a, b, c, X(4), S32, 1272893353
  201.     MD5Round "HH", c, d, a, b, X(7), S33, -155497632
  202.     MD5Round "HH", b, c, d, a, X(10), S34, -1094730640
  203.     MD5Round "HH", a, b, c, d, X(13), S31, 681279174
  204.     MD5Round "HH", d, a, b, c, X(0), S32, -358537222
  205.     MD5Round "HH", c, d, a, b, X(3), S33, -722521979
  206.     MD5Round "HH", b, c, d, a, X(6), S34, 76029189
  207.     MD5Round "HH", a, b, c, d, X(9), S31, -640364487
  208.     MD5Round "HH", d, a, b, c, X(12), S32, -421815835
  209.     MD5Round "HH", c, d, a, b, X(15), S33, 530742520
  210.     MD5Round "HH", b, c, d, a, X(2), S34, -995338651
  211.  
  212.     MD5Round "II", a, b, c, d, X(0), S41, -198630844
  213.     MD5Round "II", d, a, b, c, X(7), S42, 1126891415
  214.     MD5Round "II", c, d, a, b, X(14), S43, -1416354905
  215.     MD5Round "II", b, c, d, a, X(5), S44, -57434055
  216.     MD5Round "II", a, b, c, d, X(12), S41, 1700485571
  217.     MD5Round "II", d, a, b, c, X(3), S42, -1894986606
  218.     MD5Round "II", c, d, a, b, X(10), S43, -1051523
  219.     MD5Round "II", b, c, d, a, X(1), S44, -2054922799
  220.     MD5Round "II", a, b, c, d, X(8), S41, 1873313359
  221.     MD5Round "II", d, a, b, c, X(15), S42, -30611744
  222.     MD5Round "II", c, d, a, b, X(6), S43, -1560198380
  223.     MD5Round "II", b, c, d, a, X(13), S44, 1309151649
  224.     MD5Round "II", a, b, c, d, X(4), S41, -145523070
  225.     MD5Round "II", d, a, b, c, X(11), S42, -1120210379
  226.     MD5Round "II", c, d, a, b, X(2), S43, 718787259
  227.     MD5Round "II", b, c, d, a, X(9), S44, -343485551
  228.     
  229.     arrLongConversion(1) = MD5LongAdd(arrLongConversion(1), a)
  230.     arrLongConversion(2) = MD5LongAdd(arrLongConversion(2), b)
  231.     arrLongConversion(3) = MD5LongAdd(arrLongConversion(3), c)
  232.     arrLongConversion(4) = MD5LongAdd(arrLongConversion(4), d)
  233.     
  234. End Sub
  235.  
  236. Private Function MD5LongAdd(lngVal1 As Long, lngVal2 As Long) As Long
  237.     
  238.     Dim lngHighWord As Long
  239.     Dim lngLowWord As Long
  240.     Dim lngOverflow As Long
  241.  
  242.     lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&)
  243.     lngOverflow = lngLowWord \ 65536
  244.     lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
  245.     
  246.     MD5LongAdd = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
  247.  
  248. End Function
  249.  
  250. Private Function MD5LongAdd4(lngVal1 As Long, lngVal2 As Long, lngVal3 As Long, lngVal4 As Long) As Long
  251.     
  252.     Dim lngHighWord As Long
  253.     Dim lngLowWord As Long
  254.     Dim lngOverflow As Long
  255.  
  256.     lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&) + (lngVal3 And &HFFFF&) + (lngVal4 And &HFFFF&)
  257.     lngOverflow = lngLowWord \ 65536
  258.     lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + ((lngVal3 And &HFFFF0000) \ 65536) + ((lngVal4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
  259.     MD5LongAdd4 = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
  260.  
  261. End Function
  262.  
  263. Private Sub MD5Decode(intLength As Integer, lngOutBuffer() As Long, bytInBuffer() As Byte)
  264.     
  265.     Dim intDblIndex As Integer
  266.     Dim intByteIndex As Integer
  267.     Dim dblSum As Double
  268.     
  269.     intDblIndex = 0
  270.     
  271.     For intByteIndex = 0 To intLength - 1 Step 4
  272.         
  273.         dblSum = bytInBuffer(intByteIndex) + bytInBuffer(intByteIndex + 1) * 256# + bytInBuffer(intByteIndex + 2) * 65536# + bytInBuffer(intByteIndex + 3) * 16777216#
  274.         lngOutBuffer(intDblIndex) = MD5LongConversion(dblSum)
  275.         intDblIndex = (intDblIndex + 1)
  276.     
  277.     Next intByteIndex
  278.  
  279. End Sub
  280.  
  281. Private Function MD5LongConversion(dblValue As Double) As Long
  282.     
  283.     If dblValue < 0 Or dblValue >= OFFSET_4 Then Error 6
  284.         
  285.     If dblValue <= MAXINT_4 Then
  286.         MD5LongConversion = dblValue
  287.     Else
  288.         MD5LongConversion = dblValue - OFFSET_4
  289.     End If
  290.         
  291. End Function
  292.  
  293. Private Sub MD5Finish()
  294.     
  295.     Dim dblBits As Double
  296.     Dim arrPadding(72) As Byte
  297.     Dim lngBytesBuffered As Long
  298.     
  299.     arrPadding(0) = &H80
  300.     
  301.     dblBits = lngTrack * 8
  302.     
  303.     lngBytesBuffered = lngTrack Mod 64
  304.     
  305.     If lngBytesBuffered <= 56 Then
  306.         MD564Split (56 - lngBytesBuffered), arrPadding
  307.     Else
  308.         MD564Split (120 - lngTrack), arrPadding
  309.     End If
  310.     
  311.     
  312.     arrPadding(0) = MD5LongConversion(dblBits) And &HFF&
  313.     arrPadding(1) = MD5LongConversion(dblBits) \ 256 And &HFF&
  314.     arrPadding(2) = MD5LongConversion(dblBits) \ 65536 And &HFF&
  315.     arrPadding(3) = MD5LongConversion(dblBits) \ 16777216 And &HFF&
  316.     arrPadding(4) = 0
  317.     arrPadding(5) = 0
  318.     arrPadding(6) = 0
  319.     arrPadding(7) = 0
  320.     
  321.     MD564Split 8, arrPadding
  322.     
  323. End Sub
  324.  
  325. Private Function MD5StringChange(lngnum As Long) As String
  326.         
  327.         Dim bytA As Byte
  328.         Dim bytB As Byte
  329.         Dim bytC As Byte
  330.         Dim bytD As Byte
  331.         
  332.         bytA = lngnum And &HFF&
  333.         If bytA < 16 Then
  334.             MD5StringChange = "0" & Hex(bytA)
  335.         Else
  336.             MD5StringChange = Hex(bytA)
  337.         End If
  338.                
  339.         bytB = (lngnum And &HFF00&) \ 256
  340.         If bytB < 16 Then
  341.             MD5StringChange = MD5StringChange & "0" & Hex(bytB)
  342.         Else
  343.             MD5StringChange = MD5StringChange & Hex(bytB)
  344.         End If
  345.         
  346.         bytC = (lngnum And &HFF0000) \ 65536
  347.         If bytC < 16 Then
  348.             MD5StringChange = MD5StringChange & "0" & Hex(bytC)
  349.         Else
  350.             MD5StringChange = MD5StringChange & Hex(bytC)
  351.         End If
  352.        
  353.         If lngnum < 0 Then
  354.             bytD = ((lngnum And &H7F000000) \ 16777216) Or &H80&
  355.         Else
  356.             bytD = (lngnum And &HFF000000) \ 16777216
  357.         End If
  358.         
  359.         If bytD < 16 Then
  360.             MD5StringChange = MD5StringChange & "0" & Hex(bytD)
  361.         Else
  362.             MD5StringChange = MD5StringChange & Hex(bytD)
  363.         End If
  364.  
  365. End Function
  366.  
  367. Private Function MD5Value() As String
  368.  
  369.     MD5Value = LCase(MD5StringChange(arrLongConversion(1)) & MD5StringChange(arrLongConversion(2)) & MD5StringChange(arrLongConversion(3)) & MD5StringChange(arrLongConversion(4)))
  370.  
  371. End Function
  372.  
  373. Public Function CalculateMD5(strMessage As String) As String
  374.  
  375.     Dim bytBuffer() As Byte
  376.     
  377.     bytBuffer = MD5StringArray(strMessage)
  378.     
  379.     MD5Start
  380.     MD564Split Len(strMessage), bytBuffer
  381.     MD5Finish
  382.     
  383.     CalculateMD5 = MD5Value
  384.     
  385. End Function
  386.  
  387. Private Sub MD5Start()
  388.  
  389.     lngTrack = 0
  390.     arrLongConversion(1) = MD5LongConversion(1732584193#)
  391.     arrLongConversion(2) = MD5LongConversion(4023233417#)
  392.     arrLongConversion(3) = MD5LongConversion(2562383102#)
  393.     arrLongConversion(4) = MD5LongConversion(271733878#)
  394.     
  395. End Sub
  396.