If App.PrevInstance with a twist 1

[HughLerwill]

Dear All,

I have an app which may run multiple instances but I only want it to run a newly started instance (or display a message) if its 'Startin folder'/ CurDir$ is not equal to that used by any previous instance.
Using a file to track previous instances in App.Path is complicated in that multiple network users (who can all start muliple instances) may be using the same .exe file.

Any ideas?

TIA Hugh,

 

[dglienna]

Check if the PID is running? Look up Process Identification API. It should be easy to find your app by caption, or PID.

-David
2006 Microsoft Most Valueable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[HughLerwill]

To clarify in psuedo code;

For Each Instance in PrevInstancesOnThisPC
If Instance.CurDir = Curdir then
MsgBox "Instance already running over this folder"
CurrentInstance.Quit
End if
Next
'continue

 

[HughLerwill]

David,

My psudo code posted before I read your response.

The PID Api sounds interesting can you give me a more specific API function name(s), Googling for 'Process Identification API' has not turned up much yet.

Thanks Hugh,

 

[dglienna]

Well, look at this sample. Put this code in a BAS module:

Option Explicit

Private Declare Function EnumDesktopWindows _
 Lib "user32.dll" ( _
 ByVal hDesktop As Long, _
 ByVal lpfn As Long, _
 ByVal lparam As Long) As Long

Private Declare Function GetWindowText _
 Lib "user32.dll" Alias "GetWindowTextA" ( _
 ByVal hwnd As Long, _
 ByVal lpString As String, _
 ByVal cch As Long) As Long

Private Const MAX_LENGTH = 261&

Private sFind As String
Private sFullCaption As String

Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lparam As Long) As Long
    Dim sCap As String
    sCap = String$(MAX_LENGTH, vbNullChar)
    GetWindowText hwnd, sCap, MAX_LENGTH
    If InStr(1, sCap, sFind, vbTextCompare) <> 0 Then
        sFullCaption = StripNull(sCap) & "  hwnd: " & hwnd
        EnumWindowsProc = 0
    Else
        EnumWindowsProc = 1
    End If
End Function

Private Function StripNull(ByVal str As String) As String
    Dim nPos As Long
    nPos = InStr(str, vbNullChar)
    If nPos Then
        StripNull = Left$(str, nPos - 1)
    Else
        StripNull = str
    End If
End Function

Public Function GetFullCaption(ByVal sFindString As String) As String
    sFind = sFindString
    sFullCaption = ""
    EnumDesktopWindows 0, AddressOf EnumWindowsProc, 1
    GetFullCaption = sFullCaption
End Function

Open up Notepad, and run this:

Form1:

Option Explicit

Private Sub Form_Load()
  Dim a
  a = GetFullCaption("Notepad")
  MsgBox a
  End
End Sub

-David
2006 Microsoft Most Valueable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[dglienna]

Just found this:

http://allapi.mentalis.org/apilist/GetCurrentProcessId.shtml

-David
2006 Microsoft Most Valueable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[HughLerwill]

dglienna,

Thanks for the feedback and examples which get close but I see no way to detect the CurDir of a given process. Sorry if I am missing something.

I guess I could place the Curdir of the app into a Label on its main form when it runs. Then having found a previous instance I could possibly search for the textbox and read its contents. Is there a better way?

regards Hugh,

 

[Hypetia]

>I see no way to detect the CurDir of a given process

This was the main obstacle. With some IPC techniques I was able to do it, in the following program.

The logic is a bit complicated, but I have tried to document the code as much as possible.

The following code goes in the form.
___
[tt]
Option Explicit

Private Sub Form_Load()
'Copy the path of the current directory to Path() array
CopyMemory Path(0), ByVal CStr(CurDir$ & String(MAX_PATH, 0)), MAX_PATH
'Make 32-bit user data of this window point to Path() array
SetWindowLong hwnd, GWL_USERDATA, VarPtr(Path(0))
'Show the current directory
AutoRedraw = True
Print "CurDir:" & vbLf & CurDir$
If CheckCurDirInPreviousInstances Then
MsgBox "Instance already running over this folder" & vbLf & CurDir$
Unload Me
End If
End Sub

