【源码】VB6中高效的内存访问利器

[舉杯邀明月]

　　大家在编写程序代码时，有时候会遇到“直接读、写内存”的需求。
　　就在此时，大家的脑海里灵光一闪、Copymemory必然隆重登场……
　　不错，这个API几乎就是超级明星，大家都认识它，熟悉它的身份、作用。用它来复制内存数据，大到几MB、几十MB
的内存块，小到只有1字节，它都可以“不负众望”地工作。
　　然而，今天我要向大家介绍的，却不是这个明星，而是几个毫无名气的、默默无闻的“小人物”。为何我称之为“小
人物”呢？其一是，它们实在“太没名气”了，恐怕有95%以上的人都不知道它们的存在；其二，它位只适合用在“标准
数据类型（1/2/4/8字节）”的内存访问上，要操作较多的字节数或读写“非标准字节数”，仍然是用Copymemory为佳。
　　先看看“效果图”，尽用文字描述，有点抽象了。
　　这是分别用Copymemory和VB6的API随机读取一定次数的累计耗时（每次都是读4字节）。


　　当然这个“耗时不稳定”。这很正常，一是GetTickCount()本来精度不高（15ms），二是因为较长的执行周期，受到
系统线程调度的影响相对较大。从执行结果的记录可以看到：用“MemLong”的操作速度，很明显的比“Copymemory”的
操作速度要快一些。这个速度的评判，应该是以“大多数表现”的时间为准，偶尔出现的“耗时较长的结果”，应该是受
其它因素影响了吧，应该忽略这个结果。

我的测试程序代码如下：

Option Explicit

Private Const MASK_ADDR_A  As Long = &H3FFFFC         ' 地址空间掩码_A
Private Const MASK_ADDR_B  As Long = &H3FFFFF         ' 地址空间掩码_B
Private Const BUFF_MAX     As Long = 4194319          ' 数据空间上界（4MB + 16B)

Private arrData(BUFF_MAX)  As Byte
Private mlBaseMEM    As Long

Private Sub InitData()
   Dim i As Long

   mlBaseMEM = VarPtr(arrData(0&))
   Call Randomize
   For i = 0& To BUFF_MAX
      arrData(i) = Int(256 * Rnd())
   Next
   lstOut.AddItem Time$ & " 数据填充完成"
End Sub

Private Sub cmdClear_Click()
   Call lstOut.Clear
End Sub

Private Sub cmdCopyMemA_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdCopyMemA.Enabled = False
   Call Randomize
   w = MASK_ADDR_A * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      Call CopyMemory(w, ByVal mlBaseMEM + w, 4&)
      w = MASK_ADDR_A And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "CopyMemory 边界对齐"
   lstOut.AddItem k & "万次 消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdCopyMemA.Enabled = True
End Sub

Private Sub cmdCopyMemB_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdCopyMemB.Enabled = False
   Call Randomize
   w = MASK_ADDR_B * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      Call CopyMemory(w, ByVal mlBaseMEM + w, 4&)
      w = MASK_ADDR_B And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "CopyMemory 边界不对齐"
   lstOut.AddItem k & "万次消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdCopyMemB.Enabled = True
End Sub

Private Sub cmdMemLA_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdMemLA.Enabled = False
   Call Randomize
   w = MASK_ADDR_A * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      w = MemLong(mlBaseMEM + w)
      w = MASK_ADDR_A And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "MemLong 边界对齐 "
   lstOut.AddItem k & "万次 消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdMemLA.Enabled = True
End Sub

Private Sub cmdMemLB_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdMemLB.Enabled = False
   Call Randomize
   w = MASK_ADDR_B * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      w = MemLong(mlBaseMEM + w)
      w = MASK_ADDR_B And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "MemLong 边界不对齐 "
   lstOut.AddItem k & "万次 消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdMemLB.Enabled = True
End Sub

Private Sub cmdResetData_Click()
   Call InitData
End Sub

Private Sub Form_Load()
   Call InitData
End Sub

　　大致描述一下这个测试：程序中先开辟一个4MB的字节数据区（多开16字节以防“内存地址越界”），并随机填充一
些数值。速度测试时，从一个“随机位置”开始读取4字节，并把这4字节作为“Long类型存储单元”处理取出数值；接着
再以“刚才取得的值”为依据，决定“下一次读取的位置”。循环执行足够多的次数，取其累计耗时。因为数据区是填充
的随机数，因此会是“无规律访问”的状态下操作。

