利用动态创建自动化接口实现VB的函数指针调用

PrivateConstDISPATCH_METHOD=&H1
PrivateConstLOCALE_SYSTEM_DEFAULT=&H800
PrivateConstDISPID_VALUE=0 财管 家园 fs119.net

PrivateEnumCALLCONV
CC_FASTCALL=0
CC_CDECL=1
CC_MSCPASCAL=CC_CDECL1
CC_PASCAL=CC_MSCPASCAL
CC_MACPASCAL=CC_PASCAL1
CC_STDCALL=CC_MACPASCAL1
CC_FPFASTCALL=CC_STDCALL1
CC_SYSCALL=CC_FPFASTCALL1
CC_MPWCDECL=CC_SYSCALL1
CC_MPWPASCAL=CC_MPWCDECL1
CC_MAX=CC_MPWPASCAL1
EndEnum 财软联盟,fs119.net

PrivateTypePARAMDATA
szNameAsString
vtAsVariantTypeConstants
EndType 财软联盟,fs119.net

PrivateTypeMETHODDATA
szNameAsString
ppdataAsLong´/*pointertoanarrayofPARAMDATAs*/
dispidAsLong´/*methodID*/
iMethAsLong´/*methodindex*/
ccAsCALLCONV´/*callingconvention*/
cArgsAsLong´/*countofarguments*/
wFlagsAsInteger´/*samewFlagsasonIDispatch::Invoke()*/
vtReturnAsInteger
EndType 财管家,园,fs119.net

PrivateTypeINTERFACEDATA
pmethdataAsLong´/*pointertoanarrayofMETHODDATAs*/
cMembersAsLong
EndType

财软,联盟,fs119.net

PrivateDeclareFunctionCreateDispTypeInfoLib"oleaut32"(ByRefpidataAsINTERFACEDATA,ByVallcidAsLong,ByRefpptinfoAsIUnknown)AsLong
PrivateDeclareFunctionCreateStdDispatchLib"oleaut32"(ByValpunkOuterAsIUnknown,ByRefpvThisAsDelegator,ByValptinfoAsIUnknown,ByRefppunkStdDispAsIUnknown)AsLong 财软联.盟.fs119.net

PrivateTypeVTable
pThunkAsLong
EndType 财管家.园.fs119.net

PrivateTypeDelegator
pVtblAsLong
pFuncAsLong
EndType 财 软联盟 fs119.net

Privatem_Thunk(5)AsLong 财管家园 fs119.net

Privatem_VTableAsVTable
Privatem_DelegatorAsDelegator
Privatem_InterfaceDataAsINTERFACEDATA
Privatem_MethodDataAsMETHODDATA
Privatem_ParamData()AsPARAMDATA
Privatem_FunctionPtrAsObject

财软联盟,fs119.net

PublicFunctionCreate(ByValpFuncAsLong,ByValRetTypeAsVariantTypeConstants,ParamArrayParamTypes()AsVariant)AsObject

IfTypeName(m_FunctionPtr)<>"Nothing"Then
SetCreate=m_FunctionPtr
ExitFunction
EndIf

DimiAsLong
DimpAsLong
DimcParamAsLong
cParam=UBound(ParamTypes)1

ReDimm_ParamData(cParam)

IfcParamThen
Fori=0TocParam-1
m_ParamData(i).vt=ParamTypes(i)
m_ParamData(i).szName=""
Next
EndIf
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

财软联 盟 fs119.net

DimtiAsIUnknown
DimResultAsIUnknown
SetResult=Nothing
i=CreateDispTypeInfo(m_InterfaceData,LOCALE_SYSTEM_DEFAULT,ti)
Ifi=0Then
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)
Ifi=0Then
Setm_FunctionPtr=Result
SetCreate=m_FunctionPtr
EndIf
EndIf
EndFunction 财 管家园 fs119.net

PrivateSubClass_Initialize()
´thunk的机器码,加nop是为了清晰
m_Thunk(0)=&H4244C8B´movecx,[esp4]获得thispointer
m_Thunk(1)=&H9004418B´moveax,[ecx4]nop获得m_pFunc
m_Thunk(2)=&H90240C8B´movecx,[esp]nop得到返回地址
m_Thunk(3)=&H4244C89´mov[esp4],ecx保存返回地址
m_Thunk(4)=&H9004C483´addesp,4nop重新调整堆栈
m_Thunk(5)=&H9090E0FF´jmpeax跳转到m_pFunc
EndSub

´Helper.cls´其实不是Helper,只是原来的名字而已，包含供测试的函数
AttributeVB_Name="Helper"
OptionExplicit

SubTest1(ByRefthisAsLong)
MsgBox"Test1",vbOKOnly,"hehe"
EndSub 财软联 盟 fs119.net

SubTest(ByValsAsString)
MsgBoxs,vbOKOnly,"hehe"
EndSub


´测试程序
OptionExplicit 财管.家园.fs119.net

PrivateDeclareFunctionGetModuleHandleLib"kernel32"Alias"GetModuleHandleA"(ByVallpModuleNameAsString)AsLong
PrivateDeclareFunctionGetProcAddressLib"kernel32"(ByValhModuleAsLong,ByVallpProcNameAsString)AsLong 财软联盟,fs119.net

PrivateSubForm_Load()
DimpAsFunctionPtr
Setp=NewFunctionPtr

DimdAsObject
Setd=p.Create(AddressOfTest,vbEmpty,vbString)

d.Invoke("hehe")

DimhModUser32
DimpMessageBoxWAsLong

hModUser32=GetModuleHandle("User32")
pMessageBoxW=GetProcAddress(hModUser32,"MessageBoxW")
DimmbwAsNewFunctionPtr
DimMessageBoxWAsObject
SetMessageBoxW=mbw.Create(pMessageBoxW,vbLong,vbLong,vbString,vbString,vbLong)
´MessageBoxA0,"hehe,formMessageBoxA","",0
MessageBoxW.Invoke0,"hehe,formMessageBoxW","",0
EndSub


´Project文件
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\
STDOLE2.TLB#OLEAutomation
Form=Form1.frm
Module=Helper;Helper.bas
Class=FunctionPtr;FunctionPtr.cls
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="工程1"
ExeName32="工程1.exe"
Command32=""
Name="工程1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0

财管.家园.fs119.net

ServerSupportFiles=0
CompilationType=0
OptimizationType=2
FavorPentiumPro(tm)=0
CodeViewDebugInfo=-1
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0

FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
财软联,盟,fs119.net

文章摘自网络,如有侵权,请与我们联系.

数据统计中！！