'Returns true if a previous instance of this app
'(if present) has the same CurDir as this instance
Function CheckCurDirInPreviousInstances() As Boolean
Dim hSnapShot As Long, pe32 As PROCESSENTRY32
Dim myPid As Long, myPath As String
'Get current Pid
myPid = GetCurrentProcessId
'Get full path of the current process
myPath = GetPathFromPid(myPid)
'Enumerate processes
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, ByVal 0)
pe32.dwSize = Len(pe32)
ProcessFirst hSnapShot, pe32
Do
'Don't check this very instance
If pe32.th32ProcessID <> myPid Then
'If the process (pe32) is a previous instance of this
'application then both processes will have the same path
If StrComp(myPath, GetPathFromPid(pe32.th32ProcessID), vbTextCompare) = 0 Then
Dim lpPath As Long, hProcess As Long, S As String * MAX_PATH
'Get a pointer to Path() array in that (previous) instance
lpPath = GetPathAddressFromPid(pe32.th32ProcessID)
'If a valid pointer
If lpPath Then
'Read the Path (CurDir) from that (previous) instance
hProcess = OpenProcess(PROCESS_VM_READ, 0, pe32.th32ProcessID)
ReadProcessMemory hProcess, ByVal lpPath, ByVal S, Len(S), ByVal 0&
CloseHandle hProcess
'If both instances have the same CurDir
If InStr(1, S, CurDir$ & vbNullChar, vbTextCompare) = 1 Then
CheckCurDirInPreviousInstances = True 'Return True
Exit Do
End If
End If
End If
End If
Loop While ProcessNext(hSnapShot, pe32)
CloseHandle hSnapShot
End Function

'Returns the pointer of Path() array in another
'instance of this application identified by Pid.
Function GetPathAddressFromPid(Pid As Long) As Long
Dim lParam As Long
lParam = Pid 'this Pid be used as lParam in EnumWindowsProc
EnumWindows AddressOf EnumWindowsProc, lParam
If lParam = Pid Then
'lParam was not modified by EnumWindowsProc
'which means no valid address was found.
GetPathAddressFromPid = 0 'return a NULL pointer
Else
'lParam contains a valid address to Path() array
'in other instance identified by Pid.
GetPathAddressFromPid = lParam 'return the address
End If
End Function[/tt]
___

This goes in a module.
___
[tt]
Option Explicit
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessId As Long) As Long
Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function GetModuleFileNameEx Lib "psapi" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Sub CloseHandle Lib "kernel32" (ByVal hObject As Long)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Const TH32CS_SNAPPROCESS = 2&
Public Const GWL_WNDPROC = -4&
Public Const GWL_USERDATA = -21&
Public Const PROCESS_QUERY_INFORMATION = &H400&
Public Const PROCESS_VM_READ = &H10&
Public Const MAX_PATH = 260&
Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Public Path(MAX_PATH) As Byte
'This function checks if the window (hwnd) being enumerated belongs to the
'process (Pid=lParam). If so, its user data value is queried which holds
'the pointer to Path() array in remote process (Pid=lParam). This pointer
'is returned to the calling funtion by assigning to ByRef lParam parameter.
Function EnumWindowsProc(ByVal hwnd As Long, lParam As Long) As Long
Dim ThisPid As Long, UserData As Long
EnumWindowsProc = -1 'Keep looking
'Get the Pid of this window
GetWindowThreadProcessId hwnd, ThisPid
'lParam has the Pid of the process being investigated
'If the window belongs to this process
If ThisPid = lParam Then
'get its user data value
UserData = GetWindowLong(hwnd, GWL_USERDATA)
'if user data is non-zero...
If UserData Then
'This is a pointer to Path() array in the other process
'set lParam to this value. This change will be reflected in
'calling procedure GetPathAddressFromPid from where
'EnumWindows is called (lParam is passed ByRef)
lParam = UserData
'Stop enumeration
EnumWindowsProc = 0
End If
End If
End Function

