【转载 / 源码】MD5加密的VB类模块源码

LucasLynn

标 题:改了个MD5的VB类模块源码,可支持中文,也没有网上流传的那个超过16位就错了的毛病! (11千字)

发信人:simonyan

时 间:2002-11-4 14:31:00

详细信息:

<BLOCKQUOTE>那个网上的MD5.BAS我研究了下,有严重问题.只好另找了个自已改了下.

在窗体中调用时如下:

Dim md5 As New class 'class 为你存的类模快名

Text1.Value=md5.MD5_string_calc(sourcestring)



类模块源码如下:









<DIV class=quote>Option Explicit



' Visual Basic MD5 Implementation

' Robert Hubley and David Midkiff (mdj2023@hotmail.com)

' modify by simonyan, Support chinese

' Standard MD5 implementation optimised for the Visual Basic environment.

' Conforms to all standards and can be used in digital signature or password

' protection related schemes.



Private Const OFFSET_4 = 4294967296#

Private Const MAXINT_4 = 2147483647

Private State(4) As Long

Private ByteCounter As Long

Private ByteBuffer(63) As Byte

Private Const S11 = 7

Private Const S12 = 12

Private Const S13 = 17

Private Const S14 = 22

Private Const S21 = 5

Private Const S22 = 9

Private Const S23 = 14

Private Const S24 = 20

Private Const S31 = 4

Private Const S32 = 11

Private Const S33 = 16

Private Const S34 = 23

Private Const S41 = 6

Private Const S42 = 10

Private Const S43 = 15

Private Const S44 = 21

Property Get RegisterA() As String

    RegisterA = State(1)

End Property

Property Get RegisterB() As String

    RegisterB = State(2)

End Property



Property Get RegisterC() As String

    RegisterC = State(3)

End Property



Property Get RegisterD() As String

    RegisterD = State(4)

End Property

Public Function Md5_String_Calc(SourceString As String) As String

    MD5Init

    MD5Update LenB(StrConv(SourceString, vbFromUnicode)), StringToArray(SourceString)

    MD5Final

    Md5_String_Calc = GetValues

End Function

Public Function Md5_File_Calc(InFile As String) As String

On Error GoTo errorhandler

GoSub begin



errorhandler

    DigestFileToHexStr = ""

    Exit Function

   

begin:

    Dim FileO As Integer

    FileO = FreeFile

    Call FileLen(InFile)

    Open InFile For Binary Access Read As #FileO

    MD5Init

    Do While Not EOF(FileO)

        Get #FileO, , ByteBuffer

        If Loc(FileO) < LOF(FileO) Then

            ByteCounter = ByteCounter + 64

            MD5Transform ByteBuffer

        End If

    Loop

    ByteCounter = ByteCounter + (LOF(FileO) Mod 64)

    Close #FileO

    MD5Final

    Md5_File_Calc = GetValues

End Function

Private Function StringToArray(InString As String) As Byte()

    Dim I As Integer, bytBuffer() As Byte

    ReDim bytBuffer(LenB(StrConv(InString, vbFromUnicode)))

    bytBuffer = StrConv(InString, vbFromUnicode)

    StringToArray = bytBuffer

End Function

Public Function GetValues() As String

    GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))

End Function

Private Function LongToString(Num As Long) As String

        Dim A As Byte, B As Byte, C As Byte, D As Byte

        A = Num And &HFF&

        If A < 16 Then LongToString = "0" & Hex(A) Else LongToString = Hex(A)

        B = (Num And &HFF00&) \ 256

        If B < 16 Then LongToString = LongToString & "0" & Hex(B) Else LongToString = LongToString & Hex(B)

        C = (Num And &HFF0000) \ 65536

        If C < 16 Then LongToString = LongToString & "0" & Hex(C) Else LongToString = LongToString & Hex(C)

        If Num < 0 Then D = ((Num And &H7F000000) \ 16777216) Or &H80& Else D = (Num And &HFF000000) \ 16777216

        If D < 16 Then LongToString = LongToString & "0" & Hex(D) Else LongToString = LongToString & Hex(D)

End Function



