设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12
返回列表 发新帖
楼主: LucasLynn
打印 上一主题 下一主题

[模块/函数] 【转载 / 源码】MD5加密的VB类模块源码

[复制链接]
11#
发表于 2006-4-26 00:39:00 | 只看该作者




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
12#
发表于 2016-6-1 16:46:03 | 只看该作者
支持,顶一下
13#
发表于 2016-8-4 09:03:24 | 只看该作者
学习啦
回复

使用道具 举报

14#
发表于 2016-8-4 09:44:20 | 只看该作者
请教,可以给存放在硬盘上的文件,进行MD5加密吗?我的意思是,别人修改后,通过MD5函数我可以知道被变更过了.谢谢!
15#
发表于 2016-8-23 15:20:52 | 只看该作者
谢谢分享
回复

使用道具 举报

16#
发表于 2021-10-26 19:59:50 | 只看该作者
谢谢分享
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 07:30 , Processed in 0.079080 second(s), 29 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表