　　口水话已经说得差不多了，想必大家也应该明白我说的意思了。
　　现在，小伙伴们应该是摩拳擦掌、跃跃欲试了，迅速的打开VB6，新建一个标准EXE工程，简单的弄好窗体界面，把上
面的代码Ctrl+C，然后Ctrl+V，全编译运行…………不对嘛！提示有某某函数未定义啊！！！
　　这等小事，岂能难到大家！一看就是API调用，添加上相应的API声明，不就结了！！！
　　GetTickCount……搞定！　Copymemory……搞定！！！
　　咦，这MemLong()是什么鬼？？？怎么翻遍了API资料、MSDN，就算是“百度、古狗”一下，也找不到什么踪影啊！
　　这鬼程序怎么能够运行呢！　　

　　哈哈，不能运行？　你们不能运行就对了，这才是正常结果嘛…………
　　因为你们那儿，没有这个小东东：

　　其实这就是一个TLB，我是参考国外大神的一个TLB、结合我自己的理解和使用习惯，进行一定的改编后写的。因为这
个TLB中有一些东西是按我个人的想法和使用习惯来写的，有点“不按套路出牌”，因此这个TLB就不公开了。
　　上面的那段代码，你们也许暂时无法使用。不过我发布一段“常规API使用”的代码，大家就可以轻松进行测试了：

Option Explicit

Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" ( _
                        Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)


Private Const MASK_ADDR_A  As Long = &H3FFFFC         ' 地址空间掩码_A
Private Const MASK_ADDR_B  As Long = &H3FFFFF         ' 地址空间掩码_B
Private Const BUFF_MAX     As Long = 4194319          ' 数据空间上界（4MB + 16B)

Private arrData(BUFF_MAX)  As Byte
Private mlBaseMEM    As Long

Private Sub InitData()
   Dim i As Long

   mlBaseMEM = VarPtr(arrData(0&))
   Call Randomize
   For i = 0& To BUFF_MAX
      arrData(i) = Int(256 * Rnd())
   Next
   lstOut.AddItem Time$ & " 数据填充完成"
End Sub

Private Sub cmdClear_Click()
   Call lstOut.Clear
End Sub

Private Sub cmdCopyMemA_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdCopyMemA.Enabled = False
   Call Randomize
   w = MASK_ADDR_A * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      Call CopyMemory(w, ByVal mlBaseMEM + w, 4&)
      w = MASK_ADDR_A And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "CopyMemory 边界对齐"
   lstOut.AddItem k & "万次 消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdCopyMemA.Enabled = True
End Sub

Private Sub cmdCopyMemB_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdCopyMemB.Enabled = False
   Call Randomize
   w = MASK_ADDR_B * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      Call CopyMemory(w, ByVal mlBaseMEM + w, 4&)
      w = MASK_ADDR_B And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "CopyMemory 边界不对齐"
   lstOut.AddItem k & "万次消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdCopyMemB.Enabled = True
End Sub

Private Sub cmdMemLA_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdMemLA.Enabled = False
   Call Randomize
   w = MASK_ADDR_A * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      Call GetMem4(mlBaseMEM + w, w)
      w = MASK_ADDR_A And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "MemLong 边界对齐 "
   lstOut.AddItem k & "万次 消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdMemLA.Enabled = True
End Sub

Private Sub cmdMemLB_Click()
   Dim i&, k As Long
   Dim w&, u As Long

   k = Val(txtTime.Text)
   If (1& > k) Then Exit Sub
   If (k > 20000&) Then
      MsgBox "输入次数值太大。", 64&
      Exit Sub
   End If
   cmdMemLB.Enabled = False
   Call Randomize
   w = MASK_ADDR_B * Rnd()
   DoEvents
   u = GetTickCount()
   For i = 1& To 10000& * k
      Call GetMem4(mlBaseMEM + w, w)
      w = MASK_ADDR_B And w
   Next
   u = GetTickCount() - u
   lstOut.AddItem "MemLong 边界不对齐 "
   lstOut.AddItem k & "万次 消耗时间：" & u & "ms"
   lstOut.ListIndex = lstOut.ListCount - 1
   cmdMemLB.Enabled = True
End Sub

Private Sub cmdResetData_Click()
   Call InitData
End Sub

Private Sub Form_Load()
   Call InitData
End Sub

