md5.bas

Powerbasic 里使用MD5加密!

#COMPILE EXE
#DIM ALL
#include "Win32api.inc"

%BITS_TO_A_BYTE  = 8
%BYTES_TO_A_WORD  = 4
%BITS_TO_A_WORD  = 32
%S11 = 7
%S12 = 12
%S13 = 17
%S14 = 22
%S21 = 5
%S22 = 9
%S23 = 14
%S24 = 20
%S31 = 4
%S32 = 11
%S33 = 16
%S34 = 23
%S41 = 6
%S42 = 10
%S43 = 15
%S44 = 21
global m_lOnBits() As Long
global m_l2Power() As Long

Function LShift(lValue As Long, iShiftBits As Long) As Long
    If iShiftBits = 0 Then
        LShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        'Err.Raise 6
    End If

    If (lValue And m_l2Power(31 - iShiftBits)) Then
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
    Else
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    End If
End Function

Function RShift(lValue As Long, iShiftBits As Long) As Long
	dim aa as long
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        'Err.Raise 6
    End If

    aa = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then
        function = (aa Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function

Function RotateLeft(lValue As Long, iShiftBits As Long) As Long
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

Function AddUnsigned(lX As Long, lY As Long) As Long
Dim lX4 As Long
Dim lY4 As Long
Dim lX8 As Long
Dim lY8 As Long
Dim lResult As Long

    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If

    AddUnsigned = lResult
End Function

Function md5_F(X As Long, Y As Long, z As Long) As Long
    md5_F = (X And Y) Or ((Not X) And z)
End Function

Function md5_G(X As Long, Y As Long, z As Long) As Long
    md5_G = (X And z) Or (Y And (Not z))
End Function

Function md5_H(X As Long, Y As Long, z As Long) As Long
    md5_H = (X Xor Y Xor z)
End Function

Function md5_I(X As Long, Y As Long, z As Long) As Long
    md5_I = (Y Xor (X Or (Not z)))
End Function

Sub md5_FF(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), X), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Sub md5_GG(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), X), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Sub md5_HH(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), X), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Sub md5_II(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), X), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

'Function ConvertToWordArray(ByVal sMessage As String) As long
'Dim lMessageLength As Long
'Dim lNumberOfWords As Long
'Dim lWordArray() As Long
'Dim lBytePosition As Long
'Dim lByteCount As Long
'Dim lWordCount As Long

'%MODULUS_BITS = 512
'%CONGRUENT_BITS = 448

'    lMessageLength = Len(sMessage)

'    lNumberOfWords = (((lMessageLength + ((%MODULUS_BITS - %CONGRUENT_BITS) \ %BITS_TO_A_BYTE)) \ (%MODULUS_BITS \ %BITS_TO_A_BYTE)) + 1) * (%MODULUS_BITS \ %BITS_TO_A_WORD)
'    ReDim lWordArray(lNumberOfWords - 1)

'    lBytePosition = 0
'    lByteCount = 0
'    Do Until lByteCount >= lMessageLength
'        lWordCount = lByteCount \ %BYTES_TO_A_WORD
'        lBytePosition = (lByteCount Mod %BYTES_TO_A_WORD) * %BITS_TO_A_BYTE
'        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid$(sMessage, lByteCount + 1, 1)), lBytePosition)
'        lByteCount = lByteCount + 1
'    Loop

'    lWordCount = lByteCount \ %BYTES_TO_A_WORD
'    lBytePosition = (lByteCount Mod %BYTES_TO_A_WORD) * %BITS_TO_A_BYTE

'    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

'    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
'    lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

'    return lWordArray
'End Function

Function WordToHex(lValue As Long) As String
	dim aa as STRING
	Dim lByte As Long
	Dim lCount As Long

    For lCount = 0 To 3
        lByte = RShift(lValue, lCount * %BITS_TO_A_BYTE) And m_lOnBits(%BITS_TO_A_BYTE - 1)
        aa = aa & Right$("0" & Hex$(lByte), 2)
    Next
	function=aa
