We help IT Professionals succeed at work.

How to prevent multiple instances in a VB6 program

mskvarenina
mskvarenina asked
on
I need to prevent multiple instances of a VB program from being started on the same PC.  Microsoft and others have examples on the net but none of them have worked as indicated.  

Can someone please post a working example.
Comment
Watch Question

Commented:
On the load event of your first form type:
If (App.PrevInstance = True) Then
    unload me
end if


Commented:
doesn't app.previnstance work for you?
You could always write some registry setting out when the app starts and stops, but make sure you have someway of bypassing it if the app crashes and leaves the setting in place; perhaps write out the instance handle of the app, and test to see if the app previously running is still running.

Another method I use in my current project is to open a 'lock file' for output at the beginning of the program, and leave it open. When the app closes or crashes, the handle is closed. If another app is running, the open statement will fail and you can handle the error.

Author

Commented:
nahumd, your suggestion didn't work.  Although additional 'starts' of the app didn't display they were all present in the task list...

Commented:
mskvarenina - that's probably because the code's closing the form, rather than the application. Try it with a (nasty) "End" statement rather than "unload me".
Make sure the code supplied by nahumd is the absolutely first code to be executed when you launch your app otherwise you may have the application in memory due to open forms or other open objects.

Author

Commented:
mindphaser, yes it is the first code executed.  In project properties this is the selected form and it's at the very top of the load event.
Commented:
Are you doing anything else in the form load? Try adding an exit sub after the unload me.

Commented:
You can add an "end program function":

private sub end_program

dim frm as form
for each frm in forms
   unload frm
next

end sub

and call it instead of "unload me"
Brendt HessSenior DBA
CERTIFIED EXPERT

Commented:
The simple method, useful when you are checking this *first* (before opening anything) is:

If (App.PrevInstance = True) Then
   unload me
   End   ' Add this
end if

However, if you want a bit more sophistication, this code sets focus to the other running instance of the code.  First, some needed API calls...

Declare Function GetWindow Lib "user32" (ByVal hwnd%, ByVal wCmd%) As Integer
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd%, ByVal lpSting$, ByVal nMaxCount%) As Integer
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd%) As Integer
Private Declare Function FindWindow% Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpCaption As Any)
Private Declare Function ShowWindow% Lib "user32" (ByVal Handle As Integer, ByVal Cmd As Integer)
Private Declare Function SFocus% Lib "user32" Alias "SetFocus" (ByVal Handle As Integer)

Now, one utility subroutine:

Sub LoadTaskList(Frm As Form, Arry$())

Dim CurrWnd&, Length%, ListItem$, I%

   ReDim Arry$(0 To 0)
   I = 0

   'Get the hWnd of the first item in the master list
   'so we can process the task list entries (top-level only).
   CurrWnd = GetWindow(Frm.hwnd, GW_HWNDFIRST)

   'Loop while the hWnd returned by GetWindow is valid.
   Do While CurrWnd <> 0
      'Get the length of task name identified by CurrWnd in the list.
      Length = GetWindowTextLength(CurrWnd)

      'Get task name of the task in the master list.
      ListItem$ = Space$(Length + 1)
      Length = GetWindowText(CurrWnd, ListItem$, Length + 1)

      'If there is a task name in the list, add the item to the list.
      If Length > 0 Then
         I = I + 1
         ReDim Preserve Arry$(0 To I)
         Arry(I) = ListItem$
      End If

      'Get the next task list item in the master list.
      CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)

      'Process Windows events.
      DoEvents
   Loop
End Sub

------------------

In your startup code, add this code:

Dim Tasks() As String
Dim I as Integer
Dim J As Integer
Dim S As String
Dim TLen As Integer
...

' Ensure that a double-click on the icon is caught.  Delay a bit...
   For I = 1 To 100
      DoEvents
   Next I

   S = App.Title
   TLen = Len(S)
   App.Title = "... duplicate instance."
   Me.Caption = "... duplicate instance."

   LoadTaskList Me, Tasks()

   For J = 1 To UBound(Tasks)
      If Len(Tasks(J)) >= TLen Then
         If Left(Tasks(J)) = S Then
            Tasks(0) = Left$(Tasks(J), 8)
            Exit For
         End If
      End If
   Next J

   If J <= UBound(Tasks) Then
      I = FindWindow(0&, Tasks(J))
      If I <> 0 Then
         J = ShowWindow(I, 9)
         J = SFocus(I)
      End If
      End
   End If

   App.Title = S
   Me.Caption = S

' rest of startup code...

Author

Commented:
andyclap:  Thanks, the exit sub worked but as bhess1 said, a more sophisticated method would set the focus to the original running app.  bhess1, I tried your example and had a problem.  First in the startup code you recommended a line if Left(Tasks(J)) = S Then but there doesn't appear to be a function Left...did you mean Left$?  I took a stab and changed it to Left$ with a length of 8 but the app never started.  Then when I clicked it again I got an "overflow".  Any ideas?
Mike McCrackenSenior Consultant
CERTIFIED EXPERT
Most Valuable Expert 2011
Top Expert 2013

Commented:
listening
Brendt HessSenior DBA
CERTIFIED EXPERT

Commented:
Sorry - Left (or Left$ - either works) needs another parameter (length) that I neglected to add.  This code was adapted from code we use in our app, and some app specific code was removed, causing the problem.

In any case, the line should read:

If Left(Tasks(J), Len(S)) = S Then
           
Brendt HessSenior DBA
CERTIFIED EXPERT

Commented:
Hmmm... looking over the code again (after having the problem pointed out), you should modify more than that one line.  Here's the block of code, corrected:

  For J = 1 To UBound(Tasks)
     If Len(Tasks(J)) >= TLen Then
        If Left$(Tasks(J), TLen) = S Then
           Tasks(0) = Left$(Tasks(J), TLen)
           Exit For
        End If
     End If
  Next J

I used Left$ since you seem to have some sort of problem using Left().  Sorry for the typos

Explore More ContentExplore courses, solutions, and other research materials related to this topic.