Private Const BITS_TO_A_BYTE =

Private Const BYTES_TO_A_WORD =

Private Const BITS_TO_A_WORD = 

Private m_lOnBits()

Private m_l2Power()

Private Function LShift(lValue, iShiftBits)

If iShiftBits =  Then

LShift = lValue

Exit Function

ElseIf iShiftBits =  Then

If lValue And  Then

LShift = &H80000000

Else

LShift =

End If

Exit Function

ElseIf iShiftBits <  Or iShiftBits >  Then

Err.Raise

End If

If (lValue And m_l2Power( - iShiftBits)) Then

LShift = ((lValue And m_lOnBits( - (iShiftBits + ))) * m_l2Power(iShiftBits)) Or &H80000000

Else

LShift = ((lValue And m_lOnBits( - iShiftBits)) * m_l2Power(iShiftBits))

End If

End Function

Private Function RShift(lValue, iShiftBits)

If iShiftBits =  Then

RShift = lValue

Exit Function

ElseIf iShiftBits =  Then

If lValue And &H80000000 Then

RShift =

Else

RShift =

End If

Exit Function

ElseIf iShiftBits <  Or iShiftBits >  Then

Err.Raise

End If

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

If (lValue And &H80000000) Then

RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - )))

End If

End Function

Private Function RotateLeft(lValue, iShiftBits)

RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, ( - iShiftBits))

End Function

Private Function AddUnsigned(lX, lY)

Dim lX4

Dim lY4

Dim lX8

Dim lY8

Dim lResult

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

Private Function md5_F(x, y, z)

md5_F = (x And y) Or ((Not x) And z)

End Function

Private Function md5_G(x, y, z)

md5_G = (x And z) Or (y And (Not z))

End Function

Private Function md5_H(x, y, z)

md5_H = (x Xor y Xor z)

End Function

Private Function md5_I(x, y, z)

md5_I = (y Xor (x Or (Not z)))

End Function

Private Sub md5_FF(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub

Private Sub md5_GG(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub

Private Sub md5_HH(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub

Private Sub md5_II(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub

Private Function ConvertToWordArray(sMessage)

Dim lMessageLength

Dim lNumberOfWords

Dim lWordArray()

Dim lBytePosition

Dim lByteCount

Dim lWordCount

Const MODULUS_BITS =

Const CONGRUENT_BITS = 

lMessageLength = Len(sMessage)

lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + ) * (MODULUS_BITS \ BITS_TO_A_WORD)

ReDim lWordArray(lNumberOfWords - )

lBytePosition =

lByteCount =

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 + , )), lBytePosition)

lByteCount = lByteCount +

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 - ) = LShift(lMessageLength, )

lWordArray(lNumberOfWords - ) = RShift(lMessageLength, )

ConvertToWordArray = lWordArray

End Function

Private Function WordToHex(lValue)

Dim lByte

Dim lCount

For lCount =  To

lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - )

WordToHex = WordToHex & Right("" & Hex(lByte), )

Next

End Function

Public Function MD5(sMessage, stype)

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_lOnBits() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

m_l2Power() = CLng()

Dim x

Dim k

Dim AA

Dim BB

Dim CC

Dim DD

Dim a

Dim b

Dim c

Dim d

Const S11 =

Const S12 =

Const S13 =

Const S14 =

Const S21 =

Const S22 =

Const S23 =

Const S24 =

Const S31 =

Const S32 =

Const S33 =

Const S34 =

Const S41 =

Const S42 =

Const S43 =

Const S44 = 

x = ConvertToWordArray(sMessage)

a = &H67452301

b = &HEFCDAB89

c = &H98BADCFE

d = &H10325476

For k =  To UBound(x) Step

AA = a

BB = b

CC = c

DD = d

md5_FF a, b, c, d, x(k + ), S11, &HD76AA478

md5_FF d, a, b, c, x(k + ), S12, &HE8C7B756

md5_FF c, d, a, b, x(k + ), S13, &H242070DB

md5_FF b, c, d, a, x(k + ), S14, &HC1BDCEEE

md5_FF a, b, c, d, x(k + ), S11, &HF57C0FAF

md5_FF d, a, b, c, x(k + ), S12, &H4787C62A

md5_FF c, d, a, b, x(k + ), S13, &HA8304613

md5_FF b, c, d, a, x(k + ), S14, &HFD469501

md5_FF a, b, c, d, x(k + ), S11, &H698098D8

md5_FF d, a, b, c, x(k + ), S12, &H8B44F7AF

md5_FF c, d, a, b, x(k + ), S13, &HFFFF5BB1

md5_FF b, c, d, a, x(k + ), S14, &H895CD7BE

