【源码】VB6.0 调用Windows系统的API计算MD5码

舉杯邀明月 2013-09-20 12:16:02
加精
　　前几天，有网友发贴，求一个非对称加密的VB算法代码。
　　当时自然就想到了RSA加密算法。本想在系统中找RSA加密算法的API，却没找到。
　　在网上搜索算法代码，几乎就是找到一些千篇一律的“理论介绍”，C/C++代码倒是有一些，但我还没有试验效
果如何。费了很大的劲翻出的VB代码，一试，结果根本不行……

　　RSA的没什么收获，但却意外的找到了MD5的函数库。

　　当然，你也许会说，MD5的算法代码，网上一堆堆的，多的是…………
　　这个我也不否认。网上一出来点好东西，往往就会你抄我、他抄你的，不管看没看懂、不管有没有什么问题，只
管 Copy ＆ Paste 。内容千篇一律，有的还说明“出处”，有的干脆就“据为已出”！如果“源头”有什么错误，
后面的基本都是跟着错的。
　　对此放下不谈，再说下这些源码问题。这些MD5计算的源码，不管是C/C++的也好，还是VB的也好，或者是其它语
言的，都是把具体计算过程，用代码实现了的。那个代码模块，无论他是否进行过“封装”，面临的也是一大堆的代
码、十几个甚至近20个的函数。VB6.0的代码，就拿网上比较流行的版本来说吧，整个模块约12K代码（什么注释也不
要写），全部函数约20个。这里面不少的函数就几行代码而已，但有几个主要过程的代码是极长的。如果把这个模块
加入自己的工程代码中，在自己的工程代码编写或维护过程中，万一不小心把哪改动了一点，或不小心删除了某行，
那问题就大了，要找起来那可是累死人（当然也可以用备份的模块来全部还原）。再者，在VB6中，不支持移位运算，
整数是带符号的，运算中还可能有“溢出”问题。移位运算是用算术运算来“模拟”的，效率自然低了很多。 还有
就是算法过程，基本上就是第一个人出来之后，代码过程就是那样了，代码质量基本就是取决于“第一人”的编写水
平，即使这里面有需要优化的地方，也基本上没人去改它。一大堆的代码，写得很不规范，看着都晕……

　　相比之下，我这个用系统API来计算MD5码的模块，就比较有优越性了。
　　①　代码量少，维护容易。我这个模块，如果去掉全部注释，不足3KB了。
　　　　　　（并且基本上没什么“优化”的必要了，我自认为写得还不错！　^_^）
　　②　不用担心算法出错，或不能使用。
　　　　⑴微软的Windows系统自己在用，这个无论哪个版本的Windows系统，都会有这个库的。
　　　　⑵具体的核心计算过程是系统API实现的，不用担心有错：其一，他不能有错，系统中有那么多的证书，需
　　要进行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


（下面这段是应用示例。在一个窗体模块中）
Option Explicit



