请求注释，并给予详细解释

yiyiyicz

这是一段不好懂的代码，参见两处链接
http://club.excelhome.net/thread-588684-1-1.html
http://club.excelhome.net/thread-903803-2-1.html：看13楼

难度大、风险大，功夫浅的绕道走吧！

1. 
   
2. Option Explicit
   
3. Option Base 0
   
4. Private Const DISPATCH_METHOD = &H1
   
5. Private Const LOCALE_SYSTEM_DEFAULT = &H800
   
6. Private Const DISPID_VALUE = 0
   
7. Private Enum CALLCONV
   
8.   CC_FASTCALL = 0
   
9.   CC_CDECL = 1
   
10.   CC_MSCPASCAL = CC_CDECL + 1
    
11.   CC_PASCAL = CC_MSCPASCAL
    
12.   CC_MACPASCAL = CC_PASCAL + 1
    
13.   CC_STDCALL = CC_MACPASCAL + 1
    
14.   CC_FPFASTCALL = CC_STDCALL + 1
    
15.   CC_SYSCALL = CC_FPFASTCALL + 1
    
16.   CC_MPWCDECL = CC_SYSCALL + 1
    
17.   CC_MPWPASCAL = CC_MPWCDECL + 1
    
18.   CC_MAX = CC_MPWPASCAL + 1
    
19. End Enum
    
20. Private Type PARAMDATA
    
21.   szName As String
    
22.   vt As Byte
    
23. End Type
    
24. Private Type METHODDATA
    
25.   szName As String
    
26.   ppdata As Long
    
27.   dispid As Long
    
28.   iMeth As Long
    
29.   cc As CALLCONV
    
30.   cArgs As Long
    
31.   wFlags As Integer
    
32.   vtReturn As Integer
    
33. End Type
    
34. Private Type INTERFACEDATA
    
35.   pmethdata As Long
    
36.   cMembers As Long
    
37. End Type
    
38. Private Type Delegator
    
39.   pVtbl As Long
    
40.   pFunc As Long
    
41. End Type
    
42. Private Type VTable
    
43.   pThunk As Long
    
44. End Type
    
45. Private Declare Function CreateDispTypeInfo Lib "oleaut32" (ByRef pidata As INTERFACEDATA, ByVal lcid As Long, ByRef pptinfo As IUnknown) As Long
    
46. Private Declare Function CreateStdDispatch Lib "oleaut32" (ByVal punkOuter As IUnknown, ByRef pvThis As Delegator, ByVal ptinfo As IUnknown, ByRef ppunkStdDisp As IUnknown) As Long
    
47. Private m_Thunk(5) As Long
    
48. Private m_VTable As VTable
    
49. Private m_Delegator As Delegator
    
50. Private m_InterfaceData As INTERFACEDATA
    
51. Private m_MethodData As METHODDATA
    
52. Private m_ParamData() As PARAMDATA
    
53. Private F As Object
    
54. Public Function GetZeroPoint#(ByVal pFunc As Long, ByVal a#, ByVal b#, Optional ByVal Epsi# = 0.000001)
    
55.   Create pFunc, vbDouble, vbDouble
    
56.   If F(a) * F(b) > 0 Or b <= a Then
    
57.     MsgBox "左端点和右端点取值不合适，请检查再试！！！"
    
58.     Exit Function
    
59.   End If
    
60.   Dim n%
    
61.   n = 0
    
62.   Do While b - a > Epsi
    
63.     GetZeroPoint = (b + a) / 2
    
64.     If Abs(F(GetZeroPoint)) <= Epsi Then Exit Do
    
65.     n = n + 1
    
66.     If n > 200 Then Exit Do
    
67.     If F(GetZeroPoint) * F(a) < 0 Then b = GetZeroPoint Else a = GetZeroPoint
    
68.   Loop
    
69. End Function
    
70. Private Sub Create(ByVal pFunc As Long, ByVal RetType As Byte, ParamArray ParamTypes() As Variant)
    
