大佬教程收集整理的这篇文章主要介绍了vb module_FunctionPtr 与FunctionPtr共同实现 CallFromDll callbyAddress 可以调用模块的函数/callbyname，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。
Option Explicit
''V0.6 与CallByAddress类似，代码基本一致，就是不知道怎么传ParamArray参数，导致代码重复。
Public Function CallFromDll(ByVal dllName As String,ByVal pFunc As String,ByVal RetType As VariantTypeConstants,ParamArray ParamTypes() As Variant)
Dim hMod
hMod = GetModuleHandle(dllName) '得到库里的模块地址
Dim hFunc As Long
hFunc = GetProcAddress(hMod,pFunC) '得到模块里的函数地址
''值处理
Dim ptype As Variant,ptstr() As Variant,ptChar As String
Dim plng As Integer,pti As Integer
Dim ptVal() As Variant,ptname() As Variant
plng = UBound(ParamTypes)
ReDim ptstr(plng) '类型名
ReDim ptVal(plng) '值列表
ReDim ptname(plng) '变量名列表，因为应用时常数被解释为局部值，无法传递给函数
For Each ptype In ParamTypes
ptstr(pti) = VarType(ptypE) 'vbVariant
ptVal(pti) = ptype
If ptstr(pti) = 8 Then ptChar = """" Else ptChar = ""
ptname(pti) = ptChar & ptype & ptChar
'ptname(pti) = "ptVal(" & pti & ")" '会提示类型不匹配，所以用前两句
pti = pti + 1
Next
''执行
Dim func As FunctionPtr
Set func = New FunctionPtr
On Error Resume Next
'MsgBox "CallFromDll=CallByAddress(" & hFunc & "," & RetType & "," & Join(ptname,",") & ")"
scriptRun.AddObject "func",func
scriptRun.AddCode "func.create " & hFunc & "," & Join(ptstr,") & ""
scriptRun.AddCode "func.object.Invoke " & Join(ptname,") & ""
scriptRun.Reset
CallFromDll = Err.number
End Function
''v0.6 调用函数 '注意事项：如果是Long类型，参数常数要以&结束。%结束是整型、单精!、双精#、货币@、变长字串$
''返回错误码 （函数地址，返回类型是，参数列表注意使用类型符）
Public Function CallByAddress(ByVal pFunc As Long,ParamArray ParamTypes() As Variant)
Dim ptype As Variant,ptname() As Variant
plng = UBound(ParamTypes)
ReDim ptstr(plng) '类型名
ReDim ptVal(plng) '值列表
ReDim ptname(plng) '变量名列表，因为应用时常数被解释为局部值，无法传递给函数
''以下变量，EbExecuteLine使用时得声明成公有
Dim ptypeStr As String,pvalName As String
Dim funO As Object
Dim func As FunctionPtr
Dim funcAdrress As Long,FuncRetType As VariantTypeConstants
'======================
pti = 0
For Each ptype In ParamTypes
ptstr(pti) = VarType(ptypE) 'vbVariant
ptVal(pti) = ptype
If ptstr(pti) = 8 Then ptChar = """" Else ptChar = ""
ptname(pti) = ptChar & ptype & ptChar
'ptname(pti) = "ptVal(" & pti & ")" '会提示类型不匹配，所以用前两句
pti = pti + 1
Next
ptypeStr = Join(ptstr,") '类型字符串
Set func = New FunctionPtr
funcAdrress = pFunc
FuncRetType = RetType
scriptRun.AddObject "func",func '添加外部对象
On Error Resume Next
scriptRun.AddCode "set funO=func.create(" & funcAdrress & "," & FuncRetType & "," & ptypeStr & ")"
'scriptRun.AddCode "set funO=func.create(" & pFunc & "," & vbEmpty & "," & vbString & ")"
'Set funO = func.Create(pFunc,vbEmpty,vbString)
pvalName = Join(ptname,") '值列表字符串
'MsgBox pvalName & ptstr(0) & VarType(ptVal(0)) & "func.object.Invoke " & pvalName & " "
scriptRun.AddCode "func.object.Invoke " & pvalName & " "
'func.object.Invoke "ssssss"
scriptRun.Reset
CallByAddress = Err.number
End Function
'==============测试函数
Private Sub Test1(ByRef this As Long)
MsgBox "Test1",vbOKOnly,"hehe"
End Sub
Private Sub test(ByVal s As String)
MsgBox s,"hehe"
End Sub
Private Sub test2() Dim p As FunctionPtr Set p = New FunctionPtr Dim d As Object Set d = p.Create(AddressOf test,vbLong,vbString) d.Invoke ("hehe") Dim hModUser32 Dim pmessageBoxW As Long hModUser32 = GetModuleHandle("User32") pmessageBoxW = GetProcAddress(hModUser32,"messageBoxW") Dim mbw As New FunctionPtr Dim messageBoxW As Object Set messageBoxW = mbw.Create(pmessageBoxW,vbString,vbLong) 'messageBoxA 0,"hehe,form messageBoxA","",0 messageBoxW.Invoke 0,form messageBoxW",0End Sub
以上是大佬教程为你收集整理的vb module_FunctionPtr 与FunctionPtr共同实现 CallFromDll callbyAddress 可以调用模块的函数/callbyname全部内容，希望文章能够帮你解决vb module_FunctionPtr 与FunctionPtr共同实现 CallFromDll callbyAddress 可以调用模块的函数/callbyname所遇到的程序开发问题。
如果觉得大佬教程网站内容还不错，欢迎将大佬教程推荐给程序员好友。
本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ：384754419，请注明来意。