1 Attachment(s)
[RESOLVED, not possible] Can't get "Class" AddressOf to work
Ok, I doubt I'll get help from LaVolpe or Caton, but maybe Wqweto or Eduardo will be able to help with this stuff.
I'm just trying to get a simple version of AddressOf for classes going.
I've tried both LaVolpe's GetAddressOfEx and Caton's zAddressOf, and both crash my IDE.
I've attached a small test project.
Also, here's the code in Form1 where I'm trying to do it:
Code:
Option Explicit
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Sub Form_Load()
Dim c As New Class1
Dim addr As Long
Dim iMethodCount As Long
Dim iLastMethodAddr As Long
Call c.one(1, 1) ' This works fine.
MsgBox "pause 1"
EnumWindows AddressOf zero, 0& ' This works fine. zero is in the BAS module.
MsgBox "pause 2"
addr = GetAddressOfEx(c, 1&, cptUnknown, iMethodCount, iLastMethodAddr)
'addr = zAddressOf(c, 1&) ' This also crashes the IDE if used.
EnumWindows addr, 0& ' This crashes the IDE. WHY????
MsgBox "pause 3" ' I've tried making all the Class1 procedures Private, no change.
End Sub
Re: Can't get "Class" AddressOf to work
I don't know enough about exactly how it works to tell you for sure *why*, but I can suggest using scb_SetCallbackAdress, as I successfully use it for the very similar EnumChildWindows in my TaskDialog class:
If m_cbEnum = 0& Then m_cbEnum = scb_SetCallbackAddr(2, 3)
Call EnumChildWindows(m_TDhWnd, m_cbEnum, ObjPtr(Me))
Where for me it's ordinal 3; the 2 is the number of arguments (as it should be for EnumWindows as well).
Re: Can't get "Class" AddressOf to work
Yeah, I was thinking that the number of arguments may have had something to do with the problem.
Fafalone, do you have a reference for the code under scb_SetCallbackAdress? Google turns up nothing.
FOUND IT!
Re: Can't get "Class" AddressOf to work
It's in the same Caton selfsub code as zAddressOf (which it calls internally, but does a bunch of stuff before and after).
Re: Can't get "Class" AddressOf to work
Quote:
Originally Posted by
fafalone
It's in the same Caton selfsub code as zAddressOf (which it calls internally, but does a bunch of stuff before and after).
Hi Fafalone,
This does seem to work, but it's not what I'd call "simple". I'd really just like something with no thunk, no subclassing, no IDE protection that I could throw into a CLS module (or maybe a FRM or CTL module) and get addresses of internal procedures for quick callback things, and preserve the idea of keeping all related code together.
I'll keep studying zAddressOf as well as your code to see if I can figure out why yours works and zAddressOf doesn't.
Re: Can't get "Class" AddressOf to work
Quote:
Originally Posted by
Elroy
I'd really just like something with no thunk, no subclassing, no IDE protection that I could throw into a CLS module (or maybe a FRM or CTL module) and get addresses of internal procedures for quick callback things, and preserve the idea of keeping all related code together.
If this was possible no one would bother writing thunks for this but directly solve the issue and continue churning code :-))
TB has done this now. No extra thunking needed, just use lPfn = AddressOf MyInstance.MyMethod and you get an address to an instance-bound trampoline which can be used as along as the instance is alive.
The trampoline must translate method signatures so that something like HRESULT MyMethod(MyClass *This, long dwData, long *RetVal) can be used to implement long MyCallback(long dwData) i.e. in methods the retval is actually an output param which is translated to a real retval.
Btw, here is a minimal self-containing AddressOfMethod impl from MST, no IDE protection at all but MyCallback method must be public (can be hidden)
Code:
'--- Form1
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Sub Form_Load()
Dim lPfn As Long
lPfn = InitAddressOfMethod(Me, 1).MyCallback(0)
Debug.Print Hex$(lPfn), Timer
End Sub
Public Function MyCallback(ByVal dwData As Long) As Long
End Function
Private Function InitAddressOfMethod(pObj As Object, ByVal MethodParamCount As Long) As Form1
Dim STR_THUNK As String: STR_THUNK = "6AAAAABag+oFV4v6ge9QEMEAgcekEcEAuP9EJAS5+QcAAPOri8LB4AgFuQAAAKuLwsHoGAUAjYEAq7gIAAArq7hEJASLq7hJCIsEq7iBi1Qkq4tEJAzB4AIFCIkCM6uLRCQMweASBcDCCACriTrHQgQBAAAAi0QkCIsAiUIIi0QkEIlCDIHqUBDBAIvCBTwRwQCri8IFUBHBAKuLwgVgEcEAq4vCBYQRwQCri8IFjBHBAKuLwgWUEcEAq4vCBZwRwQCri8IFpBHBALn5BwAAq4PABOL6i8dfgcJQEMEAi0wkEIkRK8LCEAAPHwCLVCQE/0IEi0QkDIkQM8DCDABmkItUJAT/QgSLQgTCBAAPHwCLVCQE/0oEi0IEg/gAfgPCBABZWotCDGgAgAAAagBSUf/gZpC4AUAAgMIIALgBQACAwhAAuAFAAIDCGAC4AUAAgMIkAA==" ' 25.3.2019 14:01:08
Const THUNK_SIZE As Long = 16728
Dim hThunk As Long
Dim lSize As Long
hThunk = pvThunkAllocate(STR_THUNK, THUNK_SIZE)
If hThunk = 0 Then
Exit Function
End If
lSize = CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle("kernel32"), "VirtualFree"), VarPtr(InitAddressOfMethod))
Debug.Assert lSize = THUNK_SIZE
End Function
Private Function pvThunkAllocate(sText As String, Optional ByVal Size As Long) As Long
Const MEM_COMMIT As Long = &H1000
Const PAGE_EXECUTE_READWRITE As Long = &H40
Const SIGN_BIT As Long = &H80000000
Static Map(0 To &H3FF) As Long
Dim baInput() As Byte
Dim lIdx As Long
Dim lChar As Long
Dim lPtr As Long
pvThunkAllocate = VirtualAlloc(0, IIf(Size > 0, Size, (Len(sText) \ 4) * 3), MEM_COMMIT, PAGE_EXECUTE_READWRITE)
If pvThunkAllocate = 0 Then
Exit Function
End If
'--- init decoding maps
If Map(65) = 0 Then
baInput = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
For lIdx = 0 To UBound(baInput)
lChar = baInput(lIdx)
Map(&H0 + lChar) = lIdx * (2 ^ 2)
Map(&H100 + lChar) = (lIdx And &H30) \ (2 ^ 4) Or (lIdx And &HF) * (2 ^ 12)
Map(&H200 + lChar) = (lIdx And &H3) * (2 ^ 22) Or (lIdx And &H3C) * (2 ^ 6)
Map(&H300 + lChar) = lIdx * (2 ^ 16)
Next
End If
'--- base64 decode loop
baInput = StrConv(Replace(Replace(sText, vbCr, vbNullString), vbLf, vbNullString), vbFromUnicode)
lPtr = pvThunkAllocate
For lIdx = 0 To UBound(baInput) - 3 Step 4
lChar = Map(baInput(lIdx + 0)) Or Map(&H100 + baInput(lIdx + 1)) Or Map(&H200 + baInput(lIdx + 2)) Or Map(&H300 + baInput(lIdx + 3))
Call CopyMemory(ByVal lPtr, lChar, 3)
lPtr = (lPtr Xor SIGN_BIT) + 3 Xor SIGN_BIT
Next
End Function
cheers,
</wqw>
Re: Can't get "Class" AddressOf to work
Hi wqweto,
It's clear that I don't have a deep understanding of the internal structure of an instantiated COM object.
But it just seems like we should be able to locate the vTable and start returning addresses in it.
Yeah, this assumes we'll get the argument count correct to our procedure, and that we know its count in the class. But it is confusing to me why it's more complex than this.
I'm guessing that the compiler somehow differentiates Private from Public (and maybe Friend), but the vTable is always 4-bytes per jump-to-procedure, right?
IDK, I'm sure I'm not understanding a great deal.
I'll take a good look at the code you posted.
Thanks
Re: Can't get "Class" AddressOf to work
Re: Can't get "Class" AddressOf to work
Quote:
Originally Posted by
Elroy
But it just seems like we should be able to locate the vTable and start returning addresses in it.
Yes, that's basically the idea. The $1M question is which index (which address) is the one we need from this VTable?
MST solution to this problem is to build a big fake VTable which point to generated ASM code which looks like this
Code:
M1: inc eax
M2: inc eax
M3: inc eax
M4: inc eax
...
M2048: inc eax
return OrigVTable[2048-eax]
. . . where M1 to M2048 are the addresses which populate the first 2048 entries in the fake VTable so that when you call method at index 8 the fake interface will return the address of 8th entry from the original VTable.
The light-weight object used above has a tweaked QueryInterface method too which allows it to be cast to *any* interface i.e. Dim p2 As IMyInterface : Set p2 = pThunk will always succeed but calling p2.MyMethod will get intercepted by the fake VTable.
Notice that InitAddressOfMethod is returning Form1, this can be tweaked to return *any* class/form/interface because it's actually the light-weight object with modded QI which gets returned here.
Then InitAddressOfMethod(Me, 1).MyCallback(0) is compiled by VB6 as a method call on Form1 (i.e. _Form1 interface) but this gets intercepted by the fake VTable to find out the index being called and to return the pfn from original VTable as outlined in the pseudo-ASM above.
Btw, the bulk of the code above is the manual base64 decoder because CryptStringToBinary is available on XP+ and I wanted MST to support any version down to NT4. Do you want me to reduce it to ~10 lines total?
cheers,
</wqw>
Re: Can't get "Class" AddressOf to work
Quote:
Originally Posted by
wqweto
Yes, that's basically the idea. The $1M question is which index (which address) is the one we need from this VTable?
I'd be happy if I could just use some trial-and-error to get the correct vTable index, crashing my IDE to find it.
But, aren't there published rules on the order of things in the vTables? If I knew the rules, I could just stare at my CLS module's code and figure out the correct index.
Quote:
Originally Posted by
wqweto
Do you want me to reduce it to ~10 lines total?
YES! Precisely! :p
Re: Can't get "Class" AddressOf to work
Here it is in 3 lines of code (w/ 5 API declares)
Code:
Option Explicit
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, pcbBinary As Long, Optional ByVal pdwSkip As Long, Optional ByVal pdwFlags As Long) As Long
Private Function InitAddressOfMethod(pObj As Object, ByVal MethodParamCount As Long) As Form1
Const STR_THUNK As String = "6AAAAABag+oFV4v6ge9QEMEAgcekEcEAuP9EJAS5+QcAAPOri8LB4AgFuQAAAKuLwsHoGAUAjYEAq7gIAAArq7hEJASLq7hJCIsEq7iBi1Qkq4tEJAzB4AIFCIkCM6uLRCQMweASBcDCCACriTrHQgQBAAAAi0QkCIsAiUIIi0QkEIlCDIHqUBDBAIvCBTwRwQCri8IFUBHBAKuLwgVgEcEAq4vCBYQRwQCri8IFjBHBAKuLwgWUEcEAq4vCBZwRwQCri8IFpBHBALn5BwAAq4PABOL6i8dfgcJQEMEAi0wkEIkRK8LCEAAPHwCLVCQE/0IEi0QkDIkQM8DCDABmkItUJAT/QgSLQgTCBAAPHwCLVCQE/0oEi0IEg/gAfgPCBABZWotCDGgAgAAAagBSUf/gZpC4AUAAgMIIALgBQACAwhAAuAFAAIDCGAC4AUAAgMIkAA==" ' 25.3.2019 14:01:08
Dim hThunk As Long
hThunk = VirtualAlloc(0, 16728, &H1000, &H40)
Call CryptStringToBinary(StrPtr(STR_THUNK), Len(STR_THUNK), 1, hThunk, 16728)
Call CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle("kernel32"), "VirtualFree"), VarPtr(InitAddressOfMethod))
End Function
Private Sub Form_Load()
Dim lPfn As Long
lPfn = InitAddressOfMethod(Me, 1).MyCallback(0)
Debug.Print Hex$(lPfn), Timer
End Sub
Public Function MyCallback(ByVal dwData As Long) As Long
End Function
Notice that MyCallback prototype is HRESULT MyCallback(Form1 *this, long dwData, long *RetVal) i.e. this is a function w/ 3 parameters -- the first one being the instance pointer and the last one being the result.
To use retuned lPfn as a callback for long MyCallback(long dwData) prototype you'll need some kind of trampoline which will first populate this pointer with concrete instance address and then translate result from RetVal output parameter to real return value.
Such trampoline is available for every kind of class in recent TB versions which is handy implementing WndProc/SubclassProc/TimerProc callbacks directly on forms etc. MST provides this too.
cheers,
</wqw>
Re: Can't get "Class" AddressOf to work
I like the trick of having the compiler reveal its own vtable
Has anyone looked into how the idispatch->invoke or itypeinfo->invoke finds the function address from dispid/memberid?
I haven’t spelunked through the reactos implementations fully yet. looks like we need to find the FUNCDESC struct
https://github.com/reactos/reactos/b...ypelib.c#L7283
Dispcallfunc may be another place to start.
Re: Can't get "Class" AddressOf to work
So stripped down code, starting with an object created from an vb6 ActiveX dll
Code:
IDispatch *IDisp;
ITypeInfo *IType;
ITypeInfo2 *IType2;
TYPEATTR *ta;
FUNCDESC *fd; //https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-oaut/d3349d25-e11d-4095-ba86-de3fda178c4e
OLECHAR *sMethodName = OLESTR("test");
DISPID dispid; // dispatch ID (same as IType memid)
hr = IDisp->GetTypeInfo(0,NULL,&IType);
hr = IType->QueryInterface(IID_ITypeInfo2, (void**)&IType2);
// Dispatch ID for the method name
hr=IDisp->GetIDsOfNames(IID_NULL,&sMethodName,1,LOCALE_USER_DEFAULT,&dispid);
hr= IType2->GetTypeAttr(&ta);
int vtable=0, tmp=0;
for(int i=0; i < ta->cFuncs;i++){
hr = IType2->GetFuncDesc(i, &fd);
if( !FAILED(hr) ){
printf("\t i=%d memid=%x vft=%x\n", i, fd->memid, fd->oVft);
if(fd->memid == dispid && fd->invkind == INVOKE_FUNC){
printf("Found it IDisp=%x + %x\n", (int)IDisp, fd->oVft);
tmp = fd->oVft;
_asm{ //some things are cleaner in asm... todo check nulls
mov eax, IDisp ; pointer to vtable
mov ebx, [eax] ; actual vtable
add ebx, tmp ; vtable offset
mov ecx, [ebx] ; func address at offset
mov tmp, ecx
}
printf("Final address: %x\n", tmp);
getch();
break;
}
}
}
still need to move this into a dll and double check that internal classes support ITypeInfo2 too
edit: baghh ITypeInfo2 is not implemented for internal vb6 classes...the info must still there but would have to reach into internal structures to get it.
just noticed ITypeInfo has the same methods, now works in the IDE , but ITypeInfo GetTypeAttr/GetFuncDesc returns not implemented error once compiled...
IDE uses an ITypeinfo implementation in vba6.dll,
compiled internal classes use a partial implementation in msvbvm60.dll,
activex dlls with tlb use a full implementation in oleaut32.dll
Re: Can't get "Class" AddressOf to work
Ok, I've finally read and studied enough to understand my fallacy about what I'm trying to do. Basically, I was hoping to allow things like EnumWindows (and other API calls with callbacks) to be wrapped entirely within class modules. And to do it with some relatively straightforward code.
However, after further reading (primarily some things stated by LaVolpe), I now understand that methods in a class have either one or two hidden arguments, even methods that appear to have no arguments at all. The first hidden argument is the address of the actual COM object. This is needed because COM code is re-entrant (with only one copy in memory), and this allows the underlying code to keep straight which instantiation is being called (and keep things like Statics and module level variables straight).
The second hidden argument is only present on Functions and Property Get methods, and it's actually the return value. It's placed in a return argument because class methods always return an HRESULT value (and not the value that seems to appear in the source code).
Therefore, for these reasons, a class method will never work as a callback for an API call, even if we know its address. Without some sophisticated thunk, I can't think of any way of circumventing these hidden arguments.
This post is primarily to myself, so I'll forever abandon the idea of trying to do this.
-----------------
ADDED:
Quote:
Originally Posted by
LaVolpe
In a class,
Private Sub TestMe() looks a bit like this under the covers:
Code:
Private Function TestMe(ByVal pThis As Long) As HRESULT
Quote:
Originally Posted by
LaVolpe
Private Function TestMe() As Long looks a bit like this under the covers:
Code:
Private Function TestMe(ByVal pThis As Long, ByVal ptrReturn As Long) As HRESULT
' ptrReturn is a pointer to memory that receives the function's value
ADDED2:
I'm putting this here just so I can possibly find it in the future. It's more notes from LaVolpe:
Quote:
For a class, [vTable pffsets] start at &H1C, but not always. The following are relative to IDE, uncompiled, and should be verified when compiled to see if things change...
1. VB places Public methods first in the VTable, then private and friend methods. The sort order, from some quick tests, are: Public methods first, in same order listed in the class. Then private and friend, in same order listed in the class. It appears, VB makes no distinction between friend and private, as far as sorting goes, when creating the vTable for the class
2. If the class contains any public variable declarations, i.e., Public mOwner As Long, then the first item in the class is offset and no longer at &H1C. From tests, it appears each Public variable declared at top of the class offsets the first method in the class by 8 bytes or 12 bytes. VB creates a Property Get/Let for such public variables. 8 bytes for non-Object/Variant variables (Get/Let), 12 bytes for Object/Variant variables (Get/Let/Set). These appear to be in order declared and the Property Get is before Property Let/Set in the vTable.
The class with no public variables declared, starts at offset &H1C. Forms start at &H6F8, this includes mdi forms, mdi child forms, as well as 'normal' forms.
Re: [RESOLVED, not possible] Can't get "Class" AddressOf to work
Btw, "re-entrant code" means that a function can be called *while* it's being executed i.e. your Button_Click is "clicked" (i.e. called) while it's been executed (because of DoEvents or other unfortunate message pump spinning).
COM code is not more "re-entrant" than normal procedural code in a BAS file in this sense.
COM is OOP based (with deep roots in MS's VC++ compiler for it's actual implementation i.e. vtables, offsets, etc. everything copied verbatim) and because in every OOP based language the methods need a this/self/Me pointer to know the instance data to work on so COM "inherited" all this from MSVC's virtual functions implementation. Pure abstract base classes became interfaces with vtables and everything the same as in MSVC.
cheers,
</wqw>
Re: [RESOLVED, not possible] Can't get "Class" AddressOf to work
Quote:
Originally Posted by
wqweto
Btw, "re-entrant code" means that a function can be called *while* it's being executed i.e. your Button_Click is "clicked" (i.e. called) while it's been executed (because of DoEvents or other unfortunate message pump spinning).
COM code is not more "re-entrant" than normal procedural code in a BAS file in this sense.
COM is OOP based (with deep roots in MS's VC++ compiler for it's actual implementation i.e. vtables, offsets, etc. everything copied verbatim) and because in every OOP based language the methods need a this/self/Me pointer to know the instance data to work on so COM "inherited" all this from MSVC's virtual functions implementation. Pure abstract base classes became interfaces with vtables and everything the same as in MSVC.
cheers,
</wqw>
Yes, I understand. I guess, what I meant more than anything, is that COM code isn't copied for each instantiation of the class (as I once thought many moons ago). There is obviously some fancy allocation of memory going on for different instantiations so that statics and module level variables can be correctly managed.
Also, there's some stack management even for local (non static) variables going on in the case of what I'd call recursion (re-entering the same instantiation before the first entry has completed).
But yeah, my specific point was that there are extra (hidden) arguments on class procedures that aren't on BAS module procedures, and I need to remember that. So, if we want to use something like DispCallFunc (and recognize these hidden arguments), we can do it. However, when using an API callback, there's no way to tell the API call that those extra arguments are there.
Re: [RESOLVED, not possible] Can't get "Class" AddressOf to work
