Reading Parameters After Form Is Open

[aboka]

hi, am using Command$ to read the startup parameters and all is working fine. but we like to make it a single instance program and keep reading/executing the parameters even after its opened.

we are using 'App.PrevInstance' for the single instance. please advice with some sample code. thank you.

p/s - am surprise and happy this forum is still active as thought most ppl has port to .Net

p/ss - using VB6

cheers,

[jdc2000]

Command$ would get the parameters from a command line or batch file startup of your program. What other parameters would you want to be reading after the program is already started? You can design your form so that users can enter whatever additional information is needed to process additional data.

[Elroy]

My best suggestion would be to do a bit of subclassing on some form, and use a call to SendMessageTimeout with the WM_COPYDATA message to get your Command$ data over to the already-running program.

I talk about how to do that here.

[Elroy]

DDE would also be an option, but I used to struggle to get DDE to behave the way I wanted. The WM_COPYDATA method has never failed me.

[aboka]

@Elroy thanks for the fast response. I am a newbie mostly copy and paste fr the internet. let me try translate to your suggesstion:

#1 - basically the 'second' program will check if its already running; if yes then it will send its received Command over to the already running program using subclassing. will read the link you share above when got more free time tommorow as its quite long

#2 - yes, DDE. think i hv tried and using this long time ago. will do some research on that. this seems to be 'more easy' option.

will post back after going thru them. thanks and Merry Christmas to all you guys here. VB6 still rocking~! =)

[Elroy]

Just to talk about the WM_COPYDATA approach a bit more, you will have to use the following to find your subclassed window in the already-running version:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

But that's easy to use. Just put 0& for lpClassName and put the title (caption) of the subclassed window in for lpWindowName, and it should return the hWnd of that form.

Also, be sure you don't have that same form loaded on the newly-running (second) version of your program so it doesn't find that window.

I'll be around, so let me know if you decide to use this method and have any problems.

[Elroy]

yes, DDE. think i hv tried and using this long time ago. will do some research on that. this seems to be 'more easy' option.

Personally, I find the WM_COPYDATA quite easy, but I'm also fairly comfortable with subclassing these days.

And Happy Holidays to you as well.

[aboka]

Command$ would get the parameters from a command line or batch file startup of your program. What other parameters would you want to be reading after the program is already started? You can design your form so that users can enter whatever additional information is needed to process additional data.

@jdc2000 hi, this is more like an experimental to how to read the Command$ after program is running. we thought of this while playing on communication between pc using winsock. dont really hv a real workd use at this moment. i guess there will be other ways to it, but as for now, we like to learn how to make this work.

thanks

[wqweto]

There is no easy way to do this unfortunately. If you know how to use builtin GetObject function you can try the PutObject function in this thread.

The idea is for the first instance to register using PutObject some moniker like "MySpecialProject.MainForm" and the second instance to use GetObject to retrieve a reference to main form of first instance and call a method (notify it) passing its current Command$

Edit: Here is a full working sample

'--- Form1
Option Explicit

Private Declare Function GetRunningObjectTable Lib "ole32" (ByVal dwReserved As Long, pResult As IUnknown) As Long
Private Declare Function CreateFileMoniker Lib "ole32" (ByVal lpszPathName 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 MY_MONIKER As String = "MySpecialProject.MainForm"

Private m_lCookie As Long

Public Sub HandleCommandLine(sArgs As String)
    Caption = sArgs
End Sub

Private Sub Form_Load()
    If IsObjectRunning(MY_MONIKER) Then
        GetObject(MY_MONIKER).HandleCommandLine Command$
        Unload Me
    Else
        m_lCookie = PutObject(Me, MY_MONIKER)
        HandleCommandLine Command$
    End If
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    If m_lCookie <> 0 Then
        RevokeObject m_lCookie
    End If
End Sub
 
Private 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

Private 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

Private 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 might want to move PutObject, RevokeObject and IsObjectRunning routines into a separate module.

cheers,
</wqw>

[Elroy]

Ok, the attached project is an example of what I'm talking about. To test, it's easiest to compile it and then run it from the command line putting params on the command line when you do.

Let me say a couple of things about this.

First, I think, to do this correctly, it's important to start your project up from a Sub Main. That just provides additional control.

Now, I'm also going to post some code, but it's best to just grab the attached PassCommandParams.zip file.

Here's the code I've got in Module1.bas (with the Sub Main):

Option Explicit
'
Public Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type
'
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Public Declare Function FindWindowByTitle Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As String) As Long
'
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
'

