Results 1 to 5 of 5

Thread: [RESOLVED] vb6 activex.exe commandline Application

  1. #1

    Thread Starter
    New Member
    Join Date
    Dec 2022
    Posts
    3

    Resolved [RESOLVED] vb6 activex.exe commandline Application

    To be frank I just cannot get my head around "classes", wrappers" etc...
    I need a very simple activeX component that a vb6 main exe can access. The activeX.exe would be run from the command line
    e.g: "UPSstatus.exe /n" where n is the status number. There would only be one "instance" of the active component. If the CLI was run again with a new value of "n" that would become the value the component will make available to the client exe
    I don't want a form created or even visible.
    All I want is that the activeX component "UPSstatus.exe" will make the status value "n" available to the client program running on the same computer.
    Can anyone out there put me out of my misery?

    Thank you in advance.

  2. #2
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: vb6 activex.exe commandline Application

    For you server start a new Std-EXE project and paste this code in Form1

    Code:
    '--- server
    Option Explicit
    
    Private Declare Function CreateFileMoniker Lib "ole32" (ByVal lpszPathName As Long, pResult As IUnknown) As Long
    Private Declare Function GetRunningObjectTable Lib "ole32" (ByVal dwReserved As Long, pResult As IUnknown) As Long
    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 Const STR_MONIKER As String = "MySolution.MyServer"
    
    Public MyValue As String
    
    Private Sub Form_Load()
        If IsObjectRunning(STR_MONIKER) Then
            With GetObject(STR_MONIKER)
                .MyValue = Command$
            End With
            Unload Me
        Else
            MyValue = Command$
            PutObject Me, STR_MONIKER
            Visible = False
        End If
    End Sub
    
    Public Function PutObject(oObj As Object, sPathName As String, Optional ByVal Flags As Long) As Long
        Const ROTFLAGS_REGISTRATIONKEEPSALIVE As Long = 1
        Const IDX_REGISTER  As Long = 3
        Dim hResult         As Long
        Dim pROT            As IUnknown
        Dim pMoniker        As IUnknown
        
        hResult = GetRunningObjectTable(0, pROT)
        If hResult < 0 Then
            Err.Raise hResult, "GetRunningObjectTable"
        End If
        hResult = CreateFileMoniker(StrPtr(sPathName), pMoniker)
        If hResult < 0 Then
            Err.Raise hResult, "CreateFileMoniker"
        End If
        DispCallByVtbl pROT, IDX_REGISTER, ROTFLAGS_REGISTRATIONKEEPSALIVE Or Flags, ObjPtr(oObj), ObjPtr(pMoniker), VarPtr(PutObject)
    End Function
    
    Public Sub RevokeObject(ByVal lCookie As Long)
        Const IDX_REVOKE    As Long = 4
        Dim hResult         As Long
        Dim pROT            As IUnknown
        
        hResult = GetRunningObjectTable(0, pROT)
        If hResult < 0 Then
            Err.Raise hResult, "GetRunningObjectTable"
        End If
        DispCallByVtbl pROT, IDX_REVOKE, lCookie
    End Sub
    
    Public Function IsObjectRunning(sPathName As String) As Boolean
        Const IDX_ISRUNNING As Long = 5
        Const S_OK          As Long = 0
        Dim hResult         As Long
        Dim pROT            As IUnknown
        Dim pMoniker        As IUnknown
        
        hResult = GetRunningObjectTable(0, pROT)
        If hResult < 0 Then
            Err.Raise hResult, "GetRunningObjectTable"
        End If
        hResult = CreateFileMoniker(StrPtr(sPathName), pMoniker)
        If hResult < 0 Then
            Err.Raise hResult, "CreateFileMoniker"
        End If
        If DispCallByVtbl(pROT, IDX_ISRUNNING, ObjPtr(pMoniker)) = S_OK Then
            '--- success
            IsObjectRunning = True
        End If
    End Function
    
    Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
        Const CC_STDCALL    As Long = 4
        Dim lIdx            As Long
        Dim vParam()        As Variant
        Dim vType(0 To 63)  As Integer
        Dim vPtr(0 To 63)   As Long
        Dim hResult         As Long
        
        vParam = A
        For lIdx = 0 To UBound(vParam)
            vType(lIdx) = VarType(vParam(lIdx))
            vPtr(lIdx) = VarPtr(vParam(lIdx))
        Next
        hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
        If hResult < 0 Then
            Err.Raise hResult, "DispCallFunc"
        End If
    End Function
    You client code will be much simpler (literally one line of code). Start a new Std-EXE, place a button on Form1 and paste this code in Form1

    Code:
    '--- client
    Option Explicit
    
    Private Const STR_MONIKER As String = "MySolution.MyServer"
    
    Private Sub Command1_Click()
        On Error GoTo EH
        MsgBox GetObject(STR_MONIKER).MyValue, vbExclamation
    EH:
    End Sub
    Start your server with server.exe test

    Pressing the button on the client will show "test".

    Without killing the first server launch a second instance with server.exe second

    Now pressing the button on the client will show "second".

    cheers,
    </wqw>

  3. #3

    Thread Starter
    New Member
    Join Date
    Dec 2022
    Posts
    3

    Re: vb6 activex.exe commandline Application

    wqweto,
    It seems you have used a server-client solution using standard exe which means I don't have have to make an activeX component at all? If so it also means I wouldn't have to be concerned about registering the "server"?
    Thank you for your idea. I will try it out, and let you know if there are any issues.
    I tried the solution and it seemed to work, but when I put a new command button in my existing project which already has 2 command buttons and added your code...
    Private Sub Command3_Click()
    On Error GoTo EH
    MsgBox GetObject(STR_MONIKER).MyValue, vbExclamation
    End Sub
    although the rest of the program runs as normal when i click on the command3 button I get a complle error. GetObject is highlighted
    and the error message is "argument not optional"
    Can you suggest what is wrong?
    Last edited by Cal9; Dec 5th, 2022 at 08:46 PM. Reason: tried your idea and not entirely working

  4. #4

    Thread Starter
    New Member
    Join Date
    Dec 2022
    Posts
    3

    Re: vb6 activex.exe commandline Application

    I have figured out the problem. I was using an API (I think that is the right term) call...
    "Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, _
    ByVal nCount As Long, ByRef lpObject As Any) As Long"

    This took predence over the Vb built-in "GetObject()" function.
    I have renamed to remove that conflict and now it works as expected.
    I have also learned a lesson, that I need to make a note of ALL
    Vb built-in functions, not just the ones I happen to be using to avoid this sort of problem in the future.
    Thank you for your help VBForums
    Goodbye until my next problem which will be sooner than later lol

  5. #5
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [RESOLVED] vb6 activex.exe commandline Application

    how to GetRunningObjectTable,list all object by api,without tlb?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width