'returns the full path of a process identified by Pid.
Function GetPathFromPid(ByVal Pid As Long) As String
Dim hProcess As Long, S As String * MAX_PATH
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, Pid)
GetModuleFileNameEx hProcess, 0, S, MAX_PATH
CloseHandle hProcess
GetPathFromPid = Left$(S, InStr(S, vbNullChar) - 1)
End Function[/tt]
___

Don't run this program in IDE. Because the code myPath = GetPathFromPid(myPid) will return the path of VB6.EXE instead of the application path.

Compile the program, make several shortcuts to it and specify different working directories in shortcut properties.

Try invoking shortcuts in different sequences. For me, the results were fine.

Luckily, various parts of the code used in this program were copy-pasted from previous threads in this forum. I just arranged the pieces together to solve the puzzle.

 

[HughLerwill]

Hypetia,

Thank you very much for your code which is working well, I have not had a chance to study it yet but look forward. Much appreciated...

kind regards Hugh,

 

[HughLerwill]

Hypetia,

>had a chance to study it

And I am pretty sure I can see how it is working however after thrashing about with it all day there are a few issues. I appreciate your help very much and none of this is critism; just documentation so far.

On some real apps/forms the first 4 characters 'poked' into the Path array seem to get overwritten with ascii 0 after they are poked in there. This can be overcome by placing 4 spaces in front of the Curdir string before poking it and readjusting the instr test to find it at position 5.

On forms which can display other sub forms all is well until another form is opened, results then get unpredictable. Functionality is sometimes lost when a subform is opened, and sometimes it is restored when the sub form is closed. Behaviour is consistent with any given sub form but does not seem to be as simple/ dependent on whether it is just a 'free' or a modal one. I don't do hiding forms when sub forms are displayed generally so that aspect has not been tested.

Shelling to another exe sometimes results in failed functionality.

Functionality once lost can be restored by 'repoking' Curdir backinto the path array.

Does appear to work with an app which only has a modal form but I was not expecting that.

Seems as if something else has gets access to the memory occupied by the Path Array.

regards Hugh

 

[HughLerwill]

PS. Must add that I have changed the code a little.

Poking is done with a call to;

Public Sub PrevInstSetUp(hwnd As Long)

Const GWL_USERDATA = -21&
Const MAX_PATH = 260&
Dim Path(MAX_PATH) As Byte
Dim a$

If hwnd > 0 Then a$ = CurDir$ Else a$ = nul

'Copy the path of the current directory to Path() array
CopyMemory Path(0), ByVal CStr(String(4, 0) & a$ & String(MAX_PATH, 0)), MAX_PATH
'Make 32-bit user data of this window point to Path() array
SetWindowLong hwnd, GWL_USERDATA, VarPtr(Path(0))

End Sub

in Module1 and;

Function CheckCurDirInPreviousInstances(Optional AllAppsInCurrentFolder = False, Optional ArrayOfAppNames As Variant) As Boolean

ReDim ArrayOfAppNames(0)