Private Sub Main()
    ' This is our start-up.
    ' This will work in either the IDE or compiled.
    ' However, we can only get one copy loaded in the IDE,
    ' but we could compile it, run that compiled copy, and then run the second fron the IDE (to test, if we wanted).
    '
    ' See if another version is running.
    ' We must do this BEFORE we load our form.
    Dim hWndOtherInstance As Long
    hWndOtherInstance = FindWindowByTitle(0&, "Pass Command Params")
    If hWndOtherInstance Then  ' This works as well as (if not better than) App.PrevInstance.
        SendStringToAnotherWindow 0&, hWndOtherInstance, Command$
        Exit Sub
    End If
    '
    If InIDE Then
        ' We may often want to test without subclassing, as it does pose some risk to the IDE if not handled correctly.
        gbAllowSubclassing = MsgBox("Do we wish to subclass when running?", vbQuestion + vbYesNo) = vbYes
    Else
        ' Once compiled, there's no risk (other than bugs in coding).
        gbAllowSubclassing = True
    End If
    '
    ' We're now ready to show our form.
    Form1.Show
End Sub


Public Function InIDE(Optional ByRef b As Boolean = True) As Boolean
    ' NEVER specify the Optional b when calling.
    ' IDE bInIde bIsIde IsIde InIde Compiled bCompiled.
    If b = True Then Debug.Assert Not InIDE(InIDE) Else b = True
End Function

Public Function RTrimNull(s As String) As String
    RTrimNull = s
    Do
        If Right$(RTrimNull, 1&) <> vbNullChar Then Exit Do
        RTrimNull = Left$(RTrimNull, Len(RTrimNull) - 1&)
    Loop
End Function

Public Function FormObjectFromPtr(ByVal Ptr As Long) As VB.Form
    ' Ideas for these were initially shown to me by The Trick.
    ' This uses the pointer to an existing (instantiated) COM/Form object and makes another reference to it.
    ' This reference is handled completely correctly in that Addref is performed for it.
    ' Usage: Set FormAlias = FormObjectFromPtr(ObjPtr(FormOriginal))
    vbaObjSetAddref FormObjectFromPtr, ByVal Ptr
End Function

Public Sub SendStringToAnotherWindow(hWndSender As Long, hWndTarget As Long, sMsg As String)
    ' This can be used to send a message (string) to another window, possibly in another VB6 program.
    ' The other VB6 program MUST be expecting the message.  And it will need to be subclassed (i.e., hooked).
    ' See the StringMessageHook, StringMessageUnhook, and StringMessageWindowProc for details on how
    ' the receiving program must be set up.
    '
    Dim cds             As COPYDATASTRUCT
    Dim lpdwResult      As Long
    Dim Buf()           As Byte
    Const WM_COPYDATA   As Long = &H4A&
    '
    If hWndTarget Then
        ReDim Buf(1& To Len(sMsg) + 1&)
        Call CopyMemory(Buf(1&), ByVal sMsg, Len(sMsg)) ' Copy the string into a byte array, converting it to ASCII.
        cds.dwData = 3&
        cds.cbData = Len(sMsg) + 1&
        cds.lpData = VarPtr(Buf(1&))
        SendMessageTimeout hWndTarget, WM_COPYDATA, hWndSender, cds, 0&, 10&, lpdwResult
    End If
End Sub

As we can see, I actually didn't use App.PrevInstance, as I searched for the other (prior running) window, and that should serve just as well (if not better).

Now, also keep in mind that I specifically searched for a window with the caption Pass Command Params. If you change the caption of your main window, the window searched in my FindWindowByTitle will have to be tweaked to match.

Here's the code I've got in Module2.bas (basically the subclassing module for this):

Option Explicit
'
Public gbAllowSubclassing               As Boolean      ' Be sure to turn this on if you're going to use subclassing.
Private bSetWhenSubclassing_UsedByIdeStop As Boolean    ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
Private Const WM_DESTROY                As Long = &H2&  ' All other needed constants are declared within the procedures.
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
'
' Generic subclassing procedures (used in many of the specific subclassing).
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long, Optional uIdSubclass As Long)
    '
    ' In most cases, we just use hWnd for uIdSubclass.  However, in certain cases, we will use the same subclass procedure on the same hWnd
    ' with different uIdSubclass values.  For instance, if we want to "watch" a control, but we subclass the form to do this.  We may have
    ' several controls on the form we wish to "watch", but the form's hWnd and the subclass procedure will be the same.  Therefore, we can
    ' use different uIdSubclass values to keep it all straight.
    '
    ' The subclass uniqueness is defined by pfnSubclass and uIdSubclass (2nd and 3rd arguments in API calls).
    '
    ' This can be called AFTER the initial subclassing to update dwRefData.
    '
    If Not gbAllowSubclassing Then Exit Sub
    '
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, dwRefData)
End Sub

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long)
    ' Only needed if we specifically want to un-subclass before we're closing the form (or control),
    ' otherwise, it's automatically taken care of when the window closes.
    '
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass)
End Sub

