[RESOLVED] Digging into COM from Class1 inside a standard VB6 EXE project.
I'd like to learn a bit more about getting into the guts of instantiated COM objects.
I know there are a few people here fairly on top of this. LaVolpe, Bonnie, Olaf, fafalone, TheTrick, and others certainly come to mind. And, of course, the illustrious Dexwerx, dilettante, and wqewto. Sorry if I've snubbed you in that list.
In the past, most of it distant, I've done assembler, C, Fortran, and even a bit of PLI programming. However, none of that directly dealt with COM object instantiation. In fact, most of it was before COM objects were used. Some of the Fortran actually did utilize COM objects, but not in a "getting into guts" way.
For years, in VB6, I've played around a bit with these COM object, messing around with the DispCallFunc API call; exploring what tlbinf32.dll can do for us; trying to get the ideas of how IUnknown, QueryInterface, AddRef, Remove work; understanding the idea of a vtable and a TypeLib; and how all that connects to the address returned by ObjPtr. But my knowledge is clearly not be-all-end-all with respect to these things.
I'd like to learn more, but the way I learn best is to have a specific task to tackle.
Therefore, here's my task: Let's forget external libraries, and stay strictly within a VB6 Standard EXE project. As we all know, we can create classes within these projects (and forms as well, which are just classes with a windows interface). And then, we can use object variables to instantiate these classes for use in our code (possibly even using the VB_PredeclaredId flag to auto-instantiate them).
So, within that circumscribed realm, here's what I'd like to do. I'd like to create a class (let's call it Class1 for simplicity). Then, I'd like to add some Public methods and properties to it. (Let's defer any discussion of "Friend" until another time.)
And then, I'll instantiate an object variable with this class. So, let's say we have the following:
Class1 code:
Code:
Option Explicit
Public testprop1 As String
'
Dim m_testprop2 As String
'
Public Property Let testprop2(s As String)
m_testprop2 = s
End Property
Public Property Get testprop2() As String
testprop2 = m_testprop2
End Property
Public Sub testsub(s As String)
Dim i As Long
i = i + 1
' just a nonsense test.
End Sub
Public Function testfunction() As Long
testfunction = Rnd * 10000
' another nonsense test.
End Function
And, in our Form1 that we're just using for testing, we've got:
Code:
Option Explicit
Private Sub Form_Load()
Dim c As Class1 ' Create object variable restricted to being instantiated with Class1.
Set c = New Class1 ' Instantiate Class1.
Stop
Unload Me
End Sub
Okay, here's my objective: I'd like to enumerate all the exposed (Public) methods and properties of my instantiated Class1 (in my c variable), and I'd like to do this both while running p-code in the IDE and while running machine code in a compiled program. I've managed to do it in the IDE using tlbinf32.dll. However, that same approach fails when you compile the program and run the executable.
At first, one might think that the necessary data isn't inside the executable. However, if that were true, how could something like the following work:
Code:
Option Explicit
Private Sub Form_Load()
Dim c As Class1 ' Create object variable restricted to being instantiated with Class1.
Set c = New Class1 ' Instantiate Class1.
CallByName c, "testprop1", VbLet, 1234
MsgBox c.testprop1 ' <--- clearly, CallByName found the "testprop1" property, as this reports 1234.
' OR
MsgBox CallByName(c, "testfunction", VbMethod) ' <--- successfully reports some random number.
' Again, the CallByName successfully finds the method.
' So, why can't we just enumerate them? !!!
' Obviously, CallByName can find the internal TypeLib table, so why can't we?
Stop
Unload Me
End Sub
Apparently, there's something like an internal TypeLib for each of our class (and form) modules in the executable. I think what I'm wanting to do is "get at" that TypeLib. I've explored the vtable with ObjPtr, but that doesn't get me anywhere. There are only pointers to the methods and properties in the vtable, no names.
It just seems like this should be possible. Any ideas?
Last edited by Elroy; Aug 19th, 2016 at 12:12 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
The information in a type library is basically a form of predigested declaration source code. Compilers use this like other source code, and compile it into object code.
So there isn't any reason for a compiled program to carry type information around unless it is to expose it for use by other projects. Such embedded type information is an optional convenience offered by OLE/ActiveX libraries, and an external TLB/OLB file could and often does serve the same purpose.
So a "standard" EXE project has no reason to embed type information... and so they don't. ActiveX server projects do, and VB6 normally does this for them. Optionally it can also create proxy TLBs ("Remote server files") for scenarios such as DCOM.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Enumerating members is all about the OLE Automation interface IDispatch (Object in VB).
but what do I know... I've been snubbed! (along with wqewto)
edit: funny thing is, i think i've actually posted code to do something similar somewhere on here.
I posted code for someone on here asking how to "discover" the undocumented API of a VB Script Host, by walking it's IDispatch members.
Last edited by DEXWERX; Aug 19th, 2016 at 12:07 PM.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Thanks for replying, dilettante. I should probably add your name to that list in post #1.
But, I'm still confused. You say that CallByName uses late-binding and IDispatch rather than a vtable approach. Okay, I could possibly be convinced of that.
However, let's not forget that I did everything within a single standard EXE project (as outlined in post #1). It's certainly reasonable to assume that either early-binding or late-binding could be used with a COM object. In fact, I just had that discussion in another thread about Word automation.
But, for both to be possible (especially the late-binding piece), doesn't that imply that there's a TypeLib somewhere that lays everything out? (Or maybe that's where my thinking is wrong, but I don't see how.) And therefore, if we're able to use late-binding on our Class1 within our project, where's the TypeLib?
Regards, and thanks again,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Pffff, haha, geez, fragile egos. I'll edit post #1.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Ohhh, pfff, I'll just create a bunch of alternative members and rep myself if I ever start worrying about that.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
You can retrieve this information from VBHeader structure. This code snippet allows to browse classes information within Standart-EXE application (just drop an EXE to window):
Code:
' //
' // VB-classes inforamtion by The trick
' //
Option Explicit
Private Type ClassData
strName As String
DispID As Long
MethOffst As Long
lpAddress As Long
End Type
Dim data() As ClassData
Dim dataCount As Long
Private Sub Form_Load()
End Sub
Private Sub lstClass_Click()
Dim index As Long
Dim last As Long
lstMethods.Clear
If lstClass.ListIndex = lstClass.ListCount - 1 Then
last = dataCount - 1
Else
last = lstClass.ItemData(lstClass.ListIndex + 1) - 1
End If
For index = lstClass.ItemData(lstClass.ListIndex) To last
If Len(data(index).strName) Then
lstMethods.AddItem data(index).strName
End If
'
' lstMethods.AddItem IIf(Len(data(index).strName), data(index).strName, "<no name>") ' & " " _
' & Hex(data(index).DispID) & " " _
' & Hex(data(index).lpAddress)
'
Next
End Sub
Private Sub lstClass_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim fle As Variant
For Each fle In data.Files
ParseFile fle
Exit For
Next
End Sub
Private Sub ParseFile(ByVal fileName As String)
Dim fNum As Integer
Dim elfaNew As Long
Dim entry As Long
Dim base As Long
Dim txtVA As Long
Dim txtRaw As Long
Dim ofst As Long
On Error GoTo ERRORHANDLER
lstClass.Clear
lstMethods.Clear
Erase data()
dataCount = 0
fNum = FreeFile
Open fileName For Binary As fNum
Get fNum, &H3C + 1, elfaNew ' e_lfanew
Get fNum, elfaNew + &H29, entry ' AddressOfEntryPoint
Get fNum, elfaNew + &H35, base ' ImageBase
Get fNum, elfaNew + &H105, txtVA ' .text VirtualAddress
Get fNum, elfaNew + &H10D, txtRaw ' .text PointerToRawData
ofst = txtRaw - txtVA - base + 1
Dim vbHdr As Long
Dim projInf As Long
Dim objTbl As Long
Dim total As Integer
Dim fType As Long
Dim desc As Long
Get fNum, ofst + entry + base + 1, vbHdr ' vbHeader
Get fNum, ofst + vbHdr + &H30, projInf ' lpProjectData
Get fNum, ofst + projInf + &H4, objTbl ' lpObjectTable
Get fNum, ofst + objTbl + &H2A, total ' wTotalObjects
Get fNum, ofst + objTbl + &H30, desc ' VbPublicObjectDescriptor
Do While total
total = total - 1
Get fNum, ofst + desc + total * &H30 + &H28, fType ' Module type
If CBool(fType And &H2) And Not CBool(fType And &HC0880) Then
' // Class
Dim methCount As Integer
Dim objInf As Long
Dim methAddr As Long
Dim ptrName As Long
Dim arrNames As Long
Dim cName As String
Dim privDesc As Long
Dim methArrTyp As Long
Dim member As Long
Dim idxMeth As Long
Dim methOffset As Integer
Get fNum, ofst + desc + total * &H30 + &H18, ptrName
cName = Strz(fNum, ofst + ptrName)
lstClass.AddItem cName
lstClass.ItemData(lstClass.NewIndex) = idxMeth
Get fNum, ofst + desc + total * &H30, objInf ' Obj info
Get fNum, ofst + desc + total * &H30 + &H20, arrNames
Get fNum, ofst + desc + total * &H30 + &H1C, methCount
Get fNum, ofst + objInf + &H68, methAddr ' lpMethods
Get fNum, ofst + objInf + &HC, privDesc ' VbPrivateObjectDescriptor
Get fNum, ofst + privDesc + &H18, methArrTyp
dataCount = dataCount + methCount
ReDim Preserve data(dataCount - 1)
Do While methCount
Get fNum, ofst + methArrTyp, member
If member Then
Get fNum, ofst + arrNames, ptrName
Get fNum, ofst + member + &H2, methOffset
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
Get fNum, ofst + member + &HC, data(idxMeth).DispID
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
methCount = methCount - 1
methArrTyp = methArrTyp + 4
arrNames = arrNames + 4
Loop
Do Until idxMeth > UBound(data)
Get fNum, ofst + methAddr, data(idxMeth).lpAddress
idxMeth = idxMeth + 1
methAddr = methAddr + 4
Loop
Dim propCount As Integer
Get fNum, ofst + privDesc + &H10, propCount
Get fNum, ofst + privDesc + &H20, arrNames
dataCount = dataCount + propCount
ReDim Preserve data(dataCount - 1)
Do While propCount
Get fNum, ofst + arrNames, member
If member Then
Get fNum, ofst + member + &H2, methOffset
Get fNum, ofst + member + &HC, data(idxMeth).DispID
Get fNum, ofst + member, ptrName
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
propCount = propCount - 1
arrNames = arrNames + 4
Loop
End If
Loop
Close fNum
Exit Sub
ERRORHANDLER:
MsgBox "Error"
End Sub
Private Function Strz(ByVal fNum As Integer, ByVal ofst As Long) As String
Dim b As Byte
Seek fNum, ofst
Get fNum, , b
Do While b
Strz = Strz & Chr$(b)
Get fNum, , b
Loop
End Function
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
@dil I would rep you if i could for that...
@Elroy As a starting point, this is the function i posted here that walks just the names of an IDispatch's members.
Code:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Sub PrintTypeInfo(Obj As Object)
Dim ti As ITypeInfo
Dim disp As oleexp3.IDispatch
Set disp = Obj
Set ti = disp.GetTypeInfo(0, 0)
If (Not ti Is Nothing) Then
Dim ta As TYPEATTR
Dim pTa As Long
pTa = ti.GetTypeAttr()
If pTa Then
CopyMemory ta, ByVal pTa, LenB(ta)
ti.ReleaseTypeAttr pTa '<--- another leak fix...
Dim f As Long
Dim fName As String
Dim fd As FUNCDESC
Dim pFd As Long
Dim fList As String
Dim Names As New Collection
For f = 0 To ta.cFuncs - 1
pFd = ti.GetFuncDesc(f)
If pFd Then
CopyMemory fd, ByVal pFd, LenB(fd)
ti.GetDocumentation fd.memid, fName, vbNullString, 0, vbNullString
SafeAdd Names, Trim(fName)
ti.ReleaseFuncDesc pFd '<--- sorry about the leak...
End If
Next f
Dim fn
For Each fn In Names
fList = fList & fn & vbCrLf
Next
MsgBox fList
End If
End If
End Sub
Private Function SafeAdd(c As Collection, Item As String)
On Error Resume Next
c.Add Item, Item
If Err.Number Then Err.Clear
On Error GoTo 0
End Function
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by The trick
I'm sorry but as far as i know it doesn't work in compiled form.
ADDED
@Elroy, also look at on this example and this project.
now is that because Class1 is no longer public (when compiled?) It's interesting that it returns a valid ITypeInfo, but one that doesn't implement GetTypeAttr...
I wonder if it works with a Public class.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Okey dokey,
@Trick, that pretty cool code (post #10).
Also, maybe my terminology is a bit off, but I'd tend to call the internal TypeLib what the IDispatch is working with (GetIDsOfNames and Invoke methods). But I'm more than willing to be corrected if this isn't correct.
However, along with using the TypeName function on any instantiated object variable, you actually answered the question with respect to compiled code. IMHO, that's pretty impressive.
I certainly didn't get all of the workings of the VBHeader structure sorted out, but I did rework your code quite a bit. Mostly, to force myself to somewhat "think through" what you're doing. It's also now more VB6-ish, rather than C-ish. Not sure if that's a plus or minus, but that's what I did.
I also worked hard to encapsulate that ParseFile procedure. I renamed it to GetAppClassInfo, and it's now a function that returns a nested UDT with all the info.
If anyone would like to mess with it...
start a new project
put the following code into Form1
add a List1 and List2 on this form
also, to truly see it in operation, you need to throw a couple of class modules in your project with some Public stuff. Just try several things. Names of methods, properties, public variables don't matter; that's sort of the point.
You'll also have to compile the code, because this only works in compiled code. Once it's compiled, you'll immediately see all your classes. If you click a class in List1, you'll see its public members.
Code:
'
' VB-classes information by The trick, modified by Elroy.
'
Option Explicit
'
Private Enum MethodOrProperty
Method = 1
Property = 2
End Enum
'
Private Type MethPropType
Name As String ' Name of method or property.
DispID As Long ' Not really used.
lpAddress As Long ' Also, not really used.
MethOrProp As MethodOrProperty ' Once all gathered, this isn't really needed.
End Type
'
Private Type ClassType
Name As String ' Name of class.
Meths() As MethPropType ' Array of methods, zero based.
MethCount As Long ' Count of methods.
Props() As MethPropType ' Array of properties, zero based.
PropCount As Long ' Count of properties.
idxMethProp As Long ' Basically, used only internally.
End Type
'
Private Type AppType
Classes() As ClassType ' Array of classes for the EXE.
ClassesCount As Long ' Count of classes in the EXE.
End Type
'
Dim TheApp As AppType
'
Private Sub Form_Load()
Dim i As Long
'
' Load up TheApp and then show classes in listbox.
TheApp = GetAppClassInfo()
List1.Clear
List2.Clear
For i = 0 To TheApp.ClassesCount - 1
List1.AddItem TheApp.Classes(i).Name
Next i
End Sub
Private Sub List1_Click()
Dim i As Long
'
List2.Clear
For i = 0 To TheApp.Classes(List1.ListIndex).MethCount - 1
List2.AddItem TheApp.Classes(List1.ListIndex).Meths(i).Name
Next i
For i = 0 To TheApp.Classes(List1.ListIndex).PropCount - 1
List2.AddItem TheApp.Classes(List1.ListIndex).Props(i).Name
Next i
End Sub
Private Function GetAppClassInfo(Optional sExeFileSpec As String) As AppType
' Pull information out of the VBHeader structure.
' If sExeFileSpec isn't specified, it assumes we're compiled and tries to do it on "this" exe.
'
Dim data() As MethPropType
Dim dataCount As Long
'
Dim hFile As Long
Dim iMemOffset As Long
'
Dim elfaNew As Long
Dim entry As Long
Dim base As Long
Dim txtVA As Long
Dim txtRaw As Long
'
Dim vbHdr As Long
Dim projInf As Long
Dim objTbl As Long
Dim total As Integer
Dim fType As Long
Dim desc As Long
'
Dim MethCount As Integer
Dim PropCount As Integer
Dim objInf As Long
Dim methAddr As Long
Dim ptrName As Long
Dim arrNames As Long
Dim cName As String
Dim privDesc As Long
Dim methArrTyp As Long
Dim member As Long
Dim idxMeth As Long
Dim methOffset As Integer
'
If sExeFileSpec = "" Then
On Error Resume Next
Debug.Print 1 / 0
If Err Then
MsgBox "Can't do this in the IDE."
On Error GoTo 0
Exit Function
End If
On Error GoTo 0
sExeFileSpec = App.Path & "\" & App.EXEName & ".exe"
End If
'
' Open the EXE.
hFile = FreeFile
Open sExeFileSpec For Binary As hFile
'
With GetAppClassInfo
'
Get hFile, &H3C + 1, elfaNew ' e_lfanew
Get hFile, elfaNew + &H29, entry ' AddressOfEntryPoint
Get hFile, elfaNew + &H35, base ' ImageBase
Get hFile, elfaNew + &H105, txtVA ' .text VirtualAddress
Get hFile, elfaNew + &H10D, txtRaw ' .text PointerToRawData
'
iMemOffset = txtRaw - txtVA - base + 1
Get hFile, iMemOffset + entry + base + 1, vbHdr ' vbHeader
Get hFile, iMemOffset + vbHdr + &H30, projInf ' lpProjectData
Get hFile, iMemOffset + projInf + &H4, objTbl ' lpObjectTable
Get hFile, iMemOffset + objTbl + &H2A, total ' wTotalObjects
Get hFile, iMemOffset + objTbl + &H30, desc ' VbPublicObjectDescriptor
'
Do While total
'
total = total - 1
Get hFile, iMemOffset + desc + total * &H30 + &H28, fType ' Module type
If CBool(fType And &H2) And Not CBool(fType And &HC0880) Then
'
Get hFile, iMemOffset + desc + total * &H30 + &H18, ptrName
cName = AsciiZ2Mem(hFile, iMemOffset + ptrName)
'
.ClassesCount = .ClassesCount + 1
ReDim Preserve .Classes(.ClassesCount - 1)
.Classes(.ClassesCount - 1).Name = cName
.Classes(.ClassesCount - 1).idxMethProp = idxMeth
'
Get hFile, iMemOffset + desc + total * &H30, objInf ' Obj info
Get hFile, iMemOffset + desc + total * &H30 + &H20, arrNames
Get hFile, iMemOffset + desc + total * &H30 + &H1C, MethCount
Get hFile, iMemOffset + objInf + &H68, methAddr ' lpMethods
Get hFile, iMemOffset + objInf + &HC, privDesc ' VbPrivateObjectDescriptor
Get hFile, iMemOffset + privDesc + &H18, methArrTyp
'
dataCount = dataCount + MethCount
ReDim Preserve data(dataCount - 1)
'
Do While MethCount
'
Get hFile, iMemOffset + methArrTyp, member
If member Then
Get hFile, iMemOffset + arrNames, ptrName
Get hFile, iMemOffset + member + &H2, methOffset
'
methOffset = methOffset And &HFFFFFFFE
Get hFile, iMemOffset + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
Get hFile, iMemOffset + member + &HC, data(idxMeth).DispID
'
cName = AsciiZ2Mem(hFile, iMemOffset + ptrName)
data(idxMeth).Name = cName
data(idxMeth).MethOrProp = Method
idxMeth = idxMeth + 1
End If
'
MethCount = MethCount - 1
methArrTyp = methArrTyp + 4
arrNames = arrNames + 4
Loop
'
Do Until idxMeth > dataCount - 1
Get hFile, iMemOffset + methAddr, data(idxMeth).lpAddress
idxMeth = idxMeth + 1
methAddr = methAddr + 4
Loop
'
Get hFile, iMemOffset + privDesc + &H10, PropCount
Get hFile, iMemOffset + privDesc + &H20, arrNames
'
dataCount = dataCount + PropCount
'
ReDim Preserve data(dataCount - 1)
'
Do While PropCount
'
Get hFile, iMemOffset + arrNames, member
If member Then
Get hFile, iMemOffset + member + &H2, methOffset
Get hFile, iMemOffset + member + &HC, data(idxMeth).DispID
Get hFile, iMemOffset + member, ptrName
'
methOffset = methOffset And &HFFFFFFFE
Get hFile, iMemOffset + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
'
cName = AsciiZ2Mem(hFile, iMemOffset + ptrName)
data(idxMeth).Name = cName
data(idxMeth).MethOrProp = Property
idxMeth = idxMeth + 1
End If
'
PropCount = PropCount - 1
arrNames = arrNames + 4
Loop
End If
Loop
'
Close hFile
'
' Now sort out the methods and properties.
Dim idxCls As Long
Dim ptrLast As Long
Dim idxData As Long
'
For idxCls = 0 To .ClassesCount - 1
If idxCls = .ClassesCount - 1 Then
ptrLast = dataCount - 1
Else
ptrLast = .Classes(idxCls + 1).idxMethProp - 1
End If
'
With .Classes(idxCls)
For idxData = .idxMethProp To ptrLast
If Len(data(idxData).Name) Then
Select Case data(idxData).MethOrProp
Case Method
.MethCount = .MethCount + 1
ReDim Preserve .Meths(.MethCount - 1)
.Meths(.MethCount - 1) = data(idxData)
Case Property
.PropCount = .PropCount + 1
ReDim Preserve .Props(.PropCount - 1)
.Props(.PropCount - 1) = data(idxData)
End Select
End If
Next idxData
End With
Next idxCls
'
End With
End Function
Private Function AsciiZ2Mem(hFile As Long, iMemOffset As Long) As String
' Pulls an ASCIIZ string out of the file into VB6 string.
' Definitely won't work if string in file is Unicode.
' File must already be open.
Dim b As Byte
'
Seek hFile, iMemOffset
Get hFile, , b
Do While b
AsciiZ2Mem = AsciiZ2Mem & Chr$(b)
Get hFile, , b
Loop
End Function
Trick was concerned that it had bugs. Other than not watching closely for arrays being over-run, it seemed to work fine. For this modification, so long as the counts are always used before addressing arrays, I couldn't break it, even in the case of an EXE with no classes, or a class with no members.
Something else that's curious to me is why this didn't return any information about my forms.
Also, it doesn't return any formation about Friend or Private members. However, that makes sense. CallByName doesn't work with those either. I'm thinking that any TypeLib (or actual procedure name) information is truly lost upon compiling for these.
Now, I suppose my next task is to make a branch so that I can also do this with the IDE. I'm thinking that that'll be easier than what's already done. It's been a bit, but I've done that one before.
Everyone, have a nice weekend.
Elroy
EDIT1: Also, this can all fairly easily be placed into a standard module (or even a class module) for production use. That's certainly what I'd do.
EDIT2: @Trick: Any ideas on how to differentiate Property Get, Property Let, Property Set?
EDIT3: Alright, it's still pretty cool code, but there are some bugs in it. Nothing to make anything crash, but the labeling of things isn't correct. There are two types of members (methods and properties). At first glance, it appeared there was a loop for each of these. However, that's not what the two loops are about. Instead, the first loop covers all Methods and Properties with procedures. The second loop covers Public variables, which I always assumed were just properties as well. But apparently, they're treated separately in the ObjectTable, PublicObjectDescriptor, ObjectInformation, & PrivateObjectDescriptor. Also, I think it's important to differentiate between methods and properties, as well as the Get/Let/Set of properties. I'm still working on all of this, but it's slow going. This stuff is tedious.
I'm willing to post my cleaned-up ("to date") code if anyone would like to see it, but I'll wait on someone to ask.
Last edited by Elroy; Aug 19th, 2016 at 10:25 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by Elroy
However, let's not forget that I did everything within a single standard EXE project (as outlined in post #1). It's certainly reasonable to assume that either early-binding or late-binding could be used with a COM object. In fact, I just had that discussion in another thread about Word automation.
But, for both to be possible (especially the late-binding piece), doesn't that imply that there's a TypeLib somewhere that lays everything out? (Or maybe that's where my thinking is wrong, but I don't see how.) And therefore, if we're able to use late-binding on our Class1 within our project, where's the TypeLib?
Elroy
This is actually correct for not so obvious reasons. The thing is that VB6 compiler actually does not implement IDisptach for each and every class with a giant switch, marshaling parameters like crazy and what not -- this would be enormously bulky piece of code!
What it does is to lower (compile) vtable based interfaces with all the gory details and then use OS provided helper functions inside a simple lean IDispatch implementation. The thing is that these OS provided helper functions require `ITypeInfo` that describe the object passed in `this` pointer. So actually there is some part of a typelib (or a proto-typelib) for all the IDispatch interfaces in the project to be implemented with lean stubs, even for private classes.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by Elroy
EDIT2: @Trick: Any ideas on how to differentiate Property Get, Property Let, Property Set?
Hi. You can obtain this information from the internal ancillary structures. I've little bit improved the example:
Code:
' //
' // VB-classes inforamtion by The trick
' //
Option Explicit
Private Type ClassData
strName As String
DispID As Long
MethOffst As Long
lpAddress As Long
MethType As Byte
End Type
Dim data() As ClassData
Dim dataCount As Long
Private Sub lstClass_Click()
Dim index As Long
Dim last As Long
Dim sItem As String
lstMethods.Clear
If lstClass.ListIndex = lstClass.ListCount - 1 Then
last = dataCount - 1
Else
last = lstClass.ItemData(lstClass.ListIndex + 1) - 1
End If
For index = lstClass.ItemData(lstClass.ListIndex) To last
If Len(data(index).strName) Then
Select Case data(index).MethType
Case VbGet: sItem = "Public Property Get"
Case VbLet: sItem = "Public Property Let"
Case VbSet: sItem = "Public Property Set"
Case VbMethod: sItem = "Public Function"
Case 255: sItem = "Public Variable"
End Select
lstMethods.AddItem sItem & " " & data(index).strName & "()"
End If
'
' lstMethods.AddItem IIf(Len(data(index).strName), data(index).strName, "<no name>") ' & " " _
' & Hex(data(index).DispID) & " " _
' & Hex(data(index).lpAddress)
'
Next
End Sub
Private Sub lstClass_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim fle As Variant
For Each fle In data.Files
ParseFile fle
Exit For
Next
End Sub
Private Sub ParseFile(ByVal fileName As String)
Dim fNum As Integer
Dim elfaNew As Long
Dim entry As Long
Dim base As Long
Dim txtVA As Long
Dim txtRaw As Long
Dim ofst As Long
On Error GoTo ERRORHANDLER
lstClass.Clear
lstMethods.Clear
Erase data()
dataCount = 0
fNum = FreeFile
Open fileName For Binary As fNum
Get fNum, &H3C + 1, elfaNew ' e_lfanew
Get fNum, elfaNew + &H29, entry ' AddressOfEntryPoint
Get fNum, elfaNew + &H35, base ' ImageBase
Get fNum, elfaNew + &H105, txtVA ' .text VirtualAddress
Get fNum, elfaNew + &H10D, txtRaw ' .text PointerToRawData
ofst = txtRaw - txtVA - base + 1
Dim vbHdr As Long
Dim projInf As Long
Dim objTbl As Long
Dim total As Integer
Dim fType As Long
Dim desc As Long
Get fNum, ofst + entry + base + 1, vbHdr ' vbHeader
Get fNum, ofst + vbHdr + &H30, projInf ' lpProjectData
Get fNum, ofst + projInf + &H4, objTbl ' lpObjectTable
Get fNum, ofst + objTbl + &H2A, total ' wTotalObjects
Get fNum, ofst + objTbl + &H30, desc ' VbPublicObjectDescriptor
Do While total
total = total - 1
Get fNum, ofst + desc + total * &H30 + &H28, fType ' Module type
If CBool(fType And &H2) And Not CBool(fType And &HC0880) Then
' // Class
Dim methCount As Integer
Dim objInf As Long
Dim methAddr As Long
Dim ptrName As Long
Dim arrNames As Long
Dim cName As String
Dim privDesc As Long
Dim methArrTyp As Long
Dim member As Long
Dim idxMeth As Long
Dim methOffset As Integer
Dim MethType As Byte
Get fNum, ofst + desc + total * &H30 + &H18, ptrName
cName = Strz(fNum, ofst + ptrName)
lstClass.AddItem cName
lstClass.ItemData(lstClass.NewIndex) = idxMeth
Get fNum, ofst + desc + total * &H30, objInf ' Obj info
Get fNum, ofst + desc + total * &H30 + &H20, arrNames
Get fNum, ofst + desc + total * &H30 + &H1C, methCount
Get fNum, ofst + objInf + &H68, methAddr ' lpMethods
Get fNum, ofst + objInf + &HC, privDesc ' VbPrivateObjectDescriptor
Get fNum, ofst + privDesc + &H18, methArrTyp
dataCount = dataCount + methCount
ReDim Preserve data(dataCount - 1)
Do While methCount
Get fNum, ofst + methArrTyp, member
If member Then
Get fNum, ofst + arrNames, ptrName
Get fNum, ofst + member + &H2, methOffset
Get fNum, ofst + member, MethType
MethType = 2 ^ (MethType And &H3)
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
Get fNum, ofst + member + &HC, data(idxMeth).DispID
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
data(idxMeth).MethType = MethType
idxMeth = idxMeth + 1
End If
methCount = methCount - 1
methArrTyp = methArrTyp + 4
arrNames = arrNames + 4
Loop
Do Until idxMeth > UBound(data)
Get fNum, ofst + methAddr, data(idxMeth).lpAddress
idxMeth = idxMeth + 1
methAddr = methAddr + 4
Loop
Dim propCount As Integer
Get fNum, ofst + privDesc + &H10, propCount
Get fNum, ofst + privDesc + &H20, arrNames
dataCount = dataCount + propCount
ReDim Preserve data(dataCount - 1)
Do While propCount
Get fNum, ofst + arrNames, member
If member Then
Get fNum, ofst + member + &H2, methOffset
Get fNum, ofst + member + &HC, data(idxMeth).DispID
Get fNum, ofst + member, ptrName
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
data(idxMeth).MethType = 255
idxMeth = idxMeth + 1
End If
propCount = propCount - 1
arrNames = arrNames + 4
Loop
End If
Loop
Close fNum
Exit Sub
ERRORHANDLER:
MsgBox "Error"
End Sub
Private Function Strz(ByVal fNum As Integer, ByVal ofst As Long) As String
Dim b As Byte
Seek fNum, ofst
Get fNum, , b
Do While b
Strz = Strz & Chr$(b)
Get fNum, , b
Loop
End Function
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
@The Trick: Super cool. I'll be looking at it later today.
@wqweto (post #16): Yeah, I figured it was something like that. Thanks for the info.
Last edited by Elroy; Aug 21st, 2016 at 01:45 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
@The Trick: Gosh, I feel like I'm asking a lot, and you have been incredible with sharing your knowledge about these COM objects.
If you've got the time, one last question, and this would be truly sorted.
You sort of ... erm ... punted a bit when it came to the Public Variables.
Code:
data(idxMeth).MethType = 255
If we could differentiate Object variables from all other variables, this exploration could be called totally done. (Sort of like Property Let is differentiated from Property Set.)
With what you've provided in the VB6 reflection thread, I could do it that way, but doing it while we're digging into these tables would be ideal.
Any ideas?
Much Regards,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
@Trick:
Well darned, digging out the Type isn't working for me
Code:
Get fNum, ofst + member, MethType ' <---- Always seems to return ZERO.
MethType = 2 ^ (MethType And &H3)' <---- Always evaluates to ONE, which makes sense if MethType starts out ZERO.
You've been so spot on with other stuff. Oh well, any ideas?
Regards,
Elroy
p.s. Everything else is working absolutely fine.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by Elroy
@Trick:
Well darned, digging out the Type isn't working for me
Code:
Get fNum, ofst + member, MethType ' <---- Always seems to return ZERO.
MethType = 2 ^ (MethType And &H3)' <---- Always evaluates to ONE, which makes sense if MethType starts out ZERO.
You've been so spot on with other stuff. Oh well, any ideas?
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
@trick:
Okay, I was putting together a small demo, and it's now working.
Sorry about that. I obviously did something wrong the first time.
Any ideas on how to differentiate Object Public Variables from all other Public Variables in these class modules? That would be sort of the last piece to all of this.
Thanks Again,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by The trick
You can retrieve this information from VBHeader structure. This code snippet allows to browse classes information within Standart-EXE application (just drop an EXE to window):
Code:
' //
' // VB-classes inforamtion by The trick
' //
Option Explicit
Private Type ClassData
strName As String
DispID As Long
MethOffst As Long
lpAddress As Long
End Type
Dim data() As ClassData
Dim dataCount As Long
Private Sub Form_Load()
End Sub
Private Sub lstClass_Click()
Dim index As Long
Dim last As Long
lstMethods.Clear
If lstClass.ListIndex = lstClass.ListCount - 1 Then
last = dataCount - 1
Else
last = lstClass.ItemData(lstClass.ListIndex + 1) - 1
End If
For index = lstClass.ItemData(lstClass.ListIndex) To last
If Len(data(index).strName) Then
lstMethods.AddItem data(index).strName
End If
'
' lstMethods.AddItem IIf(Len(data(index).strName), data(index).strName, "<no name>") ' & " " _
' & Hex(data(index).DispID) & " " _
' & Hex(data(index).lpAddress)
'
Next
End Sub
Private Sub lstClass_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim fle As Variant
For Each fle In data.Files
ParseFile fle
Exit For
Next
End Sub
Private Sub ParseFile(ByVal fileName As String)
Dim fNum As Integer
Dim elfaNew As Long
Dim entry As Long
Dim base As Long
Dim txtVA As Long
Dim txtRaw As Long
Dim ofst As Long
On Error GoTo ERRORHANDLER
lstClass.Clear
lstMethods.Clear
Erase data()
dataCount = 0
fNum = FreeFile
Open fileName For Binary As fNum
Get fNum, &H3C + 1, elfaNew ' e_lfanew
Get fNum, elfaNew + &H29, entry ' AddressOfEntryPoint
Get fNum, elfaNew + &H35, base ' ImageBase
Get fNum, elfaNew + &H105, txtVA ' .text VirtualAddress
Get fNum, elfaNew + &H10D, txtRaw ' .text PointerToRawData
ofst = txtRaw - txtVA - base + 1
Dim vbHdr As Long
Dim projInf As Long
Dim objTbl As Long
Dim total As Integer
Dim fType As Long
Dim desc As Long
Get fNum, ofst + entry + base + 1, vbHdr ' vbHeader
Get fNum, ofst + vbHdr + &H30, projInf ' lpProjectData
Get fNum, ofst + projInf + &H4, objTbl ' lpObjectTable
Get fNum, ofst + objTbl + &H2A, total ' wTotalObjects
Get fNum, ofst + objTbl + &H30, desc ' VbPublicObjectDescriptor
Do While total
total = total - 1
Get fNum, ofst + desc + total * &H30 + &H28, fType ' Module type
If CBool(fType And &H2) And Not CBool(fType And &HC0880) Then
' // Class
Dim methCount As Integer
Dim objInf As Long
Dim methAddr As Long
Dim ptrName As Long
Dim arrNames As Long
Dim cName As String
Dim privDesc As Long
Dim methArrTyp As Long
Dim member As Long
Dim idxMeth As Long
Dim methOffset As Integer
Get fNum, ofst + desc + total * &H30 + &H18, ptrName
cName = Strz(fNum, ofst + ptrName)
lstClass.AddItem cName
lstClass.ItemData(lstClass.NewIndex) = idxMeth
Get fNum, ofst + desc + total * &H30, objInf ' Obj info
Get fNum, ofst + desc + total * &H30 + &H20, arrNames
Get fNum, ofst + desc + total * &H30 + &H1C, methCount
Get fNum, ofst + objInf + &H68, methAddr ' lpMethods
Get fNum, ofst + objInf + &HC, privDesc ' VbPrivateObjectDescriptor
Get fNum, ofst + privDesc + &H18, methArrTyp
dataCount = dataCount + methCount
ReDim Preserve data(dataCount - 1)
Do While methCount
Get fNum, ofst + methArrTyp, member
If member Then
Get fNum, ofst + arrNames, ptrName
Get fNum, ofst + member + &H2, methOffset
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
Get fNum, ofst + member + &HC, data(idxMeth).DispID
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
methCount = methCount - 1
methArrTyp = methArrTyp + 4
arrNames = arrNames + 4
Loop
Do Until idxMeth > UBound(data)
Get fNum, ofst + methAddr, data(idxMeth).lpAddress
idxMeth = idxMeth + 1
methAddr = methAddr + 4
Loop
Dim propCount As Integer
Get fNum, ofst + privDesc + &H10, propCount
Get fNum, ofst + privDesc + &H20, arrNames
dataCount = dataCount + propCount
ReDim Preserve data(dataCount - 1)
Do While propCount
Get fNum, ofst + arrNames, member
If member Then
Get fNum, ofst + member + &H2, methOffset
Get fNum, ofst + member + &HC, data(idxMeth).DispID
Get fNum, ofst + member, ptrName
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
propCount = propCount - 1
arrNames = arrNames + 4
Loop
End If
Loop
Close fNum
Exit Sub
ERRORHANDLER:
MsgBox "Error"
End Sub
Private Function Strz(ByVal fNum As Integer, ByVal ofst As Long) As String
Dim b As Byte
Seek fNum, ofst
Get fNum, , b
Do While b
Strz = Strz & Chr$(b)
Get fNum, , b
Loop
End Function
It can contain bugs, i don't test it enough.
Dear Trick,
Can the above ClassInfo.zip project be extended to creating the class object and calling a method of the any of the browsed classes.
For example suppose we have dragged a standard exe application in which we have say Class1 with method memfunc1() can we extend the above ClassInfo.zip project to create Class1 object and call its method memfunc1. Please clarify with code.
Dear trick,
First let me thankyou for the reply.
I know that in initprojectcontextdll example you showed how to create and identify the multiuse class CInitContext of activex dll
using iclassfactory and iclassfactory:: createinstance using dispcallfunc api.
Here I wanted to know how to achieve the same for a normal standard exe class say class1 and call its method memfunc1 using dispcallfunc api.
Please show me how to extend Classinfo.zip project to achieve this after enumerating the class1 and its method memfunc1 in the dragged standard exe.
I have done the following code for creating class object of dragged standard exe and called the member function by modifying parsefile function in Classinfo project as follows:
Code:
Private Sub ParseFile(ByVal fileName As String)
Dim fNum As Integer
Dim elfaNew As Long
Dim entry As Long
Dim base As Long
Dim txtVA As Long
Dim txtRaw As Long
Dim ofst As Long
Dim pCOMData As Long
Dim lOfstRegInfo As Long
Dim pRegInfo As Long
Dim pfn As Long
Dim hLib As Long
Dim pClassName As Long
Dim iTypes(2) As Integer
Dim vParams(2) As Variant
Dim lList(2) As Long
Dim bIID(1) As Currency
Dim cFactory As IUnknown
Dim cObject As IUnknown
Dim hr As Long
Dim vRet As Variant
Dim ptr As Long
Dim hLibInstance As Long
Dim hLibvqi As Long
Dim HResult As Long, IID_IClassFactory As guid, U1 As Long, U2 As Long, dwStartAddress As Long
Dim qobj As Long
Dim ofac As Object
On Error GoTo ERRORHANDLER
lstClass.Clear
lstMethods.Clear
Erase data()
dataCount = 0
fNum = FreeFile
Open fileName For Binary As fNum
Get fNum, &H3C + 1, elfaNew ' e_lfanew
Get fNum, elfaNew + &H29, entry ' AddressOfEntryPoint
Get fNum, elfaNew + &H35, base ' ImageBase
Get fNum, elfaNew + &H105, txtVA ' .text VirtualAddress
Get fNum, elfaNew + &H10D, txtRaw ' .text PointerToRawData
ofst = txtRaw - txtVA - base + 1
Dim vbHdr As Long
Dim projInf As Long
Dim objTbl As Long
Dim total As Integer
Dim fType As Long
Dim desc As Long
Get fNum, ofst + entry + base + 1, vbHdr 'used this vbheader for initializing runtime of dragged exe as below 'initialize runtime of standard exe which is dragged on this application
CreateIExprSrvObj 0&, 4&, 0&
CoInitialize ByVal 0&
HResult = IIDFromString(StrPtr("{00000001-0000-0000-C000-000000000046}"), IID_IClassFactory)
'MsgBox "IID_IClassFactory"
If HResult < 0& Then
' Exit Function
End If
'MsgBox "123"
UserDllMain U1, U2, hLib, 1&, 0&
'MsgBox "UserDllMain"
'MsgBox "456"
If vbHdr Then
VBDllGetClassObject U1, U2, vbHdr, 0&, IID_IClassFactory, ofac '0&
End If
Get fNum, ofst + vbHdr + &H30, projInf ' lpProjectData
Get fNum, ofst + projInf + &H4, objTbl ' lpObjectTable
Get fNum, ofst + objTbl + &H2A, total ' wTotalObjects
Get fNum, ofst + objTbl + &H30, desc ' VbPublicObjectDescriptor
Do While total
total = total - 1
Get fNum, ofst + desc + total * &H30 + &H28, fType ' Module type
If CBool(fType And &H2) And Not CBool(fType And &HC0880) Then
' // Class
Dim methCount As Integer
Dim objInf As Long
Dim methAddr As Long
Dim ptrName As Long
Dim arrNames As Long
Dim cName As String
Dim privDesc As Long
Dim methArrTyp As Long
Dim member As Long
Dim idxMeth As Long
Dim methOffset As Integer
Dim x As IUnknown
Get fNum, ofst + desc + total * &H30 + &H18, ptrName
cName = Strz(fNum, ofst + ptrName)
MsgBox cName
lstClass.AddItem cName
Set x = CreateObjectPrivate(cName) 'code added
lstClass.ItemData(lstClass.NewIndex) = idxMeth
Get fNum, ofst + desc + total * &H30, objInf ' Obj info
Get fNum, ofst + desc + total * &H30 + &H20, arrNames
Get fNum, ofst + desc + total * &H30 + &H1C, methCount
Get fNum, ofst + objInf + &H68, methAddr ' lpMethods
Get fNum, ofst + objInf + &HC, privDesc ' VbPrivateObjectDescriptor
Get fNum, ofst + privDesc + &H18, methArrTyp
dataCount = dataCount + methCount
ReDim Preserve data(dataCount - 1)
Do While methCount
Get fNum, ofst + methArrTyp, member
If member Then
Get fNum, ofst + arrNames, ptrName
Get fNum, ofst + member + &H2, methOffset
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
Get fNum, ofst + member + &HC, data(idxMeth).DispID
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
methCount = methCount - 1
methArrTyp = methArrTyp + 4
arrNames = arrNames + 4
Loop
Do Until idxMeth > UBound(data)
Get fNum, ofst + methAddr, data(idxMeth).lpAddress
idxMeth = idxMeth + 1
methAddr = methAddr + 4
Loop
Dim propCount As Integer
Get fNum, ofst + privDesc + &H10, propCount
Get fNum, ofst + privDesc + &H20, arrNames
dataCount = dataCount + propCount
ReDim Preserve data(dataCount - 1)
Do While propCount
Get fNum, ofst + arrNames, member
If member Then
Get fNum, ofst + member + &H2, methOffset
Get fNum, ofst + member + &HC, data(idxMeth).DispID
Get fNum, ofst + member, ptrName
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
propCount = propCount - 1
arrNames = arrNames + 4
Loop
End If
Loop
Close fNum
Exit Sub
ERRORHANDLER:
MsgBox "Error" 'only this line is called when I drag a standard exe onto the running app
End Sub
Here CreateObjectPrivate function is called from mdObjectFactory.bas module added to the ClassInfo project for which code is as follows:
Code:
' mdObjectFactory.bas - Allows instantiation of private classes
'
' By Elroy from http://www.vbforums.com/showthread.php?834231-Instantiate-internal-class-object-with-name-in-string&p=5082493&viewfull=1#post5082493
'
'=========================================================================
'
' This must be a standard (BAS) module and it MUST be named "NameBasedObjectFactory" if things are to work correctly.
'
#Const ALSO_USERCONTROLS = False ' Not tested.
'
Private Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Foo1 As Long, ByVal Foo2 As Long, ByVal fCheckOnly As Long) As Long
'
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (ByVal s1 As String, ByVal s2 As Long) As Long
Private Declare Function ExeNew Lib "msvbvm60" Alias "__vbaNew" (lpObjectInfo As Any) As IUnknown
Private Declare Function AryPtr Lib "msvbvm60" Alias "VarPtr" (ary() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal lpAddress As Long, dst As Any)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal lpAddress As Long, ByVal nv As Long)
'
Private Type EXEPROJECTINFO
Signature As Long
RuntimeVersion As Integer
BaseLanguageDll(0 To 13) As Byte
ExtLanguageDll(0 To 13) As Byte
RuntimeRevision As Integer
BaseLangiageDllLCID As Long
ExtLanguageDllLCID As Long
lpSubMain As Long
lpProjectData As Long
' < There are other fields, but not declared, not needed. >
End Type
'
Private Type ProjectData
Version As Long
lpModuleDescriptorsTableHeader As Long
' < There are other fields, but not declared, not needed. >
End Type
'
Private Type MODDESCRTBL_HEADER
Reserved0 As Long
lpProjectObject As Long
lpProjectExtInfo As Long
Reserved1 As Long
Reserved2 As Long
lpProjectData As Long
guid(0 To 15) As Byte
Reserved3 As Integer
TotalModuleCount As Integer
CompiledModuleCount As Integer
UsedModuleCount As Integer
lpFirstDescriptor As Long
' < There are other fields, but not declared, not needed. >
End Type
'
Private Enum MODFLAGS
mfBasic = 1
mfNonStatic = 2
mfUserControl = &H42000
End Enum
'
Private Type MODDESCRTBL_ENTRY
lpObjectInfo As Long
FullBits As Long
Placeholder0(0 To 15) As Byte
lpszName As Long
MethodsCount As Long
lpMethodNamesArray As Long
Placeholder1 As Long
ModuleType As MODFLAGS
Placeholder2 As Long
End Type
'
Public Function CreateObjectPrivate(ByVal Class As String) As IUnknown
'
' When you work in the compiled form and the different mechanisms will be used by the IDE.
If InIDE Then
Set CreateObjectPrivate = IdeCreateInstance(Class)
Else
Set CreateObjectPrivate = ExeCreateInstance(Class)
End If
End Function
Private Function IdeCreateInstance(ByVal Class As String) As IUnknown
' Only for IDE.
'
' IMPORTANT: The module this is in MUST be named NameBasedObjectFactory.
'
EbExecuteLine StrPtr("NameBasedObjectFactory.OneCellQueue New " & Class), 0, 0, 0
'
Set IdeCreateInstance = OneCellQueue(Nothing)
If IdeCreateInstance Is Nothing Then
Err.Raise 8, , "Specified class '" + Class + "' is not defined"
Exit Function
End If
End Function
Private Function OneCellQueue(ByVal refIn As IUnknown) As IUnknown
' Returns what was "previously" passed in as refIn,
' and then stores the current refIn for return next time.
'
Static o As IUnknown
'
Set OneCellQueue = o
Set o = refIn
End Function
Private Function ExeCreateInstance(ByVal Class As String) As IUnknown
' Only for Executable.
'
Dim lpObjectInformation As Long
'
' Get the address of a block of information about the class.
' And then create an instance of this class.
' If a class is not found, generated an error.
'
If Not GetOiOfClass(Class, lpObjectInformation) Then
Err.Raise 8, , "Specified class '" + Class + "' is not defined"
Exit Function
End If
'
Set ExeCreateInstance = ExeNew(ByVal lpObjectInformation)
End Function
Private Function GetOiOfClass(ByVal Class As String, ByRef lpObjInfo As Long) As Boolean
' Only for Executable.
'
' lpObjInfo is a returned argument.
' Function returns true if successful.
'
Static Modules() As NameBasedObjectFactory.MODDESCRTBL_ENTRY
Static bModulesSet As Boolean
Dim i As Long
'
#If ALSO_USERCONTROLS Then
Const mfBadFlags As Long = mfUserControl
#Else
Const mfBadFlags As Long = 0
#End If
'
If Not bModulesSet Then
ReDim Modules(0)
If LoadDescriptorsTable(Modules) Then
bModulesSet = True
Else
Exit Function
End If
End If
'
' We are looking for a descriptor corresponding to the specified class.
For i = LBound(Modules) To UBound(Modules)
With Modules(i)
If lstrcmpi(Class, .lpszName) = 0 And CBool(.ModuleType And mfNonStatic) And Not CBool(.ModuleType And mfBadFlags) Then
lpObjInfo = .lpObjectInfo
GetOiOfClass = True
Exit Function
End If
End With
Next i
End Function
Private Function LoadDescriptorsTable(dt() As MODDESCRTBL_ENTRY) As Boolean
' Only for Executable.
'
Dim lpEPI As Long
Dim EPI(0) As NameBasedObjectFactory.EXEPROJECTINFO
Dim ProjectData(0) As NameBasedObjectFactory.ProjectData
Dim ModDescrTblHdr(0) As NameBasedObjectFactory.MODDESCRTBL_HEADER
'
' This procedure is called only once for the project.
' Get the address of the EPI.
'
If Not FindEpiSimple(lpEPI) Then
Err.Raise 17, , "Failed to locate EXEPROJECTINFO structure in process module image"
Exit Function
End If
'
' From EPI find location PROJECTDATA, from PROJECTDATA obtain location
' of Table header tags, the title tags, and obtain the number of address sequence.
'
SaMap AryPtr(EPI), lpEPI
SaMap AryPtr(ProjectData), EPI(0).lpProjectData: SaUnmap AryPtr(EPI)
SaMap AryPtr(ModDescrTblHdr), ProjectData(0).lpModuleDescriptorsTableHeader: SaUnmap AryPtr(ProjectData)
SaMap AryPtr(dt), ModDescrTblHdr(0).lpFirstDescriptor, ModDescrTblHdr(0).TotalModuleCount: SaUnmap AryPtr(ModDescrTblHdr)
'
LoadDescriptorsTable = True
End Function
Private Function FindEpiSimple(ByRef lpEPI As Long) As Boolean
' Only for Executable.
'
Dim DWords() As Long: ReDim DWords(0)
Dim PotentionalEPI(0) As NameBasedObjectFactory.EXEPROJECTINFO
Dim PotentionalPD(0) As NameBasedObjectFactory.ProjectData
Dim i As Long
'
Const EPI_Signature As Long = &H21354256 ' "VB5/6!"
Const PD_Version As Long = &H1F4
'
' We are trying to get a pointer to a structure EXEPROJECTINFO. The address is not stored anywhere.
' Therefore the only way to find the structure - find its signature.
'
' Current research implementation simply disgusting: it is looking for signatures from the
' very beginning of the image, including those places where it can not be known. And find out
' Behind the border of the image, if you find a signature within the virtual image failed.
' This will likely result in AV-exclusion. But its (implementation) is compact.
'
SaMap AryPtr(DWords), App.hInstance
Do
If DWords(i) = EPI_Signature Then
SaMap AryPtr(PotentionalEPI), VarPtr(DWords(i))
SaMap AryPtr(PotentionalPD), PotentionalEPI(0).lpProjectData
If PotentionalPD(0).Version = PD_Version Then
lpEPI = VarPtr(DWords(i))
FindEpiSimple = True
End If
SaUnmap AryPtr(PotentionalPD)
SaUnmap AryPtr(PotentionalEPI)
If FindEpiSimple Then Exit Do
End If
i = i + 1
Loop
SaUnmap AryPtr(DWords)
End Function
Private Sub SaMap(ByVal ppSA As Long, ByVal pMemory As Long, Optional ByVal NewSize As Long = -1)
Dim pSA As Long: GetMem4 ppSA, pSA:
PutMem4 pSA + 12, ByVal pMemory: PutMem4 pSA + 16, ByVal NewSize
End Sub
Private Sub SaUnmap(ByVal ppSA As Long)
Dim pSA As Long: GetMem4 ppSA, pSA
PutMem4 pSA + 12, ByVal 0: PutMem4 pSA + 16, ByVal 0
End Sub
Private Function InIDE() As Boolean
Debug.Assert pvSetTrue(InIDE)
End Function
Private Function pvSetTrue(bValue As Boolean) As Boolean
bValue = True
pvSetTrue = True
End Function
But when I run the Classinfo project I get error msg box when I drag an exe on the running ClassInfo application .
Please clarify.
regards,
JSVenu
Last edited by jsvenu; Nov 21st, 2019 at 10:42 PM.
Reason: Suggestion from Elroy
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
jsvenu,
PLEASE, edit your above post and surround your code with the [CODE] and [/CODE] tags. For the above, it's probably easiest to type them in. But, when creating a post (or select the code), you can use the button with the number sign (aka hash or pound sign) to accomplish the same thing. Just as a further FYI, when typing these tags in here in VBForums, they're not case sensitive.
Just as another FYI, you can still use the bold and other formatting options even when you're inside of a code-block. And also, using a code-block preserves your indentation.
Thank You In Advance,
Elroy
---------------------------------
EDIT: Yes, thank you jsvenu. It looks much better now.
Last edited by Elroy; Nov 23rd, 2019 at 09:36 AM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Dear Trick,
I understand that I get error messagebox due to the fact that the dragged standard exe (containing atleast a class with atleast one member function so that we can create the class object and call the member function) is opened in a binary file and the class for which we want to create object and call its function is not in Classinfo application address space.So I tried using LoadLibrary to load the dragged standard exe to ClassInfo application address space as follows and got new vbHdr address which I used instead of vbHdr which we get from parsing the file by opening it in binary mode.
Code:
hLib = LoadLibrary(StrPtr(sLibName))
If hLib = 0 Then Exit Function
pVBHdr = SearchVBHeader(hLib)
Private Function SearchVBHeader(ByVal hLibIns As Long) As Long
Dim mbi As MEMORY_BASIC_INFORMATION, lpCodeSection As Long, bBuffer() As Byte, i As Long
VirtualQuery ByVal hLibIns, mbi, LenB(mbi)
lpCodeSection = mbi.BaseAddress + mbi.RegionSize
VirtualQuery ByVal lpCodeSection, mbi, LenB(mbi)
ReDim bBuffer(mbi.RegionSize - 1&)
RtlMoveMemory bBuffer(0), ByVal mbi.BaseAddress, mbi.RegionSize
SearchVBHeader = InStrB(bBuffer, StrConv("VB5!", vbFromUnicode))
If SearchVBHeader Then
SearchVBHeader = SearchVBHeader + mbi.BaseAddress - 1&
End If
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Dear Trick,
I observed that ClassInfo project was coming out to ERRORHANDLER: and displaying error messagebox when I use the following code at the line where LoadLibrary is called:
Code:
hLib = LoadLibrary(StrPtr(exeName)) '
If hLib = 0 Then Exit Function
pVBHdr = SearchVBHeader(hLib)
This is happening when I drag a standard exe(path given as input as exeName in the above code) which contains Class1 with a public sub abc() added onto the CLassInfo application.
Please clarify.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by The trick
You can retrieve this information from VBHeader structure. This code snippet allows to browse classes information within Standart-EXE application (just drop an EXE to window):
Code:
' //
' // VB-classes inforamtion by The trick
' //
Option Explicit
Private Type ClassData
strName As String
DispID As Long
MethOffst As Long
lpAddress As Long
End Type
Dim data() As ClassData
Dim dataCount As Long
Private Sub Form_Load()
End Sub
Private Sub lstClass_Click()
Dim index As Long
Dim last As Long
lstMethods.Clear
If lstClass.ListIndex = lstClass.ListCount - 1 Then
last = dataCount - 1
Else
last = lstClass.ItemData(lstClass.ListIndex + 1) - 1
End If
For index = lstClass.ItemData(lstClass.ListIndex) To last
If Len(data(index).strName) Then
lstMethods.AddItem data(index).strName
End If
'
' lstMethods.AddItem IIf(Len(data(index).strName), data(index).strName, "<no name>") ' & " " _
' & Hex(data(index).DispID) & " " _
' & Hex(data(index).lpAddress)
'
Next
End Sub
Private Sub lstClass_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim fle As Variant
For Each fle In data.Files
ParseFile fle
Exit For
Next
End Sub
Private Sub ParseFile(ByVal fileName As String)
Dim fNum As Integer
Dim elfaNew As Long
Dim entry As Long
Dim base As Long
Dim txtVA As Long
Dim txtRaw As Long
Dim ofst As Long
On Error GoTo ERRORHANDLER
lstClass.Clear
lstMethods.Clear
Erase data()
dataCount = 0
fNum = FreeFile
Open fileName For Binary As fNum
Get fNum, &H3C + 1, elfaNew ' e_lfanew
Get fNum, elfaNew + &H29, entry ' AddressOfEntryPoint
Get fNum, elfaNew + &H35, base ' ImageBase
Get fNum, elfaNew + &H105, txtVA ' .text VirtualAddress
Get fNum, elfaNew + &H10D, txtRaw ' .text PointerToRawData
ofst = txtRaw - txtVA - base + 1
Dim vbHdr As Long
Dim projInf As Long
Dim objTbl As Long
Dim total As Integer
Dim fType As Long
Dim desc As Long
Get fNum, ofst + entry + base + 1, vbHdr ' vbHeader
Get fNum, ofst + vbHdr + &H30, projInf ' lpProjectData
Get fNum, ofst + projInf + &H4, objTbl ' lpObjectTable
Get fNum, ofst + objTbl + &H2A, total ' wTotalObjects
Get fNum, ofst + objTbl + &H30, desc ' VbPublicObjectDescriptor
Do While total
total = total - 1
Get fNum, ofst + desc + total * &H30 + &H28, fType ' Module type
If CBool(fType And &H2) And Not CBool(fType And &HC0880) Then
' // Class
Dim methCount As Integer
Dim objInf As Long
Dim methAddr As Long
Dim ptrName As Long
Dim arrNames As Long
Dim cName As String
Dim privDesc As Long
Dim methArrTyp As Long
Dim member As Long
Dim idxMeth As Long
Dim methOffset As Integer
Get fNum, ofst + desc + total * &H30 + &H18, ptrName
cName = Strz(fNum, ofst + ptrName)
lstClass.AddItem cName
lstClass.ItemData(lstClass.NewIndex) = idxMeth
Get fNum, ofst + desc + total * &H30, objInf ' Obj info
Get fNum, ofst + desc + total * &H30 + &H20, arrNames
Get fNum, ofst + desc + total * &H30 + &H1C, methCount
Get fNum, ofst + objInf + &H68, methAddr ' lpMethods
Get fNum, ofst + objInf + &HC, privDesc ' VbPrivateObjectDescriptor
Get fNum, ofst + privDesc + &H18, methArrTyp
dataCount = dataCount + methCount
ReDim Preserve data(dataCount - 1)
Do While methCount
Get fNum, ofst + methArrTyp, member
If member Then
Get fNum, ofst + arrNames, ptrName
Get fNum, ofst + member + &H2, methOffset
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
Get fNum, ofst + member + &HC, data(idxMeth).DispID
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
methCount = methCount - 1
methArrTyp = methArrTyp + 4
arrNames = arrNames + 4
Loop
Do Until idxMeth > UBound(data)
Get fNum, ofst + methAddr, data(idxMeth).lpAddress
idxMeth = idxMeth + 1
methAddr = methAddr + 4
Loop
Dim propCount As Integer
Get fNum, ofst + privDesc + &H10, propCount
Get fNum, ofst + privDesc + &H20, arrNames
dataCount = dataCount + propCount
ReDim Preserve data(dataCount - 1)
Do While propCount
Get fNum, ofst + arrNames, member
If member Then
Get fNum, ofst + member + &H2, methOffset
Get fNum, ofst + member + &HC, data(idxMeth).DispID
Get fNum, ofst + member, ptrName
methOffset = methOffset And &HFFFFFFFE
Get fNum, ofst + methAddr + methOffset - &H1C, data(idxMeth).lpAddress
cName = Strz(fNum, ofst + ptrName)
data(idxMeth).strName = cName
idxMeth = idxMeth + 1
End If
propCount = propCount - 1
arrNames = arrNames + 4
Loop
End If
Loop
Close fNum
Exit Sub
ERRORHANDLER:
MsgBox "Error"
End Sub
Private Function Strz(ByVal fNum As Integer, ByVal ofst As Long) As String
Dim b As Byte
Seek fNum, ofst
Get fNum, , b
Do While b
Strz = Strz & Chr$(b)
Get fNum, , b
Loop
End Function
It can contain bugs, i don't test it enough.
Dear Trick,
I understand that you are using namebasedobjectfactory module for creating a private class object
of a standard exe in a new thread which you showed in multithreading example in code bank.
You were using vbheader of standard exe to check whether the object is there or not in current standard exe project and then creating private object using createprivateclass function.
You already showed how to initialize project context of activex dll using initprojectcontextdll example thru iclassfactory and iclassfactory createinstance using dispcallapi and loadlibrary.Here we are seeing that dllusage standard exe application loads testdll.dll act dl into its address space and we are able to get vbheader of testdll.dll act dll thru dllgetclassobject function address.
I want to achieve the same by loading a standard exe instead of act dll into dllusage standard exe application address space using loadlibrary and I was using vbdllgetclassobject for initializing project context of loaded standard exe to which I am passing its vbhdr . I am able to enumerate all the classes of this loaded dll thru its vbhdr as shown by you in classinfo project.But I am unable to create private object of any of the enumerated classes of loaded exe in the dllusage exe application since I am unable to get the address of these enumerated classes in main dllusage standard exe address space.
Can you please help me how to get the address of any of the enumerated classes of loaded standard exe in dllusage standard exe application so that I can create private object and call it member function,
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Dear Trick,
I was finally able to createprivateobject of standard exe in another exe using loadlibrary api and Namebasedobjectfactory module .
But for calling a method of the object I used CallByName which worked perfect.
But when I use DispCallfunc api in place of CallByName it fails.
When we call a method of an object using DispCallFunc I see that we take first parameter as ObjPtr of the class object and second parameter as offset.Last parameter as retval(variant) and in between parameters for passing data.
Please explain does CallByName use Dispcallfunc api internally or both use different ways.
I know that Dispcallfunc api can be used for calling standard module functions also apart from class object methods.
Is there any restriction for Dispcallfunc api like the class for which we are creating object and calling its method should be in the same project.
How can we implement CallByName using DispCallFunc.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by wqweto
Please share your progress and I'll show you how to use Dispcallfunc instead of CallByName.
cheers,
</wqw>
Dear wqw,
We are loading a standard exe say exe1 into address space of another another standard exe say exe2 using LoadLibrary.
Now exe2 is the main application in which we loaded exe1.
So now I am using vbHdr of exe1 to browse thru exe1 classes and their methods using Classinfo project by Trick
Having got the class and its methods information I creating object of the class using NameBasedObjectfactory module by Elroy
Now I am calling the method using CallByName and it works perfect.
But this fails even when I use only one method in say method1() of say Class1 of exe1 project.
Code:
CallByName pClass1Obj,"method1",vbMethod 'works fine
DispCallFunc ObjPtr(pClass1Obj) , 7*4 ,CC_STDCALL,0&,0&,0&,0&,valRet 'fails
Here valRet is the variant. Here method1 is the only method present in exe1 standard exe project in Class1 class module.
There we are using 7*4 as the offset second parameter of DispCallApi.
Code:
'Class1 class module:
Sub Method1()
MsgBox "in method1"
End Sub
regards,
JSVenu
Last edited by jsvenu; Nov 29th, 2019 at 11:05 AM.
Reason: typo corrected to 8 params as suggested by Lavolpe
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Can you post your DispCallFunc declaration?
Are there any public variables in the class declaration section?
Method1 is the 1st public method in that class?
Insomnia is just a byproduct of, "It can't be done"
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by LaVolpe
Can you post your DispCallFunc declaration?
Are there any public variables in the class declaration section?
Method1 is the 1st public method in that class?
Dear Lavolpe,
Code:
'DispCallFunc declaration
Public Declare Function DispCallFunc Lib "oleaut32.dll" ( _
ByRef pvInstance As Any, _
ByVal oVft As Long, _
ByVal cc As Long, _
ByVal vtReturn As VbVarType, _
ByVal cActuals As Long, _
ByRef prgvt As Any, _
ByRef prgpvarg As Any, _
ByRef pvargResult As Variant) As Long
There are no variables in the class declaration section?
Method1 is the 1st public method in that class and it is the only method.
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Originally Posted by jsvenu
Dear Lavolpe,
Thankyou very much for the reply.
Since I am outside now I will try tomorrow and let you know the status.
regards,
JSVenu
Dear Lavolpe,
Thankyou very much. ByVal before the first parameter ObjPtr(pClass1Obj) worked perfect.
Can you give me simple code of how to pass one or more parameters for any class function as input say for calculation like addition and returning the value using the above Dispcallfunc api declararation which I used from Trick's multithreading module.
regards.
JSVenu
Last edited by jsvenu; Nov 30th, 2019 at 04:03 AM.
[RESOLVED] Digging into COM from Class1 inside a standard VB6 EXE project.
Reply With Quote
I'll edit post #1. 
Originally Posted by Elroy
I'll be looking at it later today.