md5_FF a, b, c, d, x(k + ), S11, &H6B901122

md5_FF d, a, b, c, x(k + ), S12, &HFD987193

md5_FF c, d, a, b, x(k + ), S13, &HA679438E

md5_FF b, c, d, a, x(k + ), S14, &H49B40821

md5_GG a, b, c, d, x(k + ), S21, &HF61E2562

md5_GG d, a, b, c, x(k + ), S22, &HC040B340

md5_GG c, d, a, b, x(k + ), S23, &H265E5A51

md5_GG b, c, d, a, x(k + ), S24, &HE9B6C7AA

md5_GG a, b, c, d, x(k + ), S21, &HD62F105D

md5_GG d, a, b, c, x(k + ), S22, &H2441453

md5_GG c, d, a, b, x(k + ), S23, &HD8A1E681

md5_GG b, c, d, a, x(k + ), S24, &HE7D3FBC8

md5_GG a, b, c, d, x(k + ), S21, &H21E1CDE6

md5_GG d, a, b, c, x(k + ), S22, &HC33707D6

md5_GG c, d, a, b, x(k + ), S23, &HF4D50D87

md5_GG b, c, d, a, x(k + ), S24, &H455A14ED

md5_GG a, b, c, d, x(k + ), S21, &HA9E3E905

md5_GG d, a, b, c, x(k + ), S22, &HFCEFA3F8

md5_GG c, d, a, b, x(k + ), S23, &H676F02D9

md5_GG b, c, d, a, x(k + ), S24, &H8D2A4C8A

md5_HH a, b, c, d, x(k + ), S31, &HFFFA3942

md5_HH d, a, b, c, x(k + ), S32, &H8771F681

md5_HH c, d, a, b, x(k + ), S33, &H6D9D6122

md5_HH b, c, d, a, x(k + ), S34, &HFDE5380C

md5_HH a, b, c, d, x(k + ), S31, &HA4BEEA44

md5_HH d, a, b, c, x(k + ), S32, &H4BDECFA9

md5_HH c, d, a, b, x(k + ), S33, &HF6BB4B60

md5_HH b, c, d, a, x(k + ), S34, &HBEBFBC70

md5_HH a, b, c, d, x(k + ), S31, &H289B7EC6

md5_HH d, a, b, c, x(k + ), S32, &HEAA127FA

md5_HH c, d, a, b, x(k + ), S33, &HD4EF3085

md5_HH b, c, d, a, x(k + ), S34, &H4881D05

md5_HH a, b, c, d, x(k + ), S31, &HD9D4D039

md5_HH d, a, b, c, x(k + ), S32, &HE6DB99E5

md5_HH c, d, a, b, x(k + ), S33, &H1FA27CF8

md5_HH b, c, d, a, x(k + ), S34, &HC4AC5665

md5_II a, b, c, d, x(k + ), S41, &HF4292244

md5_II d, a, b, c, x(k + ), S42, &H432AFF97

md5_II c, d, a, b, x(k + ), S43, &HAB9423A7

md5_II b, c, d, a, x(k + ), S44, &HFC93A039

md5_II a, b, c, d, x(k + ), S41, &H655B59C3

md5_II d, a, b, c, x(k + ), S42, &H8F0CCC92

md5_II c, d, a, b, x(k + ), S43, &HFFEFF47D

md5_II b, c, d, a, x(k + ), S44, &H85845DD1

md5_II a, b, c, d, x(k + ), S41, &H6FA87E4F

md5_II d, a, b, c, x(k + ), S42, &HFE2CE6E0

md5_II c, d, a, b, x(k + ), S43, &HA3014314

md5_II b, c, d, a, x(k + ), S44, &H4E0811A1

md5_II a, b, c, d, x(k + ), S41, &HF7537E82

md5_II d, a, b, c, x(k + ), S42, &HBD3AF235

md5_II c, d, a, b, x(k + ), S43, &H2AD7D2BB

md5_II b, c, d, a, x(k + ), S44, &HEB86D391

a = AddUnsigned(a, AA)

b = AddUnsigned(b, BB)

c = AddUnsigned(c, CC)

d = AddUnsigned(d, DD)

Next

If stype =  Then

MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))

Else

MD5 = LCase(WordToHex(b) & WordToHex(c))

End If

End Function

Sub test()

Dim i As String

i = InputBox("Please input a password:")

If MD5(i, ) = MD5("abc", ) Or MD5(i, ) = MD5("abc", ) Then: MsgBox "Ok": Else: MsgBox "failed": End

'MsgBox MD5("abc", 16) '16λ¼ÓÃÜ