Private Function ProcedureAddress(AddressOf_TheProc As Long) As Long
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Function IdeStopButtonClicked() As Boolean
    ' The following works because all variables are cleared when the STOP button is clicked,
    ' even though other code may still execute such as Windows calling some of the subclassing procedures below.
    IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Public Sub SubclassFormToReceiveStringMsg(frm As VB.Form)
    '
    ' On this one, we use dwRefData to save the ObjPtr(SomeForm) of the form that is to receive the message.
    '
    ' Called as follows:
    '       SubclassSomeWindow Me.hWnd, AddressOf StringMessage_Proc, ObjPtr(Me)
    '
    ' NOTE: Best done in the Form_Load event, but doesn't really matter so long as it's done before the message is sent.
    '
    ' This can simultaneously be used by as many forms as will need it,
    ' but it can only be done once per form.
    '
    ' See SendStringToAnotherWindow for sending a message (which doesn't require subclassing).
    '
    SubclassSomeWindow frm.hWnd, AddressOf StringMessage_Proc, ObjPtr(frm)
End Sub

Private Function StringMessage_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_StringMessage_Proc, uIdSubclass
        StringMessage_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        StringMessage_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim cds As COPYDATASTRUCT
    Dim Buf() As Byte
    Dim sMsg As String
    Dim frm As VB.Form
    Const WM_COPYDATA As Long = &H4A&
    '
    If uMsg = WM_COPYDATA Then
        Call CopyMemory(cds, ByVal lParam, Len(cds))
        ReDim Buf(1 To cds.cbData)
        Call CopyMemory(Buf(1), ByVal cds.lpData, cds.cbData)
        sMsg = StrConv(Buf, vbUnicode)
        sMsg = RTrimNull(sMsg)
        Set frm = FormObjectFromPtr(dwRefData)
        On Error Resume Next            ' Put error trapping around this because it's never good to error in these subclass procedures.
            frm.HereIsYourMessage sMsg  ' HereIsYourMessage MUST be public, or we can't find it this way.
        On Error GoTo 0
    End If
    '
    ' Give control to other procs, if they exist.
    StringMessage_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_StringMessage_Proc() As Long
    AddressOf_StringMessage_Proc = ProcedureAddress(AddressOf StringMessage_Proc)
End Function

I few notes about the way I do subclassing.

One, for it to do anything, you have to be sure and turn on the gbAllowSubclassing flag.

Two, my method of subclassing is somewhat safe for the IDE. However, its one weakness is, if you click a Stop/End button while a modal form is loaded, you'll crash the IDE. As a note, this includes the "End" button on the popup for a runtime error. It also includes message boxes. However, if no modal forms are loaded, it's completely safe in the IDE. Basically, it's most prudent to just exit your program the way you would in the compiled version (and just try to stay away from the IDE's stop button).

And this is precisely why I've got that gbAllowSubclassing flag that I usually set with a prompt when in the IDE. That way, I can develop (unrelated things) without worrying about the subclassing.

----

Ok, lastly, here's some code I threw into the Form1 test form:

Option Explicit

Private Sub Form_Load()
    SubclassFormToReceiveStringMsg Me
    '
    MsgBox "Command params from initial startup: " & vbNewLine & vbNewLine & """" & Command$ & """"
End Sub

Public Sub HereIsYourMessage(sMsg As String)
    MsgBox "Command params from running another instance: " & vbNewLine & vbNewLine & """" & sMsg & """"
End Sub

There aren't any controls on this form (although there could be). It could easily just be one of your main forms that never gets unloaded (or you will no longer get the messages, nor will you stop other instances).

The most important thing is the HereIsYourMessage procedure. That's where other Command$ strings (from other instances trying to run) will come into your program.

---

That's about it.

[aboka]

ok guys, manage to make it work using the Subclass example here, and also with DDE forms too.

thanks a lot to all, especially @Elroy for the sample and details explaining

Merry Christmax, and Happy New Year~!

p/s - will rate all the answers, but couldn't as dont hv enough reputations.... sorry

[gilman]

Alternatively you can use an Active Exe project and a client application that launch the main application with the params you need.
In the adjunt file there's a sample on how to do it.

[aboka]

Alternatively you can use an Active Exe project and a client application that launch the main application with the params you need.
In the adjunt file there's a sample on how to do it.

Thanks for another example