Dim hSnapShot As Long, pe32 As PROCESSENTRY32
Dim myPid As Long, myPath As String, thisPath As String, fullPath As String
'Get current Pid
myPid = GetCurrentProcessId
'Get full path of the current process
myPath = GetPathFromPid(myPid)
If AllAppsInCurrentFolder Then myPath = Left$(myPath, InStrRev(myPath, "\"))
'Enumerate processes
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, ByVal 0)
pe32.dwSize = Len(pe32)
ProcessFirst hSnapShot, pe32
Do
'Don't check this very instance
If pe32.th32ProcessID <> myPid Then
'If the process (pe32) is a previous instance of this
'application then both processes will have the same path

thisPath = GetPathFromPid(pe32.th32ProcessID): fullPath = thisPath
If AllAppsInCurrentFolder Then thisPath = Left$(thisPath, InStrRev(thisPath, "\"))

'If StrComp(myPath, GetPathFromPid(pe32.th32ProcessID), vbTextCompare) = 0 Then
If StrComp(myPath, thisPath, vbTextCompare) = 0 Then

Dim lpPath As Long, hProcess As Long, s As String * MAX_PATH
'Get a pointer to Path() array in that (previous) instance
lpPath = GetPathAddressFromPid(pe32.th32ProcessID)
'If a valid pointer
If lpPath Then
'Read the Path (CurDir) from that (previous) instance
hProcess = OpenProcess(PROCESS_VM_READ, 0, pe32.th32ProcessID)
ReadProcessMemory hProcess, ByVal lpPath, ByVal s, Len(s), ByVal 0&
CloseHandle hProcess


'If both instances have the same CurDir
If InStr(1, s, CurDir$ & vbNullChar, vbTextCompare) = 5 Then
If AllAppsInCurrentFolder Then
'Beep
ReDim Preserve ArrayOfAppNames(UBound(ArrayOfAppNames) + 1)
ArrayOfAppNames(UBound(ArrayOfAppNames)) = fullPath
CheckCurDirInPreviousInstances = True
Else
CheckCurDirInPreviousInstances = True 'Return True
Exit Do
End If
End If
End If
End If
End If
Loop While ProcessNext(hSnapShot, pe32)
CloseHandle hSnapShot
End Function

in Module2. All decs and variables have been duplicated as required and are Private to each. Could be this is upsetting the cart but the basic model using a call from a newly created form in a test project works fine.
regards Hugh,

 

[Hypetia]

Hugh,

I did not get a chance to get online after March 7. I just read your above two posts today. Sorry for the delay.

Regarding the 4-byte issue in the Path array. I did not experience this problem when I was testing the code, though my test program was much simpler than yours. I don't find a clear explanation of this behaviour right now.

As far as multiple form issue is concerned, I thought I took care of this as well. There can be many windows belonging to a processes and only one of those window gets the pointer to the Path array.

See the following code which checks this same thing and makes sure that we are peeking at the correct window.
___
[tt]
'get its user data value
UserData = GetWindowLong(hwnd, GWL_USERDATA)
'if user data is non-zero...
If UserData Then[/tt]
___

By default, the user-data value of all windows is initialized to zero. So if a window has got its user-data value pointing to the Path array, only its user-data value is supposed to be non-zero (unless our application is using them for some other purpose, which is not the case). Therefore, the unpredictable behaviour in case of multiple forms is also hard to explain. The code is supposed to identify the correct window, holding the address of the Path array.

Just make sure, the window which holds the address to the Path array does not get destroyed during the lifetime of the application. In that case the user-data value will get reset and require a "poke" again. The address should be preferably written to the main window, which lasts for the whole application lifetime.

Problem with the shelling other apps also does not make sense.

I think I can only comment better once I reproduce these problems myself and debug them carefully.

Besides all this, I would suggest if you are having issues with the above technique, there are other, much easier alternatives.

Perhaps your application can write its CurDir value to a registry location and remove it before terminating.

Other instances can check the same location for other CurDir values and continue only if they find their CurDir value to be new and unique.

This whole scenario can be coded easily using VB's internal registry functions viz. SaveSetting, GetSetting and GetAllSettings. With a little careful coding, this method can prove to be very easy and safe.

 

[HughLerwill]

Hypetia,

Thanks for coming back. It has been some time since we talked and I have had hot fingers since. I have found that I can after all get a file based approach (dismissed in my first post) to work.

If you'd like to persue I am still interested but the 'cat has been skinned'

though my test program was much simpler than yours>
Only in the sense of the detection routine, my poking routine was identical to yours.

Kind regards and thanks again Hugh

 

[HughLerwill]

identical to yours>
Although it gave the option to disable funtionality intentionally.