Public Sub MD5Init()

    ByteCounter = 0

    State(1) = UnsignedToLong(1732584193#)

    State(2) = UnsignedToLong(4023233417#)

    State(3) = UnsignedToLong

GOODWIN

谢谢分享

使者

谢谢分享

李力军2

请教,可以给存放在硬盘上的文件,进行MD5加密吗?我的意思是,别人修改后,通过MD5函数我可以知道被变更过了.谢谢!

李力军2

学习啦

aodou51899

支持，顶一下

xlonger

Option Compare Database
Option Explicit

'根据编译提示，我改了一下代码，通过编译，请高手复核检查。

'Private Sub Form_Current()
'Dim c1 As New MD5 'MD5是你存储的“类模块”的名称。
'A.value = c1.Md5_String_Calc("c")
'End Sub
'A.value是4A8A08F09D37B73795649038408B5F33




' Visual Basic MD5 Implementation
' Robert Hubley and David Midkiff (mdj2023@hotmail.com)
' modify by simonyan, Support chinese
' Standard MD5 implementation optimised for the Visual Basic environment.
' Conforms to all standards and can be used in digital signature or password
' protection related schemes.
Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647
Private State(4) As Long
Private ByteCounter As Long
Private ByteBuffer(63) As Byte
Private Const S11 = 7
Private Const S12 = 12
Private Const S13 = 17
Private Const S14 = 22
Private Const S21 = 5
Private Const S22 = 9
Private Const S23 = 14
Private Const S24 = 20
Private Const S31 = 4
Private Const S32 = 11
Private Const S33 = 16
Private Const S34 = 23
Private Const S41 = 6
Private Const S42 = 10
Private Const S43 = 15
Private Const S44 = 21
Property Get RegisterA() As String
    RegisterA = State(1)
End Property
Property Get RegisterB() As String
    RegisterB = State(2)
End Property
Property Get RegisterC() As String
    RegisterC = State(3)
End Property
Property Get RegisterD() As String
    RegisterD = State(4)
End Property
Public Function Md5_String_Calc(SourceString As String) As String
    MD5Init
    MD5Update LenB(StrConv(SourceString, vbFromUnicode)), StringToArray(SourceString)
    MD5Final
    Md5_String_Calc = GetValues
End Function
Public Function Md5_File_Calc(InFile As String) As String
On Error GoTo errorhandler
GoSub begin
errorhandler:
    Md5_File_Calc = ""
    Exit Function
   
begin:
    Dim FileO As Integer
    FileO = FreeFile
    Call FileLen(InFile)
    Open InFile For Binary Access Read As #FileO
    MD5Init
    Do While Not EOF(FileO)
        Get #FileO, , ByteBuffer
        If Loc(FileO) < LOF(FileO) Then
            ByteCounter = ByteCounter + 64
            MD5Transform ByteBuffer
        End If
    Loop
    ByteCounter = ByteCounter + (LOF(FileO) Mod 64)
    Close #FileO
    MD5Final
    Md5_File_Calc = GetValues
End Function
Private Function StringToArray(InString As String) As Byte()
    Dim I As Integer, bytBuffer() As Byte
    ReDim bytBuffer(LenB(StrConv(InString, vbFromUnicode)))
    bytBuffer = StrConv(InString, vbFromUnicode)
    StringToArray = bytBuffer
End Function
Public Function GetValues() As String
    GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
End Function
Private Function LongToString(Num As Long) As String
        Dim A As Byte, B As Byte, C As Byte, D As Byte
        A = Num And &HFF&
        If A < 16 Then LongToString = "0" & Hex(A) Else LongToString = Hex(A)
        B = (Num And &HFF00&) \ 256
        If B < 16 Then LongToString = LongToString & "0" & Hex(B) Else LongToString = LongToString & Hex(B)
        C = (Num And &HFF0000) \ 65536
        If C < 16 Then LongToString = LongToString & "0" & Hex(C) Else LongToString = LongToString & Hex(C)
        If Num < 0 Then D = ((Num And &H7F000000) \ 16777216) Or &H80& Else D = (Num And &HFF000000) \ 16777216
        If D < 16 Then LongToString = LongToString & "0" & Hex(D) Else LongToString = LongToString & Hex(D)
End Function
Public Sub MD5Init()
    ByteCounter = 0
    State(1) = UnsignedToLong(1732584193#)
    State(2) = UnsignedToLong(4023233417#)
    State(3) = UnsignedToLong(2562383102#)
    State(4) = UnsignedToLong(271733

xlonger

编译不了啊出错

okmijn

编译不了啊出错

但是可以运行

[此贴子已经被作者于2006-3-7 22:13:37编辑过]

xiaxue_203

不太懂