-
[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?
-
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.
Your CallByName example is one of the ways to use late binding. That makes use of IDispatch.
Maybe Using early binding and late binding in Automation would be helpful?
-
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.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
I'm used to it. "Casting pearls" and all that. ;)
-
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
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Pffff, haha, geez, fragile egos. :p I'll edit post #1. :p
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Not important, the only thing that counts here are the "rep" score doodads and they don't count for much.
-
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. :p
-
1 Attachment(s)
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
It can contain bugs, i don't test it enough.
-
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
this might be helpful
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
Elroy
And therefore, if we're able to use late-binding on our Class1 within our project, where's the TypeLib?
Elroy
In order to use late binding you don't need a TypeLib, you just call GetIDsOfNames and Invoke methods.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
DEXWERX
@Elroy As a starting point, this is the function i posted
here that walks just the names of an IDispatch's members.
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.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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.
cheers,
</wqw>
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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. :)
-
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
-
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.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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?
Regards,
Elroy
p.s. Everything else is working absolutely fine.
Please, send me EXE that causes problem.
-
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
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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.
regards,
JSVenu
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
The trick
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.
regards,
JSVenu
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
The trick
Dear Trick,
Thank you for the reply.
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
-
1 Attachment(s)
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.
Attachment 172455
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. :)
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Dear Elroy,
Thankyou for the suggestion and I improved indentation as per your suggestion.
regards,
JSVenu
-
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
But still I am getting error.Please clarify.
regards,
JSVenu
-
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.
regards,
JSVenu
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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,
regards,
JSVenu
-
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.
Please clarify.
regards,
JSVenu
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
jsvenu
Please clarify.
Please share your progress and I'll show you how to use Dispcallfunc instead of CallByName.
cheers,
</wqw>
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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
-
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?
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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.
regards,
JSVenu
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
8 params in the API, but you are only passing 7 in this call:
Code:
DispCallFunc ObjPtr(pClass1Obj) , 7*4 ,CC_STDCALL,0&,0&,0&,valRet
I'm going to assume you are passing 8 and above is a typo on your part.
Try this.
Code:
DispCallFunc ByVal ObjPtr(pClass1Obj), 7*4 , CC_STDCALL, 0&, 0&, ByVal 0&, ByVal 0&, valRet
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
LaVolpe
8 params in the API, but you are only passing 7 in this call:
Code:
DispCallFunc ObjPtr(pClass1Obj) , 7*4 ,CC_STDCALL,0&,0&,0&,valRet
I'm going to assume you are passing 8 and above is a typo on your part.
Try this.
Code:
DispCallFunc ByVal ObjPtr(pClass1Obj), 7*4 , CC_STDCALL, 0&, 0&, ByVal 0&, ByVal 0&, valRet
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
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
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
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
You can use a helper wrapper function like this DispCallByVtbl which is based on Olaf snippet here in these forums.
You still have to heed actual ByVal/ByRef or method params and pass ObjPtr(oParam) if the method is declared w/ ByVal oParam As Object parameter or VarPtr(oParam) if the method expects ByRef oParam As Object.
cheers,
</wqw>
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
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
I wrote a wrapper awhile back. You can look at it
http://www.vbforums.com/showthread.p...all-DLL-Calls)
For COM calls, important to pass the correct vartype
1. Strings: Pass StrPtr
2. Objects: Pass VarPtr(Object) when official documentation is a far pointer **pUnk
3. Objects: Pass ObjPtr(Object) when official documentation is ByRef near pointer *pObject
4. Numeric variables. Pass correct vartype, using & ! # @ suffix or conversion functions CLng(), etc
5. Numeric variables ByRef: Pass VarPtr(variable)
6. Arrays: Pass VarPtr(array(lbound))
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Dear wqew and Lavolpe,
Thankyou very much for the replies.
regards,
JSVenu
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
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
Quote:
Originally Posted by
Elroy
@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
Dear Elroy and JSVenu:
Can anyone of you show me the demo, how can we create a class instance from a vb6 standard exe in IDE as well as EXE
Shall we use CallByName or DispCallFunc or CreateObjectPrivate from firehacker?
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
loquat,
You want to instantiate a class that resides an another standard EXE, and it's not the one you're working on?
That would be rather difficult, as the machine-code (once compiled) is re-entrant. There's more to it than this, but basically (briefly), when we instantiate an object from a class, all we're doing is creating space for the class's module-level variables (and setting up its VTable). The actual machine-code isn't copied.
So, how are we going to reach from one program into another (possibly non-running) program, and execute code within it? If it were an ActiveX object, I could see how. We can even load and call functions from a standard DLL. But another standard executable? I don't think so.
Good Luck,
Elroy
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
JFYI, here is DispInvoke function implemented as a CallByName replacement that uses DispCallFunc to directly call IDispatch::Invoke
thinBasic Code:
Option Explicit
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
Private Declare Function VariantCopy Lib "oleaut32" (pvarDest As Any, pvargSrc As Any) As Long
Private Sub Command1_Click()
Dim lResult As Long
Debug.Print "DispInvoke=" & DispInvoke(Command1, "Name", VbGet Or VbMethod)
Debug.Print "IsError=" & IsError(DispInvoke(Command1, "Index", VbGet Or VbMethod))
Debug.Print "IsEmpty=" & IsEmpty(DispInvoke(Command1, "Move", VbMethod, 1000, 0, 1000, 2000))
Debug.Print "IsEmpty=" & IsEmpty(DispInvoke(Command1, "Left", VbLet, 500))
Debug.Print "DispInvoke=" & DispInvoke(Me, "Test", VbMethod, lResult), "lResult=" & lResult
End Sub
Public Function Test(lResult As Long) As Boolean
lResult = 42
Test = True
End Function
Public Function DispInvoke( _
ByVal pDisp As Object, _
ProcName As Variant, _
ByVal CallType As VbCallType, _
ParamArray Args() As Variant) As Variant
Const DISP_E_MEMBERNOTFOUND As Long = &H80020003
Const DISP_E_PARAMNOTOPTIONAL As Long = &H8002000F
Const DISPID_PROPERTYPUT As Long = -3
Const IDX_GetIDsOfNames As Long = 5
Const IDX_Invoke As Long = 6
Dim IID_NULL(0 To 3) As Long
Dim lDispID As Long
Dim vRevArgs As Variant
Dim lIdx As Long
Dim aParams(0 To 3) As Long
Dim lPropPutDispID As Long
Dim lResultPtr As Long
Dim hResult As Long
If pDisp Is Nothing Then
hResult = DISP_E_PARAMNOTOPTIONAL
GoTo QH
End If
'--- figure out procedure DispID
If IsNumeric(ProcName) Then
lDispID = ProcName
Else
hResult = DispCallByVtbl(ObjPtr(pDisp), IDX_GetIDsOfNames, VarPtr(IID_NULL(0)), VarPtr(StrPtr(ProcName)), 1&, 0&, VarPtr(lDispID))
If hResult < 0 Then
GoTo QH
End If
End If
'--- reverse arguments
If UBound(Args) >= 0 Then
ReDim vRevArgs(0 To UBound(Args) - LBound(Args)) As Variant
For lIdx = 0 To UBound(vRevArgs)
'--- have to keep VT_BYREF so cannot use simple assignment here
Call VariantCopy(vRevArgs(lIdx), Args(UBound(Args) - lIdx))
Next
aParams(0) = VarPtr(vRevArgs(0)) ' .rgPointerToVariantArray
aParams(2) = UBound(vRevArgs) + 1 ' .cArgs
End If
If (CallType And (VbLet Or VbSet)) <> 0 Then
lPropPutDispID = DISPID_PROPERTYPUT
aParams(1) = VarPtr(lPropPutDispID) ' .rgPointerToLongNamedArgs
aParams(3) = 1 ' .cNamedArgs
End If
If (CallType And (VbGet Or VbMethod)) <> 0 Then
lResultPtr = VarPtr(DispInvoke)
End If
hResult = DispCallByVtbl(ObjPtr(pDisp), IDX_Invoke, lDispID, VarPtr(IID_NULL(0)), 0&, CallType, VarPtr(aParams(0)), lResultPtr, 0&, 0&)
'--- take care of subs (some do not accept result pointer)
If hResult = DISP_E_MEMBERNOTFOUND And (CallType And VbMethod) <> 0 Then
hResult = DispCallByVtbl(ObjPtr(pDisp), IDX_Invoke, lDispID, VarPtr(IID_NULL(0)), 0&, CallType, VarPtr(aParams(0)), 0&, 0&, 0&)
End If
QH:
If hResult < 0 Then
IID_NULL(0) = vbError
IID_NULL(2) = hResult
Call VariantCopy(DispInvoke, IID_NULL(0))
End If
End Function
Private Function DispCallByVtbl(ByVal pUnk As Long, ByVal lIndex As Long, ParamArray Args() As Variant) As Variant
Const CC_STDCALL As Long = 4
Dim vParams As Variant
Dim lIdx As Long
Dim vType(0 To 63) As Integer
Dim vPtr(0 To 63) As Long
Dim hResult As Long
vParams = Args
For lIdx = 0 To UBound(vParams)
vType(lIdx) = VarType(vParams(lIdx))
vPtr(lIdx) = VarPtr(vParams(lIdx))
Next
hResult = DispCallFunc(pUnk, lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
If hResult < 0 Then
Err.Raise hResult, "DispCallFunc"
End If
End Function
Notice that DispInvoke never raises an error but return CVErr created variant of vbError sub-type. Test for failure with IsError(vResult) and if vbError can extract the HRESULT with CLng(vResult) while casting vResult to string produces "Error Xxx" as text. Notice how IsError(DispInvoke(Command1, "Index", VbGet Or VbMethod)) can be used to test if the command button control is part of a control array with no error being raised, so this check works in "Break on All Errors" mode too. Notice how all ByRef output params are correctly populated when the call returns too. Notice how instead of a procedure *name* one can pass a DispID like -4 (DISPID_NEWENUM) to get the enumerator without knowing the method name it was implemented under.
All this goodness in less than 100 LOC :-))
Enjoy!
</wqw>
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
loquat
Can anyone of you show me the demo, how can we create a class instance from a vb6 standard exe in IDE as well as EXE
Shall we use CallByName or DispCallFunc or CreateObjectPrivate from firehacker?
Quote:
Originally Posted by
jsvenu
We are loading a standard exe say exe1 into address space of another another standard exe say exe2 using LoadLibrary.
Dear geniuses of the forum:
I strongly encourage not to answer these kind of questions without before asking for a full explanation of the project where these techniques will be used.
If the people use VB6 for hacking and making malware, they not only damage random people (steal credit card numbers or other private information, create ransomware or who knows what) but they also may damage us, because antiviruses companies might become more and more restrictive about VB6 programs, and the false positives may grow because of these programs.
May be these persons have legitimate reasons, good intentions with their programs, but when asking suspicious things like these, I suggest to first request a full (and believable) explanation of their projects.
Why someone would need to inject code into another running exe?
May be... yes, but it seems safer to assume that they are probably making malware.
If we don't take care of "our" programming language, who will?
I know these challenges may seem interesting, but please be careful.
Thank you.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
Eduardo-
Dear geniuses of the forum:
I strongly encourage not to answer these kind of questions without before asking for a full explanation of the project where these techniques will be used.
If the people use VB6 for hacking and making malware, they not only damage random people (steal credit card numbers or other private information, create ransomware or who knows what) but they also may damage us, because antiviruses companies might become more and more restrictive about VB6 programs, and the false positives may grow because of these programs.
May be these persons have legitimate reasons, good intentions with their programs, but when asking suspicious things like these, I suggest to first request a full (and believable) explanation of their projects.
Why someone would need to inject code into another running exe?
May be... yes, but it seems safer to assume that they are probably making malware.
If we don't take care of "our" programming language, who will?
I know these challenges may seem interesting, but please be careful.
Thank you.
Dear Eduardo-:
I have no attension to inject any code to other dlls or exes, i have never do that ever, because my Basic knowledge do not allow me to
I m a beginner of VB6, what I use much more is office vba
I have learn many many skills from this forum, some of them have been used in some of my codes
and I m interested in this topic, just because of curious, I can not think of any usage of this kind of skills.
thanks for your concern
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
Elroy
loquat,
You want to instantiate a class that resides an another standard EXE, and it's not the one you're working on?
That would be rather difficult, as the machine-code (once compiled) is re-entrant. There's more to it than this, but basically (briefly), when we instantiate an object from a class, all we're doing is creating space for the class's module-level variables (and setting up its VTable). The actual machine-code isn't copied.
So, how are we going to reach from one program into another (possibly non-running) program, and execute code within it? If it were an ActiveX object, I could see how. We can even load and call functions from a standard DLL. But another standard executable? I don't think so.
Good Luck,
Elroy
I m a little confused, so what you have discussed is to create instance of a private class from a dragdroped exe into this process?
but not create directly from an exe file, am i right?
If that is so, i m curious too, how can we make it.
becuase i have read each and evert posts of this thread and the related threads, and have tried to make a demo
but nothing complete after long time of testing, i will give a demo later, thanks for your explaination.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
loquat
but not create directly from an exe file, am i right?
If you only have the filename of the .exe the first step would be to start it. When this .exe starts it has to register a class factory somewhere -- this is a *running* object with the single purpose of creating new instances of all the classes that are implemented in the .exe and it is these new instances that are called out-of-proc COM servers in the literature about COM.
The easiest way to register a class factory from a Std-EXE is to use file moniker with PutObject function as implemeted in this thread. The class factory needs to have a single method -- CreateInstance(ProgID As String) As Object with a big Select Case on the name of the class that's requested to be instantiated.
A client first calls the built-in GetObject("MyServer.ClassFactory") and then Set oObj = oFactory.CreateInstance("MyClass") to create instances of out-of-process COM servers that run in the Std-EXE process space.
What is my point? In this scenario you control both the .exe and the clients. The .exe has to be instrumented to register a class factory. It is not possible to take outlook.exe and to bolt a class factory registration code onto it unless Microsoft has already done that. If the .exe is produced by 3-rd party there is little you can do to instantiate instances of its private classes if the original author has not provided a class factory or another instantiation mechanism -- this is next to impossible and would be considered in the sphere of blackhat hacking.
cheers,
</wqw>
-
1 Attachment(s)
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
share1 class1,form1 ,use createobject("project1.form1") to read,call method
Attachment 174689
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Hi xiaoyao, have you tried embedding Chrome windows into a VB Form?
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
dreammanor
Hi xiaoyao, have you tried embedding Chrome windows into a VB Form?
Of course, the form is embedded in the Google Chrome kernel, I have done it many times, but this technology is still relatively complicated, and it is best if you can pay part of the cost. Can operate web pages, click on forms, enter content or read web data, web pictures. I most want to write some code to enable f12's debugging tools, open the webpage, and then grab network packets. In this way, I can also perform cookies, and also some web forms to send data to intercept.
This main purpose is that there are many webpages that do not support Internet Explorer login or display abnormally, so you can only directly open the controls of Google Chrome or Google Chrome kernel. Then take out the cookies on the webpage, and then you can write a program for post multithreading.
One of my previous use cases, opened my own Taobao shop. Collect the order data I sold.
Please ignore the following Chinese:
当然啦，窗体嵌入谷歌浏览器内核，我做过很多次了，只不过这个技术还是比较复杂的，如果可以付一部分费用就最好了。可以操作网页，表单点击，输入内容或者读取网页数据，网页图片。我最希望写一些代码开启f12的调 试工具，打开网页，然后抓取网络数据包。这样我也可以进行cookie，还有一些网页表单发送数据的拦截。
这个主要用途就是有很多网页他不支持ie浏览器登陆或者显示不正常，所以只能直接打开谷歌浏览器或者谷歌浏览器内核的控件。再取出网页上的cookie，然后就可以写程序进行post多线程处理了。
我以前的使用案例之一，打开我自己的淘宝网店。采集我卖出去的订单数据。
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
wqweto
JFYI, here is
DispInvoke function implemented as a
CallByName replacement that uses
DispCallFunc to directly call
IDispatch::Invoke
thinBasic Code:
Option Explicit
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
Private Declare Function VariantCopy Lib "oleaut32" (pvarDest As Any, pvargSrc As Any) As Long
Private Sub Command1_Click()
Dim lResult As Long
Debug.Print "DispInvoke=" & DispInvoke(Command1, "Name", VbGet Or VbMethod)
Debug.Print "IsError=" & IsError(DispInvoke(Command1, "Index", VbGet Or VbMethod))
Debug.Print "IsEmpty=" & IsEmpty(DispInvoke(Command1, "Move", VbMethod, 1000, 0, 1000, 2000))
Debug.Print "IsEmpty=" & IsEmpty(DispInvoke(Command1, "Left", VbLet, 500))
Debug.Print "DispInvoke=" & DispInvoke(Me, "Test", VbMethod, lResult), "lResult=" & lResult
End Sub
Public Function Test(lResult As Long) As Boolean
lResult = 42
Test = True
End Function
Public Function DispInvoke( _
ByVal pDisp As Object, _
ProcName As Variant, _
ByVal CallType As VbCallType, _
ParamArray Args() As Variant) As Variant
Const DISP_E_MEMBERNOTFOUND As Long = &H80020003
Const DISP_E_PARAMNOTOPTIONAL As Long = &H8002000F
Const DISPID_PROPERTYPUT As Long = -3
Const IDX_GetIDsOfNames As Long = 5
Const IDX_Invoke As Long = 6
Dim IID_NULL(0 To 3) As Long
Dim lDispID As Long
Dim vRevArgs As Variant
Dim lIdx As Long
Dim aParams(0 To 3) As Long
Dim lPropPutDispID As Long
Dim lResultPtr As Long
Dim hResult As Long
If pDisp Is Nothing Then
hResult = DISP_E_PARAMNOTOPTIONAL
GoTo QH
End If
'--- figure out procedure DispID
If IsNumeric(ProcName) Then
lDispID = ProcName
Else
hResult = DispCallByVtbl(ObjPtr(pDisp), IDX_GetIDsOfNames, VarPtr(IID_NULL(0)), VarPtr(StrPtr(ProcName)), 1&, 0&, VarPtr(lDispID))
If hResult < 0 Then
GoTo QH
End If
End If
'--- reverse arguments
If UBound(Args) >= 0 Then
ReDim vRevArgs(0 To UBound(Args) - LBound(Args)) As Variant
For lIdx = 0 To UBound(vRevArgs)
'--- have to keep VT_BYREF so cannot use simple assignment here
Call VariantCopy(vRevArgs(lIdx), Args(UBound(Args) - lIdx))
Next
aParams(0) = VarPtr(vRevArgs(0)) ' .rgPointerToVariantArray
aParams(2) = UBound(vRevArgs) + 1 ' .cArgs
End If
If (CallType And (VbLet Or VbSet)) <> 0 Then
lPropPutDispID = DISPID_PROPERTYPUT
aParams(1) = VarPtr(lPropPutDispID) ' .rgPointerToLongNamedArgs
aParams(3) = 1 ' .cNamedArgs
End If
If (CallType And (VbGet Or VbMethod)) <> 0 Then
lResultPtr = VarPtr(DispInvoke)
End If
hResult = DispCallByVtbl(ObjPtr(pDisp), IDX_Invoke, lDispID, VarPtr(IID_NULL(0)), 0&, CallType, VarPtr(aParams(0)), lResultPtr, 0&, 0&)
'--- take care of subs (some do not accept result pointer)
If hResult = DISP_E_MEMBERNOTFOUND And (CallType And VbMethod) <> 0 Then
hResult = DispCallByVtbl(ObjPtr(pDisp), IDX_Invoke, lDispID, VarPtr(IID_NULL(0)), 0&, CallType, VarPtr(aParams(0)), 0&, 0&, 0&)
End If
QH:
If hResult < 0 Then
IID_NULL(0) = vbError
IID_NULL(2) = hResult
Call VariantCopy(DispInvoke, IID_NULL(0))
End If
End Function
Private Function DispCallByVtbl(ByVal pUnk As Long, ByVal lIndex As Long, ParamArray Args() As Variant) As Variant
Const CC_STDCALL As Long = 4
Dim vParams As Variant
Dim lIdx As Long
Dim vType(0 To 63) As Integer
Dim vPtr(0 To 63) As Long
Dim hResult As Long
vParams = Args
For lIdx = 0 To UBound(vParams)
vType(lIdx) = VarType(vParams(lIdx))
vPtr(lIdx) = VarPtr(vParams(lIdx))
Next
hResult = DispCallFunc(pUnk, lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
If hResult < 0 Then
Err.Raise hResult, "DispCallFunc"
End If
End Function
Notice that
DispInvoke never raises an error but return
CVErr created variant of
vbError sub-type. Test for failure with
IsError(vResult) and if
vbError can extract the HRESULT with
CLng(vResult) while casting
vResult to string produces "Error Xxx" as text. Notice how
IsError(DispInvoke(Command1, "Index", VbGet Or VbMethod)) can be used to test if the command button control is part of a control array with no error being raised, so this check works in "Break on All Errors" mode too. Notice how all
ByRef output params are correctly populated when the call returns too. Notice how instead of a procedure *name* one can pass a
DispID like -4 (DISPID_NEWENUM) to get the enumerator without knowing the method name it was implemented under.
All this goodness in less than 100 LOC :-))
Enjoy!
</wqw>
Thanks for this great routine.
One question:
Why do we have to reverse the arguments before passing them to the IDispatch::Invoke Method ?
Regards.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
If you check out IDispatch::Invoke documentation it mentions (in passing) the reverse order of pDispParams->rgvarg array under puArgErr parameter details
puArgErr
The index within rgvarg of the first argument that has an error. Arguments are stored in pDispParams->rgvarg in reverse order, so the first argument is the one with the highest index in the array. This parameter is returned only when the resulting return value is DISP_E_TYPEMISMATCH or DISP_E_PARAMNOTFOUND. This argument can be set to null.
cheers,
</wqw>
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
wqweto
If you check out
IDispatch::Invoke documentation it mentions (in passing) the reverse order of
pDispParams->rgvarg array under
puArgErr parameter details
puArgErr
The index within rgvarg of the first argument that has an error. Arguments are stored in pDispParams->rgvarg in reverse order, so the first argument is the one with the highest index in the array. This parameter is returned only when the resulting return value is DISP_E_TYPEMISMATCH or DISP_E_PARAMNOTFOUND. This argument can be set to null.
cheers,
</wqw>
Sorry, I should have checked out the documentation before asking.
Thanks for answering.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
Quote:
Originally Posted by
dreammanor
Hi xiaoyao, have you tried embedding Chrome windows into a VB Form?
Long way to open multiple windows in Google Chrome and then put the menu. Unexpectedly all hide the same, just right, er web page control part embedded in the VB window. It runs a standard Google Chrome window, but in VB we can display 4 to 16 pages in one pass.
In a word, it is to display multiple Google Chrome web pages as multiple Vb6 controls.
And then every Google Chrome window. I bind an object, open a web page, read the content of the web page, and execute the script.
-
Re: Digging into COM from Class1 inside a standard VB6 EXE project.
There is some very small remote desktop software. You just need to fill in the account number and password. We can hide the whole process. Finally, most of the displayed remote desktop is turned into a control, including the icon of the taskbar. Of course, you can also turn the ordinary office Excel window into a control. Hide any extraneous menus, as well as the tab ribbon.
-
Re: [RESOLVED] Digging into COM from Class1 inside a standard VB6 EXE project.
I don't know what y'all are talking about, but this thread is quite old, and long since resolved.
Please start your own thread if you wish to discuss other topics.
-
Re: [RESOLVED] Digging into COM from Class1 inside a standard VB6 EXE project.
Code:
Private Sub Command1_Click()
ParseFile App.Path & "\" & App.EXEName & ".exe"
End Sub
what's form,usercontrol type id?
fType:50430083,cName=DataEnvironment1
fType:16875651,cName=DataReport1
fType:98435,cName=MDIForm1
fType:1409027,cName=PropertyPage1
fType:1941507,cName=UserControl1
fType:98435,cName=Form2
fType:1146883,cName=Class1
fType:98435,cName=frmMain
