[RESOLVED] Digging into COM from Class1 inside a standard VB6 EXE project.

[wqweto]

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>

[LaVolpe]

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))

[jsvenu]

Dear wqew and Lavolpe,
Thankyou very much for the replies.

regards,
JSVenu

[loquat]

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

@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?

[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

[wqweto]

JFYI, here is DispInvoke function implemented as a CallByName replacement that uses DispCallFunc to directly call IDispatch::Invoke

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>

[Eduardo-]

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?

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.

[loquat]

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

[loquat]

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.

[wqweto]

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>

[xiaoyao]

share1 class1,form1 ,use createobject("project1.form1") to read,call method
Prj_ShareForm.zip

[dreammanor]

Hi xiaoyao, have you tried embedding Chrome windows into a VB Form?

[xiaoyao]

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多线程处理了。
我以前的使用案例之一，打开我自己的淘宝网店。采集我卖出去的订单数据。

[JAAFAR]

JFYI, here is DispInvoke function implemented as a CallByName replacement that uses DispCallFunc to directly call IDispatch::Invoke

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.

[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>

[JAAFAR]

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.

[xiaoyao]

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.

[xiaoyao]

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.

[Elroy]

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.

[xiaoyao]

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