vb6可用的md5摘要函数

用法实例(来源未知，请告知）

MsgBox ToolsMd5.Encode(“a”) ’32位加密

MsgBox ToolsMd5.Encode(“a”, 16) ’16位加密

直接上源码了:

'Attribute VB_Name = "Md5"
'        ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
'        ::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'        :::::                                              :::::
'        :::::         使用 Windows API 来计算 MD5          :::::
'        :::::                                              :::::
'        ::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'        ````````````````````````````````````````````````````````
'
'  * - * - * - * - * - * - * - * - * - * - * - * - * - * - * - * - * - *
'           -=  函 数 清 单  =-
'     GetMD5Text        获取上次计算的MD5码文本
'     MD5Bytes          计算一个字节数组的MD5码
'     MD5String         计算一个字符串（ANSI编码）的MD5码
'     MD5File           计算一个文件的MD5码
'  * - * - * - * - * - * - * - * - * - * - * - * - * - * - * - * - * - *
'
Option Explicit

' ==============================
' ≡     自定义 数据类型      ≡
' ==============================
Type MD5_CTX
    dwNUMa      As Long
    dwNUMb      As Long
    Buffer(15)  As Byte
    cIN(63)     As Byte
    cDig(15)    As Byte
End Type

' ==============================
' ≡     API 函 数 声 明      ≡
' ==============================
Private Declare Sub MD5Init Lib "advapi32" (lpContext As MD5_CTX)
Private Declare Sub MD5Final Lib "advapi32" (lpContext As MD5_CTX)
Private Declare Sub MD5Update Lib "advapi32" (lpContext As MD5_CTX, _
    ByRef lpBuffer As Any, ByVal BufSize As Long)

Private stcContext   As MD5_CTX


' ==============================
' ≡     通用 函数 & 过程     ≡
' ==============================
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 功    能：计算一个字符串（ANSI编码）的MD5码
' 入口参数：
'  strText     字符串文本
' 返回参数：   MD5码 （16字节的Byte数组）
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Function MD5String(strText As String) As Byte()
    Dim aBuffer()     As Byte
    
    Call MD5Init(stcContext)
    If (Len(strText) > 0) Then
        aBuffer = StrConv(strText, vbFromUnicode)
        Call MD5Update(stcContext, aBuffer(0), UBound(aBuffer) + 1)
    Else
        Call MD5Update(stcContext, 0, 0)
    End If
    Call MD5Final(stcContext)
    MD5String = stcContext.cDig
End Function

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 功    能：计算一个字节流的MD5码
' 入口参数：
'  Buffer      Byte数组
'  size        长度（可选，默认计算整个长度）
' 返回参数：   MD5码 （16字节的Byte数组）
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Function MD5Bytes(Buffer() As Byte, _
                        Optional ByVal size As Long = -1) As Byte()
      Dim U As Long, pBase   As Long

   pBase = LBound(Buffer)
   U = UBound(Buffer) - pBase
   If (-1 = size) Then size = U + 1
   Call MD5Init(stcContext)
   If (-1 = U) Then
      Call MD5Update(stcContext, 0, 0)
   Else
      Call MD5Update(stcContext, Buffer(pBase), size)
   End If
   Call MD5Final(stcContext)
   MD5Bytes = stcContext.cDig
End Function

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 功    能：计算一个文件的MD5码
' 入口参数：
'  FileName    磁盘文件名（完整路径）
' 返回参数：   MD5码 （16字节的Byte数组）
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Function MD5File(ByVal FileName As String) As Byte()
   Const BUFFERSIZE  As Long = 1024& * 512      ' 缓冲区 512KB
      Dim DataBuff() As Byte
      Dim lFileSize  As Long
      Dim iFn        As Long

   On Error GoTo E_Handle_MD5
   If (Len(Dir$(FileName)) = 0) Then Err.Raise 5      '文件不存在
   ReDim DataBuff(BUFFERSIZE - 1)
   iFn = FreeFile()
   Open FileName For Binary As #iFn
   lFileSize = LOF(iFn)
   Call MD5Init(stcContext)
   If (lFileSize = 0) Then
      Call MD5Update(stcContext, 0, 0)
   Else
      Do While (lFileSize > 0)
         Get iFn, , DataBuff
         If (lFileSize > BUFFERSIZE) Then
            Call MD5Update(stcContext, DataBuff(0), BUFFERSIZE)
         Else
            Call MD5Update(stcContext, DataBuff(0), lFileSize)
         End If
         lFileSize = lFileSize - BUFFERSIZE
      Loop
   End If
   Close iFn
   Call MD5Final(stcContext)
E_Handle_MD5:
   MD5File = stcContext.cDig
End Function

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 功    能：获取上次计算的MD5码文本
' 入口参数：   < 无 >
' 返回参数：   MD5码文本字符串（没有MD5数据 返回空串）
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Function GetMD5Text() As String
    Dim sResult As String, I&
    If (stcContext.dwNUMa = 0) Then
        sResult = vbNullString
    Else
        sResult = Space$(32)
        For I = 0 To 15
            Mid$(sResult, I + I + 1) = Right$("0" & Hex$(stcContext.cDig(I)), 2)
        Next
    End If
    GetMD5Text = sResult                                                        ' LCase$(sResult) '字母小写
End Function


Public Function Encode(Txt$, Optional Is16bit As Boolean) As String
    Call MD5String(Txt)
    Encode= GetMD5Text()
End Function

Views: 58