　　这一组API其实有8个：4个读数据的、4个写数据的。这组API，VB6和VB5都支持，但更低版本的VB是否支持，我就不
　清楚了，我手里没有对应的dll，也不想到网上满世界的找那些了。毕竟没有意义，我发现WinXP有VB6和VB5的运行库，
　但在Win7、Win10中只有VB6的，已经没有VB5的了。
　　如果程序中在读、写内存时，这组API正好适用，那为何不用呢！反正VB程序运行，都已经加载运行库dll了，这组
　API又是“自家的”，岂不美哉？
　　待会儿，我把AIP使用的测试工程打个包上传到资源。代码中有这8个API的函数原型。当然这个所谓的原型也仅是作
　为一个“参考标准”而已，充分理解其“机理”的基础上，完全可以自由发挥、变换声明形式。


　　欢迎前来围观、拍砖…………

[舉杯邀明月]

引用 20 楼 zhao4zhong1 的回复:

无profiler不要谈效率！！尤其在这个云计算、虚拟机、模拟器、CUDA、多核 、多级cache、指令流水线、多种存储介质、……满天飞的时代！ . . . . . . . .

我说的这些API，关你的“云计算、虚拟机、模拟器…………”鸟事！！！！ 你除了回复一些毫无鸟用的东西瞎扯蛋、装13之外，还能做什么！！！

[舉杯邀明月]

引用 17 楼 bakw 的回复:

有了个新发现， Private Declare Function Htons Lib "ws2_32.dll" Alias "htons" (ByVal HostShort As Integer) As Integer 其实这个函数是高低字节的交换，这个不错。我采集的时候byte到integer的字节交换其实可以用这个来做 不知道有没有long的？

引用 18 楼 bakw 的回复:

居然还有 htonl 比你这个还好

刚才查了一下，感觉有问题啊： 这些API的参数是“整数”（16位、32位），是ByVal传入的。 而你的变量是Single的，不能直接传递啊（ByVal参数，调用时会进行“等值、类型转换”）， 　在“接收数据”的缓冲区中，它是“Byte序列”吧！也不能直接传给ntohl或ntohs。 转换结果是Long或Integer，你只能用相应的“整数变量”来存放结果。 因此无论如何，你始终得用Copymemroy来“中转一下”才能操作吧！ 我已经说过了，凡是单次操作1字节、2字节、4字节、8字节，我说的那组API的效率就比Copymemory要高。 并且，不需要使用“中转变量空间”。

[舉杯邀明月]

刚才发现这帖子被“推荐”了，谢谢　@caozhy 版主的抬举！ 本以为如今VB6版块已经成“冷宫”了，没有谁会管这事了呢。

[赵4老师]

引用 23 楼 Chen8013 的回复:

[quote=引用 20 楼 zhao4zhong1 的回复:] 无profiler不要谈效率！！尤其在这个云计算、虚拟机、模拟器、CUDA、多核 、多级cache、指令流水线、多种存储介质、……满天飞的时代！ . . . . . . . .

我说的这些API，关你的“云计算、虚拟机、模拟器…………”鸟事！！！！ 你除了回复一些毫无鸟用的东西瞎扯蛋、装13之外，还能做什么！！！ [/quote] 不在实际环境使用相应profiler实测，你能保证你的代码在云计算、虚拟机、模拟器、CUDA、多核 、多级cache、指令流水线、多种存储介质、……不同环境下运行，实际结果和你的结论都相符合吗？！

[赵4老师]

为什么不参考 Program Files\Microsoft Visual Studio\VC98\CRT\SRC\Intel\MEMCPY.ASM Program Files\Microsoft Visual Studio 8\VC\crt\src\intel\memcpy.asm Program Files\Microsoft Visual Studio 9.0\VC\crt\src\intel\memcpy.asm Program Files\Microsoft Visual Studio 10.0\VC\crt\src\intel\memcpy.asm Program Files (x86)\Microsoft Visual Studio\2017\Enterprise\VC\Tools\MSVC\14.10.25017\crt\src\i386\memcpy.asm Program Files (x86)\Microsoft Visual Studio\2017\Enterprise\VC\Tools\MSVC\14.10.25017\crt\src\x64\memcpy.asm 呢？

[赵4老师]

计算机组成原理→DOS命令→汇编语言→C语言（不包括C++）、代码书写规范→数据结构、编译原理、操作系统→计算机网络、数据库原理、正则表达式→其它语言（包括C++）、架构……