End Function

Function MD5(ByVal sMessage As String, Optional Bit16 As LONG) AS STRING
	redim m_lOnBits(30)
	redim m_l2Power(30)

    m_lOnBits(0) = CLng(1)
    m_lOnBits(1) = CLng(3)
    m_lOnBits(2) = CLng(7)
    m_lOnBits(3) = CLng(15)
    m_lOnBits(4) = CLng(31)
    m_lOnBits(5) = CLng(63)
    m_lOnBits(6) = CLng(127)
    m_lOnBits(7) = CLng(255)
    m_lOnBits(8) = CLng(511)
    m_lOnBits(9) = CLng(1023)
    m_lOnBits(10) = CLng(2047)
    m_lOnBits(11) = CLng(4095)
    m_lOnBits(12) = CLng(8191)
    m_lOnBits(13) = CLng(16383)
    m_lOnBits(14) = CLng(32767)
    m_lOnBits(15) = CLng(65535)
    m_lOnBits(16) = CLng(131071)
    m_lOnBits(17) = CLng(262143)
    m_lOnBits(18) = CLng(524287)
    m_lOnBits(19) = CLng(1048575)
    m_lOnBits(20) = CLng(2097151)
    m_lOnBits(21) = CLng(4194303)
    m_lOnBits(22) = CLng(8388607)
    m_lOnBits(23) = CLng(16777215)
    m_lOnBits(24) = CLng(33554431)
    m_lOnBits(25) = CLng(67108863)
    m_lOnBits(26) = CLng(134217727)
    m_lOnBits(27) = CLng(268435455)
    m_lOnBits(28) = CLng(536870911)
    m_lOnBits(29) = CLng(1073741823)
    m_lOnBits(30) = CLng(2147483647)

    m_l2Power(0) = CLng(1)
    m_l2Power(1) = CLng(2)
    m_l2Power(2) = CLng(4)
    m_l2Power(3) = CLng(8)
    m_l2Power(4) = CLng(16)
    m_l2Power(5) = CLng(32)
    m_l2Power(6) = CLng(64)
    m_l2Power(7) = CLng(128)
    m_l2Power(8) = CLng(256)
    m_l2Power(9) = CLng(512)
    m_l2Power(10) = CLng(1024)
    m_l2Power(11) = CLng(2048)
    m_l2Power(12) = CLng(4096)
    m_l2Power(13) = CLng(8192)
    m_l2Power(14) = CLng(16384)
    m_l2Power(15) = CLng(32768)
    m_l2Power(16) = CLng(65536)
    m_l2Power(17) = CLng(131072)
    m_l2Power(18) = CLng(262144)
    m_l2Power(19) = CLng(524288)
    m_l2Power(20) = CLng(1048576)
    m_l2Power(21) = CLng(2097152)
    m_l2Power(22) = CLng(4194304)
    m_l2Power(23) = CLng(8388608)
    m_l2Power(24) = CLng(16777216)
    m_l2Power(25) = CLng(33554432)
    m_l2Power(26) = CLng(67108864)
    m_l2Power(27) = CLng(134217728)
    m_l2Power(28) = CLng(268435456)
    m_l2Power(29) = CLng(536870912)
    m_l2Power(30) = CLng(1073741824)


    Dim X() As Long
    Dim k As Long
    Dim AA As Long
    Dim BB As Long
    Dim CC As Long
    Dim DD As Long
    Dim a As Long
    Dim b As Long
    Dim c As Long
    Dim d As Long


	Dim lMessageLength As Long
	Dim lNumberOfWords As Long
	Dim lBytePosition As Long
	Dim lByteCount As Long
	Dim lWordCount As Long

	%MODULUS_BITS = 512
	%CONGRUENT_BITS = 448

		lMessageLength = Len(sMessage)

		lNumberOfWords = (((lMessageLength + ((%MODULUS_BITS - %CONGRUENT_BITS) \ %BITS_TO_A_BYTE)) \ (%MODULUS_BITS \ %BITS_TO_A_BYTE)) + 1) * (%MODULUS_BITS \ %BITS_TO_A_WORD)
		ReDim X(lNumberOfWords - 1)

		lBytePosition = 0
		lByteCount = 0
		Do Until lByteCount >= lMessageLength
			lWordCount = lByteCount \ %BYTES_TO_A_WORD
			lBytePosition = (lByteCount Mod %BYTES_TO_A_WORD) * %BITS_TO_A_BYTE
			X(lWordCount) = X(lWordCount) Or LShift(Asc(Mid$(sMessage, lByteCount + 1, 1)), lBytePosition)
			lByteCount = lByteCount + 1
		Loop

		lWordCount = lByteCount \ %BYTES_TO_A_WORD
		lBytePosition = (lByteCount Mod %BYTES_TO_A_WORD) * %BITS_TO_A_BYTE

		X(lWordCount) = X(lWordCount) Or LShift(&H80, lBytePosition)

		X(lNumberOfWords - 2) = LShift(lMessageLength, 3)
		X(lNumberOfWords - 1) = RShift(lMessageLength, 29)


    a = &H67452301
    b = &HEFCDAB89
    c = &H98BADCFE
    d = &H10325476

    For k = 0 To UBound(X) Step 16
        AA = a
        BB = b
        CC = c
        DD = d

        md5_FF a, b, c, d, X(k + 0), %S11, &HD76AA478
        md5_FF d, a, b, c, X(k + 1), %S12, &HE8C7B756
        md5_FF c, d, a, b, X(k + 2), %S13, &H242070DB
        md5_FF b, c, d, a, X(k + 3), %S14, &HC1BDCEEE
        md5_FF a, b, c, d, X(k + 4), %S11, &HF57C0FAF
        md5_FF d, a, b, c, X(k + 5), %S12, &H4787C62A
        md5_FF c, d, a, b, X(k + 6), %S13, &HA8304613
        md5_FF b, c, d, a, X(k + 7), %S14, &HFD469501
        md5_FF a, b, c, d, X(k + 8), %S11, &H698098D8
        md5_FF d, a, b, c, X(k + 9), %S12, &H8B44F7AF
        md5_FF c, d, a, b, X(k + 10), %S13, &HFFFF5BB1
        md5_FF b, c, d, a, X(k + 11), %S14, &H895CD7BE
        md5_FF a, b, c, d, X(k + 12), %S11, &H6B901122
        md5_FF d, a, b, c, X(k + 13), %S12, &HFD987193
        md5_FF c, d, a, b, X(k + 14), %S13, &HA679438E
        md5_FF b, c, d, a, X(k + 15), %S14, &H49B40821

        md5_GG a, b, c, d, X(k + 1), %S21, &HF61E2562
        md5_GG d, a, b, c, X(k + 6), %S22, &HC040B340
        md5_GG c, d, a, b, X(k + 11), %S23, &H265E5A51
        md5_GG b, c, d, a, X(k + 0), %S24, &HE9B6C7AA
        md5_GG a, b, c, d, X(k + 5), %S21, &HD62F105D
        md5_GG d, a, b, c, X(k + 10), %S22, &H2441453
        md5_GG c, d, a, b, X(k + 15), %S23, &HD8A1E681
        md5_GG b, c, d, a, X(k + 4), %S24, &HE7D3FBC8
        md5_GG a, b, c, d, X(k + 9), %S21, &H21E1CDE6
        md5_GG d, a, b, c, X(k + 14), %S22, &HC33707D6
        md5_GG c, d, a, b, X(k + 3), %S23, &HF4D50D87
        md5_GG b, c, d, a, X(k + 8), %S24, &H455A14ED
        md5_GG a, b, c, d, X(k + 13), %S21, &HA9E3E905
        md5_GG d, a, b, c, X(k + 2), %S22, &HFCEFA3F8
        md5_GG c, d, a, b, X(k + 7), %S23, &H676F02D9
        md5_GG b, c, d, a, X(k + 12), %S24, &H8D2A4C8A

        md5_HH a, b, c, d, X(k + 5), %S31, &HFFFA3942
        md5_HH d, a, b, c, X(k + 8), %S32, &H8771F681
        md5_HH c, d, a, b, X(k + 11), %S33, &H6D9D6122
        md5_HH b, c, d, a, X(k + 14), %S34, &HFDE5380C
        md5_HH a, b, c, d, X(k + 1), %S31, &HA4BEEA44
        md5_HH d, a, b, c, X(k + 4), %S32, &H4BDECFA9
        md5_HH c, d, a, b, X(k + 7), %S33, &HF6BB4B60
        md5_HH b, c, d, a, X(k + 10), %S34, &HBEBFBC70
        md5_HH a, b, c, d, X(k + 13), %S31, &H289B7EC6
        md5_HH d, a, b, c, X(k + 0), %S32, &HEAA127FA
        md5_HH c, d, a, b, X(k + 3), %S33, &HD4EF3085
        md5_HH b, c, d, a, X(k + 6), %S34, &H4881D05
        md5_HH a, b, c, d, X(k + 9), %S31, &HD9D4D039
        md5_HH d, a, b, c, X(k + 12), %S32, &HE6DB99E5
        md5_HH c, d, a, b, X(k + 15), %S33, &H1FA27CF8
        md5_HH b, c, d, a, X(k + 2), %S34, &HC4AC5665

        md5_II a, b, c, d, X(k + 0), %S41, &HF4292244
        md5_II d, a, b, c, X(k + 7), %S42, &H432AFF97
        md5_II c, d, a, b, X(k + 14), %S43, &HAB9423A7
        md5_II b, c, d, a, X(k + 5), %S44, &HFC93A039
        md5_II a, b, c, d, X(k + 12), %S41, &H655B59C3
        md5_II d, a, b, c, X(k + 3), %S42, &H8F0CCC92
        md5_II c, d, a, b, X(k + 10), %S43, &HFFEFF47D
        md5_II b, c, d, a, X(k + 1), %S44, &H85845DD1
        md5_II a, b, c, d, X(k + 8), %S41, &H6FA87E4F
        md5_II d, a, b, c, X(k + 15), %S42, &HFE2CE6E0
        md5_II c, d, a, b, X(k + 6), %S43, &HA3014314
        md5_II b, c, d, a, X(k + 13), %S44, &H4E0811A1
        md5_II a, b, c, d, X(k + 4), %S41, &HF7537E82
        md5_II d, a, b, c, X(k + 11), %S42, &HBD3AF235
        md5_II c, d, a, b, X(k + 2), %S43, &H2AD7D2BB
        md5_II b, c, d, a, X(k + 9), %S44, &HEB86D391

        a = AddUnsigned(a, AA)
        b = AddUnsigned(b, BB)
        c = AddUnsigned(c, CC)
        d = AddUnsigned(d, DD)
    Next
   dim aaString as string
    If Bit16 Then
        aaString = LCase$(WordToHex(b) & WordToHex(c))    '16bit
    Else
        aaString = LCase$(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))    '32bit
    End If
    Mid$(aaString, (Len(sMessage) Mod 16), 1) = "l"
End Function


FUNCTION WINMAIN (BYVAL hDlg AS DWORD, _
                  BYVAL wMsg AS DWORD, _
                  BYVAL wParam AS ASCIIZ PTR, _
                  BYVAL lParam AS LONG) AS LONG
    msgbox md5("123456")
END FUNCTION