Printable View
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,
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.
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.
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.
@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~! =)
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:
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.Code:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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.
Personally, I find the WM_COPYDATA quite easy, but I'm also fairly comfortable with subclassing these days.Quote:
Originally Posted by aboka
And Happy Holidays to you as well.
@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.Quote:
Originally Posted by jdc2000
thanks :)
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
You might want to move PutObject, RevokeObject and IsObjectRunning routines into a separate module.Code:'--- 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
cheers,
</wqw>
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):
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).Code:
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
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):
I few notes about the way I do subclassing.Code:
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
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:
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).Code:
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
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.
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 :D
Merry Christmax, and Happy New Year~!
p/s - will rate all the answers, but couldn't as dont hv enough reputations.... sorry
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 :)Quote:
Originally Posted by gilman