71.   If TypeName(F) <> "Nothing" Then Set F = Nothing
    
72.   Dim i As Long
    
73.   Dim p As Long
    
74.   Dim cParam As Long
    
75.   cParam = UBound(ParamTypes) + 1
    
76.   ReDim m_ParamData(cParam)
    
77.   If cParam Then
    
78.     For i = 0 To cParam - 1
    
79.         m_ParamData(i).vt = ParamTypes(i)
    
80.         m_ParamData(i).szName = ""
    
81.     Next
    
82.   End If
    
83.   m_MethodData.szName = "Invoke"
    
84.   m_MethodData.ppdata = VarPtr(m_ParamData(0))
    
85.   m_MethodData.dispid = DISPID_VALUE
    
86.   m_MethodData.iMeth = 0
    
87.   m_MethodData.cc = CC_STDCALL
    
88.   m_MethodData.cArgs = cParam
    
89.   m_MethodData.wFlags = DISPATCH_METHOD
    
90.   m_MethodData.vtReturn = RetType
    
91.   m_InterfaceData.pmethdata = VarPtr(m_MethodData)
    
92.   m_InterfaceData.cMembers = 1
    
93.   Dim ti As IUnknown
    
94.   Dim Result As IUnknown
    
95.   Set Result = Nothing
    
96.   i = CreateDispTypeInfo(m_InterfaceData, LOCALE_SYSTEM_DEFAULT, ti)
    
97.   If i = 0 Then
    
98.     m_VTable.pThunk = VarPtr(m_Thunk(0))
    
99.     m_Delegator.pVtbl = VarPtr(m_VTable)
    
100.     m_Delegator.pFunc = pFunc
     
101.     p = VarPtr(m_InterfaceData)
     
102.     p = VarPtr(m_Delegator)
     
103.     i = CreateStdDispatch(Nothing, m_Delegator, ti, Result)
     
104.     If i = 0 Then Set F = Result
     
105.   End If
     
106. End Sub
     
107. Private Sub Class_Initialize()
     
108.   m_Thunk(0) = &H4244C8B
     
109.   m_Thunk(2) = &H90240C8B
     
110.   m_Thunk(1) = &H9004418B
     
111.   m_Thunk(3) = &H4244C89
     
112.   m_Thunk(4) = &H9004C483
     
113.   m_Thunk(5) = &H9090E0FF
     
114. End Sub
     
115. Private Sub Class_Terminate()
     
116.     Set F = Nothing
     
117. End Sub

复制代码

yiyiyicz

代码出处见链接
http://club.excelhome.net/thread-588684-1-1.html
代码中出现了
“&H4244C8B”等应该是内存地址吧？
另外多处用到了API ,如“CreateDispTypeInfo”
在链接http://club.excelhome.net/thread-903803-2-1.html
13楼，说明此为“是自动化封装和激活调用”

看不明白
请求注释代码，并能深入浅出的给予解释
注意，附件中有类模块、模块，还有一个控件按钮中间也有代码
一楼的代码不全

yiyiyicz

这代码是能运行的，只是看不懂，无法灵活应用

感兴趣的诸位
第一个问题是那些地址该怎么写？按照什么原则来设定这些地址？
第二个问题，能详细解释API在这里怎么起作用的？
第三就是希望能深入浅出的讲解一下，这个程序的设计思路。自己怎么能改写？

yiyiyicz

这段代码要解决的问题，大致如上图所示。即若干个方程求解，全部使用一个求解方程的模块。而在调用该模块时，又需要自动选取相应的FUNC函数
FUNC函数不止一个，如何自动选取对应的那一个，是这段代码的关键，也是难点。

百度不到去谷歌

有刷屏嫌疑 这么长的代码 你觉得有人会闲到一步步去解释？
代码都在了 有基本的基础 就是自己F8逐行调试 增加debug.print 不懂的再百度谷歌
学习只能靠自己的