[舉杯邀明月]

@zhao4zhong1 我已经忍你很久了！ 你这些毫无鸟用的破理论，就别拿到我的面前来丢人现眼了！！！！

[赵4老师]

引用 29 楼 Chen8013 的回复:

@zhao4zhong1 我已经忍你很久了！ 你这些毫无鸟用的破理论，就别拿到我的面前来丢人现眼了！！！！

你能忍得比我久？看看我是哪年注册CSDN的。

[赵4老师]

使用电脑计时有时误差会很大，因为待测程序段的运行会影响电脑时钟。 将待测程序段循环足够多次，手动掐秒表计时可能更准确。

[舉杯邀明月]

赵4，我真不想再和你这个脑残说什么了………… 恶心　！！！

[zzyong00]

偶尔来一次，就看到这么激烈的争论，不，是争吵

[舉杯邀明月]

引用 41 楼 Tiger_Zhao 的回复:

请注明出处。不要搞得象第一发现人一样。 Exposing undocumented memory access functions in Visual Basic 6

我的帖子中，可写有“首次发现、独家爆料”等等（或者表达类似意思的词句）描述？？？ 如果找不出来，你却偏要那样去理解，那也只是你的智商问题！ 这个论坛是交流编程技术的，不是“文学、著作”类型的论坛，你去抠这些字眼，有意思吗？？？ 注明出处？是不是我还应该向你缴纳版权费啊？？？ 网上那么多把别人的文章直接Ctrl+C然后Ctrl+V发表，明摆着是别人的东西却标明为“原创”发表的， 　　　　　你有本事，去管管啊！！！！！ 我的这个帖子，你看到哪一段内容是从那边Copy过来（直接的翻译也算啊）的？ 最多只能说是“主题相同”而已！ 难道说，别人已经发表过某个题材的文章了，别人就再也不允许发表相同题材的东西了？？？ 那是一篇“很老”的文章了，你可能是早就看到过的， 你为何不转载或“引述”向大家透露一下这种应用呢？ 要是看到在这儿有人发布过这些了，我也没必要再提起这个。 不过，你在这个论坛已经混了十几年了，我似乎从来没看到过你发表过什么“技术分享”的帖子吧！ 一个从来不与别人分享技术、心得的人，跑来砸场子，说我没有“注明出处”…… （严格说来，那些“文章”能算出处吗） 对于你这种人的心态，我也只能呵呵了…………

[PctGL]

..................lz 杯具.. 还不如就直接说了呢, 看到后来我才反应过来是啥么意思

[zdingyun]

有点意思，围观留印。

[足球中国]

来看热闹蝗还是比较多的。

[PixelDemon]

CopyMemory 和 GetMem都是通过DLL方式实现的调用，你这种小数据量的内部才能拷贝 大部分是会花在DLL的调用上。 tlb在程序编译时就知道接口函数在dll中的相对位置，这个调用花销比DLL少啊 不过我不太理解你1字节、4字节这样的要用外部函数辅助读取有什么实际意义呢。

[舉杯邀明月]

引用 47 楼 PixelDemon 的回复:

CopyMemory 和 GetMem都是通过DLL方式实现的调用，你这种小数据量的内部才能拷贝 大部分是会花在DLL的调用上。 tlb在程序编译时就知道接口函数在dll中的相对位置，这个调用花销比DLL少啊 不过我不太理解你1字节、4字节这样的要用外部函数辅助读取有什么实际意义呢。

在某些情况下，我们需要“按内存地址读或写一定字节的数据”，这时只有通过API才能实现； 在某些情况下，我们需要“在完全不同‘数据类型’的数据区之间传递字节序列”， 　　而不是是“按数据值”来传递值，这时也得用API来实现。 在通常情况下，都是用Copymemroy这个API来做（实际API入口是"RtlMoveMemory"）。 　　这是大家都非常熟悉的一个“内存操作”的API。 只是在某一些特定情况下，换用VB6（或VB5，按自己的IDE来用）中的相应API， 　　能够比用Copymemory提高一点儿运行效率。 这些“具体应用”场合，多数只有在串口通讯、加密解密算法中比较适用。 其它的一般应用，多半是用不到这些API的。

[qq_39996698]

谢谢分享 收下了！！！！

[cc_chencai]

谢谢分享 ，学习了！！！！

[weixin_40051443]

感谢分享