Private Sub Command1_Click()

   Dim aBuffer() As Byte

   

   Cls

   '字符串MD5

   Print "MD5("""") ="

   Call MD5String("")

   Print GetMD5Text() & vbLf

   Print "MD5(""abc"") ="

   Call MD5String("abc")

   Print GetMD5Text() & vbLf

   Print "MD5(""中秋快乐！"") ="

   Call MD5String("中秋快乐！")

   Print GetMD5Text() & vbLf

   '字节数组MD5

   Print "字节数组 MD5(""abc"") ="

   Call MD5Bytes(StrConv("abc", vbFromUnicode))

   Print GetMD5Text() & vbLf

   

   Print "字节数组 MD5(""中秋快乐！"") ="

   Call MD5Bytes(StrConv("中秋快乐！", vbFromUnicode))

   Print GetMD5Text() & vbLf

   '文件MD5

   Print "文件：Explorer.exe　MD5 = "

   Call MD5File("c:\windows\explorer.exe")

   Print GetMD5Text(); vbLf

End Sub
...全文
13195 124 打赏 收藏 转发到动态 举报
写回复
用AI写文章
124 条回复
切换为时间正序
请发表友善的回复…
发表回复
zhzhzh3 2015-09-06
  • 打赏
  • 举报
 回复
不错，引用模块，没问题
舉杯邀明月 2015-07-27
  • 打赏
  • 举报
 回复
引用 141 楼 tob8008 的回复:
为何我转成MD5码后会是乱码？
对于你这种空洞的提问，我也只有来个空洞的回复： 因为你的用法不对！！！ .
tob8008 2015-07-24
  • 打赏
  • 举报
 回复
为何我转成MD5码后会是乱码？
pdprf 2015-06-03
  • 打赏
  • 举报
 回复
非常感谢开源这么好的代码，赞一个！
pdprf 2015-06-03
  • 打赏
  • 举报
 回复
引用 137 楼 Chen8013 的回复:
[quote=引用 136 楼 pdprf 的回复:] 英文的转换没错，中文的转换出来跟站长网的不一样。 等完善。。。
所谓的“完善”，都是具体的应用细节方面的东西。 不同的人，可能不同的方案和想法。我不是神仙，不可能猜出你有什么样的怪异想法！！！ 基本用法，我的代码中已经“表达”得很清楚了。 如果细节方面不适用，自己按自己的需求进行修改啊！ 至于“中文的转换出来跟站长网的不一样”，这个问题，本帖子的回复中早就有相关论述。 MD5算法只有一个标准，你说的“结果不一样”，只能是如下两种情况之一： 1是你的使用方法不当；2就是你说的“站长网”它的算法有问题。 我不知道你所说的“站长网”是哪个网，但可以不客气的说，别以为它挂个“站长”的名号，它就是权威了！！！ 如果你想多学点东西、少闹出的笑话，建议你仔细看看帖子中的回复！ [/quote] 抱歉，已看到第二页回复，那个转换中文的跟站长网转换出来的是一样的，建议更新到首页，让更多人看到学习。 以下是我自己整理出来的，一般只需要用到这个而已： 
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

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

Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

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 = LCase(sResult)       ' LCase$(sResult) '字母小写
End Function

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

Public Function Md5(StrText As String) As String
    Dim lLen As Long
    Dim aBuffer() As Byte
    lLen = WideCharToMultiByte(&HFDE9&, 0, StrPtr(StrText), Len(StrText), 0, 0, 0, 0)
    ReDim aBuffer(lLen - 1)
    Call WideCharToMultiByte(&HFDE9&, 0&, StrPtr(StrText), Len(StrText), aBuffer(0), lLen, 0, 0)
    Call MD5Bytes(aBuffer)
    Md5 = GetMD5Text()
End Function
舉杯邀明月 2015-05-25
  • 打赏
  • 举报
 回复
137F，“少闹出的笑话”，应为“少闹出点笑话”。 一个字 输入失误。
舉杯邀明月 2015-05-25
  • 打赏
  • 举报
 回复
引用 136 楼 pdprf 的回复:
英文的转换没错，中文的转换出来跟站长网的不一样。 等完善。。。
所谓的“完善”，都是具体的应用细节方面的东西。 不同的人，可能不同的方案和想法。我不是神仙，不可能猜出你有什么样的怪异想法！！！ 基本用法，我的代码中已经“表达”得很清楚了。 如果细节方面不适用，自己按自己的需求进行修改啊！ 至于“中文的转换出来跟站长网的不一样”，这个问题，本帖子的回复中早就有相关论述。 MD5算法只有一个标准，你说的“结果不一样”，只能是如下两种情况之一： 1是你的使用方法不当；2就是你说的“站长网”它的算法有问题。 我不知道你所说的“站长网”是哪个网，但可以不客气的说，别以为它挂个“站长”的名号，它就是权威了！！！ 如果你想多学点东西、少闹出的笑话，建议你仔细看看帖子中的回复！
pdprf 2015-05-23
  • 打赏
  • 举报
 回复
英文的转换没错，中文的转换出来跟站长网的不一样。 等完善。。。
Carlven2012 2014-08-05
  • 打赏
  • 举报
 回复
好东西，顶一个。
liufumingok 2014-05-06
  • 打赏
  • 举报
 回复
感谢楼主！这个不错
舉杯邀明月 2014-03-31
  • 打赏
  • 举报
 回复
谢谢关注！
在当时编写这个代码时，没有考虑到超大文件的情况。
先已经在私信中给你作了比较详细的解释了，这儿就不再多说了。
在手机上回复真不方便……
wcymiss 2014-03-17
  • 打赏
  • 举报
 回复
非常好！今天正在找这个东东。收藏了
liyz1288 2014-02-26
  • 打赏
  • 举报
 回复
这帖子中的MD5file对大文件的MD5值不对我用的是一个3G多的GHOST文件瞬间计算完了下的MD5工具得到的值都是一样的，计算需要很长时间。望大侠回复~
pzwhz 2013-12-23
  • 打赏
  • 举报
 回复
Base64 api函数有吗？
舉杯邀明月 2013-10-16
  • 打赏
  • 举报
 回复
引用 128 楼 u010087908 的回复:
你也来凑热闹了啊。
NANU-NANA 2013-10-16
  • 打赏
  • 举报
 回复
vansoft 2013-10-15
  • 打赏
  • 举报
 回复
不明觉厉。 +10086
舉杯邀明月 2013-10-09
  • 打赏
  • 举报
 回复
引用 125 楼 zzyong00 的回复:
路过一下，没想到这里还有这么激烈讨论的帖子
楼上这位高手，好久没在这论坛来过了…… 欢迎再次归来。
zzyong00 2013-10-07
  • 打赏
  • 举报
 回复
路过一下，没想到这里还有这么激烈讨论的帖子
自然静 2013-10-06
  • 打赏
  • 举报
 回复
引用 100 楼 Chen8013 的回复:
[quote=引用 99 楼 milertom 的回复:] 不明觉厉。99楼
这只猫比较可爱。 [/quote] 我也觉得
加载更多回复（104）
VB6.0调用 DLL版ZIP压缩文件夹目录和解压ZIP文件
VB6.0调用 DLL版ZIP压缩文件夹目录和解压ZIP文件，网上很多源码不好用，所以就自己做了一个。原始代码是VC++的用VS2019编译了一个，DLL封装了下。调用很简单 '调用方法如下: 'CreateZipFileA "C:\123", "C:\123.zip") 压缩 Public Declare Function CreateZipFileA Lib "MirPack.dll" (ByVal sFolderPath As String, ByVal sZipFilePath As String) As Long 'UnZipFileA "C:\123", "C:\123.zip") 解压 Public Declare Function UnZipFileA Lib "MirPack.dll" (ByVal sFolderPath As String, ByVal sZipFilePath As String) As Long
VB6.0调用控件制作播放器的源码.rar
VB6.0调用控件制作播放器的源码，可以播放AVI/MPG/ASF/WMV等格式的文件，界面和功能都相对简单，主要是想学习自定义控件的使用。
VB6.0 动态调用API函数实现相碰操作.rar
VB6.0 动态调用API函数实现相碰操作，比如执行GetPixel、执行OpenProcess、执行MessageBoxA、执行Beep等操作。
vb6.0 MD5计算程序源码！
MD5计算程序源码！vb6 做的，代码写在模块里。可以直接在你的程序里调用！
VB6.0源码：DLL文件的编译链接插件.rar
吸取前辈的经验，自己写了个VB6.0 DLL文件的编译链接插件，按照以下方法，可以在VB 6.0中直接编译生成带外部输出的DLL文件。 　　1. 把MakeDLL.dll和MakeDLL.exe两个文件复制入VB所在目录，例如 　　"C:\Program Files\Microsoft Visual Studio\VB98" 　　2. 把Module1DLL.bas和Standard DLL.vbp两个文件复制入VB所在目录下的 　　Template目录下的Projects目录，例如 　　"C:\Program Files\Microsoft Visual Studio\VB98\Template\Projects" 　　3. 启动VB 6.0，随便选择建立一种什么类型的程序，然后主菜单选择"外接程序" 　　再选择"外接程序管理器"，你应该可以看到在列表中有"Create DLLs in VB 6.0，然后选择它，并在窗口右下方的"加载行为"中把"在启动中加载"和"加载/卸载"都钩选，点确定，再次关闭VB 6.0 　　4. 再次启动VB，建立一个ActiveX DLL程序，这个时候点主菜单"文件"，可以看到"生成工程1.DLL(K)"和"选择DLL出口函数"菜单项目。 　　好了，大功告成，现在你的VB 6.0已经可以直接编译链接标准的DLL文件了，造作方法，如下： 　　建立ActiveX dll程序，添加一个模块(DLL的函数只能在模块中才有效)，在模块中编写你的DLL function过程函数，编写完毕，点保存，然后点"文件"菜单下的”选择DLL出口函数"，在弹出窗口中选择需要申明为可以外部调用的 　　function，然后确定，最后点"文件"->"生成xxx.dll(K)"，编译生成DLL。 　　需要注意的地方如下： 　　1. 程序代码必须在模块中编写 　　2. 需要申明为外部调用的函数必须为Public 　　3. DLL代码中必须包含一个function DLLmain函数和一个sub Main，不过function DLLmain会被执行，而sub main只是摆设，其中的代码不会运行，但是必须有这个东西(◎_◎)。 　　4. DLL代码编写没有什么特殊的要求，可以做一切可以在VB中用的东西，比如调用API啊，编写嵌入代码啊(关键)……
API

1,486

社区成员

23,280

社区内容

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章