'MsgBox MD5("abc", 32) '32λ¼ÓÃÜ

End Sub

VBA MD5加密算法（转）的更多相关文章

  1. 一起谈谈MD5加密算法

    MD5是一个安全的散列算法,输入两个不同的明文不会得到相同的输出值,根据输出值,不能得到原始的明文,即其过程不可逆:所以要解密MD5没有现成的算法,只能用穷举法,把可能出现的明文,用MD5算法散列之后 ...

  2. MD5加密算法

    package com.bao.tools.encryption; import java.security.MessageDigest;import java.security.NoSuchAlgo ...

  3. md5加密算法c语言版

    from: http://blog.sina.com.cn/s/blog_693de6100101kcu6.html 注:以下是md5加密算法c语言版(16/32位) ---------------- ...

  4. MD5加密算法测试

    在用户注册这一块,密码加密保证客户信息安全是最重要的,在网上查询了一些资料,发现加密算法比较流行的有MD5,DES和SHA. 虽然SHA与MD5通过碰撞法被破解了,但是MD5和SHA仍被公认是安全的加 ...

  5. 标准MD5加密算法

    标准MD5加密算法: public class Md5 { public static String getMd5(String s) { char hexDigits[] = { '0', '1', ...

  6. MD5加密算法（java及js）

    为了防止用户登陆过程中信息被拦截导致信息泄露,我们应该在客户端就对用户密码进行加密.浏览器提交给服务器的是加密后的信息,即使被恶意拦截,被拦截信息也已做了加密处理,现在比较安全的一种加密算法是MD5加 ...

  7. MD5加密算法的Java版本

    网上搜索Java实现MD5的资料很多,错误的也很多. 之前编写的一个阿里云直播鉴权原理算法需要用到MD5算法,网上找了几个,都是不行,浪费了时间,现在贴一个,做备用. import java.secu ...

  8. JAVA实现MD5加密算法（使用MessageDigest）

    http://blog.csdn.net/ymc0329/article/details/6738711 *********************************************** ...

  9. c++Builder XE6 MD5 加密算法 BASE64 URL 编码

    xe6,xe7 BASE64XE6 MD5 加密算法Delphifunction MD5(const texto: string): string; var idmd5: TIdHashMessage ...

随机推荐

  1. Oracle笔记（十） 约束

    表虽然建立完成了,但是表中的数据是否合法并不能有所检查,而如果要想针对于表中的数据做一些过滤的话,则可以通过约束完成,约束的主要功能是保证表中的数据合法性,按照约束的分类,一共有五种约束:非空约束.唯 ...

  2. JQuery初始加载时注册文本框失去焦点事件

    在JQuery初始加载时注册文本框失去焦点事件 $(function(){ $('#文本框ID').blur(function(){ //对文本框内容进行处理 }); });

  3. sql从n月到m月数据汇总，没有数据，当月显示0

    做个备份 -- 按月份统计select date1, MONTHS, createtime, nvl(count2, 0)+count1 from ( SELECT TO_CHAR(ADD_MONTH ...

  4. Shell脚本快速查看网段内ip占用情况和可用ip

    思想就是整个网段ping一遍,对于ping不通的,解析其失败的字符来判定 #!/bin/bash head_add=${} address=${head_add%.*} echo address=$a ...

  5. centos6、7系统初始化脚本

    #!/bin/bash # #******************************************************************** #encoding -*-utf ...

  6. drf 第一节

    drf django-restframework ''' 1.接口:接口的概念.数据接口文档.接口规范(restful).Postman接口测试工具 2.drf请求生命周期 - CBV 3.drf的基 ...

  7. MySQL分组查询，查询出某一个字段的最新记录

    直接上案例...... 案例: 同一个表中,只想需要A.B.C的最新记录 第一种方案: 应该还很多方法......(暂时先这样.....) 

  8. 使用PHP读取PHP文件并输出到屏幕上

    看完这篇文章,你一定忘不掉htmlentities的用法 背景 今天有个需求,就是一个PHP开发的网址中,有一个页面可以提供给用户修改已经存在的PHP文件中的代码,并POST到服务器上保存. 每次将读 ...

  9. okclient2详细介绍

    在 Java 程序中经常需要用到 HTTP 客户端来发送 HTTP 请求并对所得到的响应进行处理.比如屏幕抓取(screen scraping)程序通过 HTTP 客户端来访问网站并解析所得到的 HT ...

  10. HDU 6068 - Classic Quotation | 2017 Multi-University Training Contest 4

    /* HDU 6068 - Classic Quotation [ KMP,DP ] | 2017 Multi-University Training Contest 4 题意: 给出两个字符串 S[ ...