win2009

选项 清楚的显示
选项 Base 0
私有 常数 DISPATCH_METHOD = &H1
私有 常数 LOCALE_SYSTEM_DEFAULT = &H800
私有 常数 DISPID_VALUE = 0
私有 Enum CALLCONV
  CC_FASTCALL = 0
  CC_CDECL = 1
  CC_MSCPASCAL = CC_CDECL + 1
  CC_PASCAL = CC_MSCPASCAL
  CC_MACPASCAL = CC_PASCAL + 1
  CC_STDCALL = CC_MACPASCAL + 1
  CC_FPFASTCALL = CC_STDCALL + 1
  CC_SYSCALL = CC_FPFASTCALL + 1
  CC_MPWCDECL = CC_SYSCALL + 1
  CC_MPWPASCAL = CC_MPWCDECL + 1
  CC_MAX = CC_MPWPASCAL + 1
结束 Enum
私有 类型声明字符 PARAMDATA
  szName 为 字符串文字
  vt 为 字节型
结束 类型声明字符
私有 类型声明字符 METHODDATA
  szName 为 字符串文字
  ppdata 为 长整数
  dispid 为 长整数
  iMeth 为 长整数
  cc 为 CALLCONV
  cArgs 为 长整数
  wFlags 为 整数
  vtReturn 为 整数
结束 类型声明字符
私有 类型声明字符 INTERFACEDATA
  pmethdata 为 长整数
  cMembers 为 长整数
结束 类型声明字符
私有 类型声明字符 Delegator
  pVtbl 为 长整数
  pFunc 为 长整数
结束 类型声明字符
私有 类型声明字符 VTable
  pThunk 为 长整数
结束 类型声明字符
私有 声明 函数 CreateDispTypeInfo 引用库 "oleaut32" (ByRef pidata 为 INTERFACEDATA, ByVal lcid 为 长整数, ByRef pptinfo 为 IUnknown) 为 长整数
私有 声明 函数 CreateStdDispatch 引用库 "oleaut32" (ByVal punkOuter 为 IUnknown, ByRef pvThis 为 Delegator, ByVal ptinfo 为 IUnknown, ByRef ppunkStdDisp 为 IUnknown) 为 长整数
私有 m_Thunk(5) 为 长整数
私有 m_VTable 为 VTable
私有 m_Delegator 为 Delegator
私有 m_InterfaceData 为 INTERFACEDATA
私有 m_MethodData 为 METHODDATA
私有 m_ParamData() 为 PARAMDATA
私有 F 为 对象
公共的 函数 GetZeroPoint#(ByVal pFunc 为 长整数, ByVal a#, ByVal b#, 选择 ByVal Epsi# = 0.000001)
  Create pFunc, vbDouble, vbDouble
  如果 F(a) * F(b) > 0 或者 b <= a 那么
    MsgBox "左端点和右端点取值不合适,请检查再试！！！"
    退出 函数
  结束 如果
  定义 n%
  n = 0
  做 当 b - a > Epsi
    GetZeroPoint = (b + a) / 2
    如果 绝对值(F(GetZeroPoint)) <= Epsi 那么 退出 做
    n = n + 1
    如果 n > 200 那么 退出 做
    如果 F(GetZeroPoint) * F(a) < 0 那么 b = GetZeroPoint 否则 a = GetZeroPoint
  循环
