VB module_functionptr and functionptr jointly implement callfromdll callbyaddress, which can call the module function/callbyname

Option explicit

''V0. 6 is similar to callbyaddress, and the code is basically the same, that is, you do not know how to pass the paramarray parameter, resulting in code duplication.
Public Function callfromdll (byval dllname as string, byval pfunc as string, byval rettype as varianttypeconstants, paramarray paramtypes () as variant)
Dim hmod
Hmod = getmodulehandle (dllname) 'to get the module address in the library

Dim hfunc as long
Hfunc = getprocaddress (hmod, pfunc) 'to obtain the function address in the module


''Value processing
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) 'type name
Redim ptval (PLNG) 'Value List
Redim ptname (PLNG) 'variable name list, because the application's regular number is interpreted as a local value and cannot be passed to the Function

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 & ")" 'will prompt that the type does not match, so use the first two sentences
PTI = PtI + 1
Next


''Execution
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 & "," & rettype & "," & join (ptstr ,",")&""
Scriptrun. addcode "func. Object. invoke" & join (ptname ,",")&""
Scriptrun. Reset
Callfromdll = err. Number
End Function

Note: if it is of the long type, the parameter constant must end. % The end is an integer or a single precision! , Double precision #, currency @, variable-length string $
''Return Error Code (function address, return type is, the parameter list must use a type character)
Public Function callbyaddress (byval pfunc as long, byval rettype as varianttypeconstants, paramarray paramtypes () as variant)
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) 'type name
Redim ptval (PLNG) 'Value List
Redim ptname (PLNG) 'variable name list, because the application's regular number is interpreted as a local value and cannot be passed to the Function

''The following variables are declared as public when ebexecuteline is used.
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 & ")" 'will prompt that the type does not match, so use the first two sentences
PTI = PtI + 1
Next
Ptypestr = join (ptstr, ",") 'type string

Set func = new functionptr
Funcadrress = pfunc
Funcrettype = rettype
Scriptrun. addobject "func", func' add External Object

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, ",") 'value list string
'Msgbox pvalname & ptstr (0) & vartype (ptval (0) & "func. Object. invoke" & pvalname &""
Scriptrun. addcode "func. Object. invoke" & pvalname &""
'Func. Object. invoke "ssssssss"
Scriptrun. Reset
Callbyaddress = err. Number
End Function

'================ Test the Function
Private sub test1 (byref this as long)
Msgbox "test1", vbokonly, "hehe"
End sub

Private sub test (byval s as string)
Msgbox S, vbokonly, "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, vblong, vblong, vbstring, vbstring, vblong)
'Messageboxa 0, "hehe, form messageboxa", "", 0
Messageboxw. Invoke 0, "hehe, form messageboxw", "", 0
End sub