Sender: rochcock (chen3feng), letter area: MicrosoftTrd Title: My VB's function pointer invoking letter station: BBS Shuimu Tsinghua Station (Fri Jan 3 14:54:25 2003), transfer this article first in Shuimu Tsinghua BBS MicrosoftTrd version, please keep the information by author chen3feng (Roachcock@smth.org) email: chen3feng@163.com, chen3feng@hotmail.com, a few days ago before the 9CBS Document Center See a Matthew Curland VB function pointer call, it It is dynamically created a custom interface pointer and then returns a certain method, but this method although the efficiency is high, each function needs to create a custom interface type, but also to use the IDL language, it is not convenient, Yesterday I tried a solution, which is dynamically created an automated interface pointer. Although the efficiency is low, its flexibility is enough to make up this weakness. I only use two APIs to use two OLE API: Private Declare function createDisptyInfo lib "oleaut32" (byref pidata as _ interfacedata, byval LCID As long, byref pptinfo As IUnknown) As Long Private Declare function CreateStdDispatch Lib "oleaut32" (ByVal punkOuter _ As IUnknown, ByRef pvThis As Delegator, ByVal ptinfo As IUnknown, ByRef _ ppunkStdDisp As IUnknown) As Long before the function creates a type by specifying a description of the data Information, the latter creates an IDispatch pointer // vb's Object Type of the VC to create a data structure, so you need to fill in a data structure in order to create type information. Type, function declaration, no longer mention it.
For details on these two APIs, please refer to the MSDN implementation method First we need to simulate the structure of the classes in C , we need a custom structure to represent objects, 'Proxy object Private Type delegator PVTBL AS Long' virtual function table pointer PFUNC AS LONG 'a data member, here's a pointer end type' virtual function table private type vtable pthunk as ring 'to call the function of the X86 machine language, of course, I will write with vc end type' first, I am using VC End Type '. The assembly code of the Thunk that copied the machine code is as follows: 'Thunk machine code, plus NOP is to make a complete, each valid instruction is filled with a double word, more clear m_thunk (0) = & H4244C8B' MOV ECX, [ESP 4] Get this Pointer M_thunk (1) = & H9004418B 'MOV EAX, [ECX 4] NOP Get m_pfunc m_thunk (2) = & H90240C8B' MOV ECX, [ESP] NOP Get Return Address M_thunk (3) = & H4244C89 'MOV [ESP " 4], ECX Save Return Address M_thunk (4) = & H9004C483 'Add ESP, 4 NOP Re-Adjust Stack M_thunk (5) = & H9090E0FF' JMP EAX Jump to M_PFUNC Created This method is invoke, Dispid is 0, also That is, it is not possible to call the sample code directly to call the sample code private subform_load () DIM P AS FunctionPtr Set P = New FunctionPtr DIM D AS Object Set D = P.CREATE (Addressof Test, vbempty, vbstring) 'Test is a standard module Function d.Invoke "hehe" d "hehe" 'may be omitted Invoke' call Win32 API MessageBoxW Dim hModUser32 Dim pMessageBoxW As Long hModUser32 = GetModuleHandle ( "User32") pMessageBoxW = GetProcAddress (hModUser32, "MessageBoxW") Dim mbw As New FunctionPtr Dim MessageBoxw = mbw.create (PMessageBoxw, VT_I4, VT_BSTR, VT_BSTR, _ VT_BSTR, VT_I4) MessageBoxw 0, "Hehe, Form MessageBoxw", "", 0 'can omit in invoke end sub
Compiling the above code requires the introduction type library to operate the library, however, since OleAut32 only supports conversion to the automated compatibility type, only the automated compatible types are used, and due to the VB class does not support aggregation, the first parameter of CreateStddispatch is external IUNKNOWN pointer parameters cannot be used, which means that the FunctionPtr object must ensure that it is valid in the automation interface pointer of the CREATE method. This is a regret, although it is widely used during the debugging period, but it doesn't need it. No need to add an additional dynamic connection library to join the FunctionPtr class module to the project, create a FunctionPtr type object, call CREATE to get the first parameter of the automated object Create that can be returned to the function pointer, the second Returns the function of the function, the parameters of the number of applications are the type of the parameters of the function. It is very simple source code, including the complete test Project 'functionptr.cls' function pointer definition Version 1.0 Class Begin multiuse = -1 'True Persistable = 0' NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0' vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "FunctionPtr" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option ExplicitPrivate Const DISPATCH_METHOD = & H1private const locale_system_default = & h800Private const Dispid_value = 0
Private 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 1END ENUM
Private Type Paramdata Szname As String VT As VariantTypeConstantsend Type
Private Type METHODDATA szName As String ppdata As Long '/ * pointer to an array of PARAMDATAs * / dispid As Long' / * method ID * / iMeth As Long '/ * method index * / cc As CALLCONV' / * calling convention * / cArgs As Long '/ * count of arguments * / wFlags As Integer' / * same wFlags as on IDispatch :: Invoke () * / vtReturn As IntegerEnd TypePrivate Type INTERFACEDATA pmethdata As Long '/ * pointer to an array of METHODDATAs * / cMembers As lucked type
Private Declare Function CreateDispTypeInfo Lib "oleaut32" (ByRef pidata As INTERFACEDATA, ByVal lcid As Long, ByRef pptinfo As IUnknown) As LongPrivate Declare Function CreateStdDispatch Lib "oleaut32" (ByVal punkOuter As IUnknown, ByRef pvThis As Delegator, ByVal ptinfo As IUnknown, ByRef PPunkstddisp as iunknown) as long
Private Type vTable Pthunk As Longend Type
Private Type Delegator Pvtbl As Long Pfunc As Longend Type
Private m_thunk (5) as long
Private M_VTable As VTablePrivate M_Delegator As DelegatorPrivate M_InterfaceData AS InterfaceDataPrivate M_MethodData AsMETHODDATAPRIVATE M_PARAMDATA () AS ParamdataPrivate M_FunctionPtr As Object
Public Function Create (ByVal pFunc As Long, ByVal RetType As VariantTypeConstants, ParamArray ParamTypes () As Variant) As Object If TypeName (m_FunctionPtr) <> "Nothing" Then Set Create = m_FunctionPtr Exit Function End If Dim i As Long Dim p As Long DIM CPARAM As Long CParam = Ubound (paramtypes) 1 Redim M_Paramdata (CPARAM) IF CParam Then for i = 0 to CPARAM - 1 m_Paramdata (i) .vt = paramtypes (i) m_paramdata (i) .szname = "" Next End If 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 = 1dim TI as iUnknown Dim Result As IUnknown set result = Nothing i = createdisptyinfo (M _InterfaceData, LOCALE_SYSTEM_DEFAULT, ti) If i = 0 Then 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 (Nothing, M_Delegator, Ti, Result) if i = 0 THEN SET M_FunctionPtr = Result Set Create = m_functionptr End If End IFEND Function
Private sub class_initialize () 'Thunk machine code, plus NOP is for clear m_thunk (0) = & H4244C8B' MOV ECX, [ESP 4] get this Pointer M_thunk (1) = & H9004418B 'MOV EAX, [ECX 4] NOP Get m_pfunc m_thunk (2) = & H90240C8B 'MOV ECX, [ESP] NOP gets return address m_thunk (3) = & H4244C89' MOV [ESP 4], ECX Save Return Address M_thunk (4) = & H9004C483 'Add ESP, 4 NOP Recommo Adjusting the stack m_thunk (5) = & h9090e0ff 'JMP EAX jump to m_pfuncend su'Helper.cls' actually not helper, just the original name, including function attribute vb_name = "helper" option vb_name = "helper" Option Explicit
Sub Test1 (byref this as long) msgbox "test1", vbokonly, "hehe" End Sub
Sub Test (Byval S as String) Msgbox S, Vbokonly, "HEHE" End Sub 'Test Program Option Explicit
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPrivate Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Sub Form_Load () Dim p As FunctionPtr Set p = New FunctionPtr Dim d As Object Set d = p.Create (AddressOf Test, vbEmpty, 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 "," ", 0nd Sub 'Project file type = exe reason = * / g {00020430-0000-0000-c000-000000000046} # 2.0 # 0 #C: / windows / system / stdole2.tlb # Ole Automation form = form1.frm module = helper; helper.bas class = functionptr Engineering 1 "Exename32 =" project 1.exe "command32 =" "name =" engineering 1 "HelpContextId =" 0 "compatiblemode =" 0 "majorver = 1 minorver = 0 revisionver = 0 autoincrementVer = 0 Serversu pportFiles = 0 CompilationType = 0 OptimizationType = 2 FavorPentiumPro (tm) = 0 CodeViewDebugInfo = -1 NoAliasing = 0 BoundsCheck = 0 OverflowCheck = 0 FlPointCheck = 0FDIVCheck = 0 UnroundedFP = 0 StartMode = 0 Unattended = 0 Retained = 0 ThreadPerObject = 0 MaxNumberOfThreads = 1