结束 函数
私有 过程 Create(ByVal pFunc 为 长整数, ByVal RetType 为 字节型, ParamArray ParamTypes() 为 变体型)
  如果 TypeName(F)<>"Nothing" 那么 设置 F = 空值
  定义 i 为 长整数
  定义 p 为 长整数
  定义 cParam 为 长整数
  cParam = UBound(ParamTypes) + 1
  ReDim m_ParamData(cParam)
  如果 cParam 那么
    循环范围 i = 0 到 cParam - 1
        m_ParamData(i).vt = ParamTypes(i)
        m_ParamData(i).szName = ""
    下一个
  结束 如果
  m_MethodData.szName = "Invoke"
  m_MethodData.ppdata = VarPtr(m_ParamData(0))
  m_MethodData.dispid = DISPID_VALUE
  m_MethodData.iMeth = 0
  m_MethodData.cc = CC_STDCALL
  m_MethodData.cArgs = cParam
  m_MethodData.wFlags = DISPATCH_METHOD
  m_MethodData.vtReturn = RetType
  m_InterfaceData.pmethdata = VarPtr(m_MethodData)
  m_InterfaceData.cMembers = 1
  定义 ti 为 IUnknown
  定义 Result 为 IUnknown
  设置 Result = 空值
  i = CreateDispTypeInfo(m_InterfaceData, LOCALE_SYSTEM_DEFAULT, ti)
  如果 i = 0 那么
    m_VTable.pThunk = VarPtr(m_Thunk(0))
    m_Delegator.pVtbl = VarPtr(m_VTable)
    m_Delegator.pFunc = pFunc
    p = VarPtr(m_InterfaceData)
    p = VarPtr(m_Delegator)
    i = CreateStdDispatch(空值, m_Delegator, ti, Result)
    如果 i = 0 那么 设置 F = Result
  结束 如果
结束 过程
私有 过程 Class_Initialize()
  m_Thunk(0) = &H4244C8B
  m_Thunk(2) = &H90240C8B
  m_Thunk(1) = &H9004418B
  m_Thunk(3) = &H4244C89
  m_Thunk(4) = &H9004C483
  m_Thunk(5) = &H9090E0FF
结束 过程
私有 过程 Class_Terminate()
    设置 F = 空值
结束 过程

yiyiyicz

win2009 发表于 2014-6-14 23:09
选项 清楚的显示
选项 Base 0
私有 常数 DISPATCH_METHOD = &H1

谢谢，也许我没有说明白
现在3，4楼重新做了解释
关键是怎么理解“自动化封装和激活调用”？

下面的资料是针对8楼对代码原理解释的补充资料
在没有充分掌握VB/VBA之前，切不可冒然使用
这些资料统统来自网络，本人稍做编辑和注释

yiyiyicz

【相关资料】
类总是与VTable结构配对，以使得保持所有过程的地址。以下资料为“获得类模块中指定的函数地址”

大多数的编程语言都可以获取真实的函数地址。在汇编中，这个根本就不是问题，是正当的编程手段之一，windows也经常会应用这个称为回调函数的东西。但VB编程受限制，只能获取标准模块中的函数地址，而且该函数地址不可在运行时获取属于静态连接。

在进行对象编程时，经常用到类模块。最简单的类模块应用就是包装代码了，但遇到类似处理子类化窗口函数时经常会让你觉得很累，无法获取类模块中指定的函数地址，于是... 你不得不绕到模块中，通过动态调用的方式实现回调函数。比起 SetWindowLong xxx,xxx,any proc address 简直太费脑筋了，而且很多新手还不能理解这种编程思路，也无法应用。有些汇编高手开始从对象的底层做起一步一步的探索找到了 Thunk 的解决方法。其实这个方法是MS首先做出来的，只不过被coders们加强了。

利用所学的有限的知识我也做一下，争取解决他吧:

1. Private Function GetClassProcAddress(ByVal SinceCount As Long) As Long
   
2. '***************************************************************************************************
   
3. ' VB6 历史上最简单的获取类中指定函数地址的函数诞生了,can be get address of property to value ,too
   
4. '***************************************************************************************************
   
5. Dim i As Long, jmpAddress As Long
   
6. CopyMemory i, ByVal ObjPtr(Me), 4 ' get vtable
   
7. CopyMemory i, ByVal i + (SinceCount - 1) * 4 + &H1C, 4 ' 查表
   
8. CopyMemory jmpAddress, ByVal i + 1, 4 ' 获取的函数地址实际还是一个表,是一个跳转表
   
