You can use a delegator light-weight object if you have to implement it all in VB6.
First you'll need a typelib with a custom interface with long
retvals by its methods because methods of a VB6 "interface" class always return HRESULT
and this will interfere with the delegator retvals (negative retvals will raise errors).
[
uuid(a4d82779-ed39-437c-9f42-89048603a82b),
version(1.0),
helpstring("Delegator Typelib 1.0")
]
library DelegatorLib
{
importlib("stdole2.tlb");
[
odl,
uuid(fdb250f4-4175-444f-8a53-72ecfcaf8fd0),
version(1.0),
]
interface IDelegator : IUnknown {
long Call0([in] long pfn);
long Call1([in] long pfn, [in] long A1);
long Call2([in] long pfn, [in] long A1, [in] long A2);
long Call3([in] long pfn, [in] long A1, [in] long A2, [in] long A3);
long Call4([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4);
long Call5([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4, [in] long A5);
long Call6([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4, [in] long A5, [in] long A6);
long Call7([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4, [in] long A5, [in] long A6, [in] long A7);
};
}
Then in a standard module you can implement the light-weight object -- a very minimal implementation would be enough.
Option Explicit
'--- for VirtualQuery'
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private m_aThunk(0 To 1) As Long
Private m_aVtbl(0 To 9) As Long
Public Type DelegatorData
pVTable As Long
End Type
Public Function InitDelegator(This As DelegatorData) As IDelegator
Dim dwDummy As Long
Dim lIdx As Long
If m_aVtbl(0) = 0 Then
m_aThunk(0) = &H51585859
m_aThunk(1) = &H9090E0FF
Call VirtualProtect(m_aThunk(0), 8, PAGE_EXECUTE_READWRITE, dwDummy)
m_aVtbl(0) = pvAddr(AddressOf pvQueryInterface)
m_aVtbl(1) = pvAddr(AddressOf pvAddRefRelease)
m_aVtbl(2) = pvAddr(AddressOf pvAddRefRelease)
For lIdx = 3 To 9
m_aVtbl(lIdx) = VarPtr(m_aThunk(0))
Next
End If
This.pVTable = VarPtr(m_aVtbl(0))
Call CopyMemory(InitDelegator, VarPtr(This), 4)
End Function
Private Function pvAddr(ByVal lPtr As Long) As Long
pvAddr = lPtr
End Function
Private Function pvQueryInterface(This As DelegatorData, ByVal riid As Long, pvObj As Long) As Long
pvObj = VarPtr(This)
End Function
Private Function pvAddRefRelease(This As DelegatorData) As Long
'--- do nothing
End Function
The thunk code is really the funny part, this is the assembly
00401030 59 pop ecx
00401031 58 pop eax
00401032 58 pop eax
00401033 51 push ecx
00401034 FF E0 jmp eax
So basicly it preserves return address in ecx
, gets rid of the first argument (this
) then pops and jumps to the second one (pfn
) and leaves the rest of the arguments intact. Then delegated function's epilog takes care of the stack (delegated function has to be in stdcall
calling convention).
You can initialize a (singleton) delegator like this
Private m_uDelegator As DelegatorData
Private m_pDelegator As IDelegator
Set m_pDelegator = InitDelegator(m_uDelegator)
And later use m_pDelegator
var directly like this
ret = m_pDelegator.Call0(AddressOf Test)
No clean-up necessary.
The rest of the CallN
functions use the same thunk but you can cut them out as you don't need these for your purposes.