9. GetClassProcAddress = i + jmpAddress + 5 ' 计算跳转相对偏移取实际地址
   
10. End Function

复制代码

调用方法:

类模块中指定的函数地址 = GetClassProcAddress( 第几个函数 )

oo" 代码很少... 他能行吗? 没问题... 找到指定的函数地址是没问题的...

解释下这个函数：参数 SinceCount , 是从某个类模块中最顶端的函数或属性算起,他是第几个函数

这个参数有讲究...

1. 当被查找的函数为公用函数时，它的值就是自顶端算起的第几个函数，比如你在类模块中最顶端写的一个公用函数 WndProc，那么就传 1；如果是第2个公用函数或属性那么就传 2 依次... 注意,计算的时候要算上公用属性,公用属性也要算上,当他是函数,算做一个

2. 当被查找的函数为局部函数时,也就是说如果是 Private 修饰的函数,则此参数值为 所有公用函数个数 + 这是第 N 个私有函数也是从顶端算起,同样包括属性

说下原理：

对象是什么? 对象实际就是一个结构。VB，甚至 C++ 都不一定能让你真正深刻的理解最底层的对象构造，如果说 VB 能让你懂得什么叫继承则 C++ 能让你知道对象还可以变异....对象原来是那么简单，实现了那么高级的技术！

再向底层看，用汇编构造对象，你就可以看到，对象原来就是一个结构，结构中包括所有公用函数、属性的地址指针和连接、销毁函数指针等。那么,在返回到 VB，ObjPtr（善意提醒，此函数慎用！） 可以得到对象的 vTable 指针。通过查询 vTable 就可以得到我们想要的函数指针。前提是我们要知道编译器是按照什么样的顺序放置属性函数指针的。现在经过查询资料和测试，已经知道了，那就是 基址 + &H1C 所谓的基址其实就是vTable, &H1C就是VB给结构添加的和必要的函数指针所占用的空间。从vTable+&H1C 开始存储我们的函数地址，存储顺序如何,可以参照上面对 GetClassProcAddress 的参数 SinceCount 的解释。VB 把所有模块都单独的建立了一个表，每个表中又有单独的表表示他所包含的函数地址。

好了,函数和原理解释已经差不多了。再说说应用

很不幸的我要说,直接应用价值基本 = 0 , 郁闷啊... 为什么呢? 因为... 对象的函数他的第1个参数是vTable指针,第2个(暂时忘了,想起来再补)

于是你构造的函数有4个参数,但编译后该函数将有6个参数,那如果直接交给别人用,比如 APi 那还不出事吗...

会出事,但又不是不能弥补,加上少量的内嵌汇编代码,从新构造一个小函数,就可以完美的运行了,o... 还是很不错的选择

说了很多, 我也累了,就先打住了,总结起来,就是成功的用最简单的代码获取了类模块中指定的函数地址,从这个角度来说此文应该还是一精华文章吧?

等我有时间了,我会将弥补的汇编函数和 GetClassProcAddress 相结合,构造一个最简单化的代码,实现真正的类模块回调函数

yiyiyicz

【相关资料】

1，关于 “获取类模块中指定的函数地址之最强文”
http://www.cnblogs.com/pctgl/articles/1566676.html
文章中给出了一个 GetWndProcAddress 函数，专用于子类化接口的获取

2，获取类模块中指定的函数地址之最强文
http://www.cnblogs.com/pctgl/articles/1352916.html
文章中给出了 GetWndProcAddress 函数，增强版

3，关于 “获取类模块的函数地址” 的子类化
http://www.cnblogs.com/pctgl/articles/1586841.html

yiyiyicz

要想玩转此法，功夫得相当了得对于一般功力的（没有汇编基础，对操作系统一知半解的），最好不要折腾这玩意。【警告】搞不好，会把系统弄崩溃！用VB/VBA，还有其他的办法