End Process from Task Manager using VB 6 Code - vb6

I need to kill an application roughly so I can get phantom subscriber of that application in my database (this can not be produced by closing the application). Manually, if we kill the application from Task Manager, the phantom subscriber will be exist. Now I need to do it automatically in VB 6 code. Help! Thanks.

There are two ways:
Send WM_CLOSE to the target application if it has a window (hidden/visible). Task Manager's "End Task" uses this method. Most of the applications handle WM_CLOSE and terminate gracefully.
Use TerminateProcess API to kill forcefully - Task Manager's "End Process" uses this method. This API forcefully kills the process.
An example can be found here:
VB Helper: HowTo: Terminate a process immediately

Use vb6.0 TaskKill
Private Sub Command1_Click()
Shell "taskkill.exe /f /t /im Application.exe"
End Sub

Call ShellExecute with the TaskKill command
TASKKILL [/S system [/U username [/P
[password]]]]
{ [/FI filter] [/PID processid | /IM imagename] } [/T] [/F]
Description:
This tool is used to terminate tasks by process id (PID) or image
name.

Shell "taskkill.exe /f /t /im processname.exe"
This forces (/f) the terminatation of the process with the image name (/im) of processname.exe, and any child processes which were started by it (/t). You may not need all these switches. See the taskkill command help for more information (type the following at the command line):
taskkill/?

Karl Peterson's excellent archive of VB6 code has high quality sample code and full explanations using both WM_CLOSE and TerminateProcess. Accept no substitutes!
One pitfall you might see in a lot of code out there is that sending WM_CLOSE to a single window handle you have isn't sufficient - most applications comprise numerous windows. The answer as implemented in Karl's code: Find all the top-level windows belonging to this application and send the message to each.

Option Explicit
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Target As String
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:03
' Created By : Jason Bruwer
' Purpose : Returns the windows handle of a window if you know the name
' : E.g.
' Microsoft Word
' Microsoft Excel
' Microsoft PowerPoint
' Adobe Reader
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function GetWindowsHandle(WindowName As String, hWindow As Long) As Boolean
On Error GoTo Errors
' Get the target's window handle.
hWindow = FindWindow(vbNullString, WindowName)
If hWindow = 0 Then GoTo Cheers
GetWindowsHandle = True
Cheers:
Exit Function
Errors:
frmMain.LogErrorAcrossUsingRBT ("GetWindowsHandle")
GoTo Cheers
End Function
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:03
' Created By : Jason Bruwer
' Purpose : Enumerates all the currently open windows and searches for an application
' with the specified name.
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function TerminateTask(app_name As String) As Boolean
On Error GoTo Errors
Target = UCase(app_name)
EnumWindows AddressOf EnumCallback, 0
TerminateTask = True
Cheers:
Exit Function
Errors:
frmMain.LogErrorAcrossUsingRBT ("TerminateTask")
GoTo Cheers
End Function
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:04
' Created By : Jason Bruwer
' Purpose : Checks to see if this is the window we are looking for and then trys
' to kill the application
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long
Dim buf As String * 256
Dim title As String
Dim length As Long
' Get the window's title.
length = GetWindowText(app_hWnd, buf, Len(buf))
title = Left$(buf, length)
'If title <> "" Then Debug.Print title
' See if this is the target window.
If InStr(UCase(title), Target) <> 0 Then
' Kill the window.
If Not KillProcess(app_hWnd) Then Exit Function
End If
' Continue searching.
EnumCallback = 1
End Function
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:06
' Created By : Jason Bruwer
' Purpose : Trys to kill an application by using its windows handle
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function KillProcess(hWindow As Long) As Boolean
Dim RetrunValue As Long
Dim ProcessValue As Long
Dim ProcessValueID As Long
Dim ThreadID As Long
On Error GoTo Errors
If (IsWindow(hWindow) <> 0) Then
ThreadID = GetWindowThreadProcessId(hWindow, ProcessValueID)
If (ProcessValueID <> 0) Then
App.LogEvent "Warning...killing orphan process..."
ProcessValue = OpenProcess(PROCESS_ALL_ACCESS, CLng(0), ProcessValueID)
RetrunValue = TerminateProcess(ProcessValue, CLng(0))
CloseHandle ProcessValueID
End If
End If
KillProcess = True
Cheers:
Exit Function
Errors:
frmMain.LogErrorAcrossUsingRBT ("KillProcess")
GoTo Cheers
End Function

Here is my code in vb6 to kill process by name
It works for me
Private Sub TerminateProcess(ProcessName As String)
Dim Process As Object
For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & ProcessName & "'")
Process.Terminate
Next
End Sub

Doing this through VB6 Internal ways ...
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Sub KillProcess(ByVal processName As String)
Set oWMI = GetObject("winmgmts:")
Set oServices = oWMI.InstancesOf("win32_process")
For Each oService In oServices
servicename = LCase(Trim(CStr(oService.Name) & ""))
If InStr(1, servicename, LCase(processName), vbTextCompare) > 0 Then
oService.Terminate
End If
Next
End Sub
...and just use it as follow:
killProcess("notepad.exe")
Second option: [ by SHELL external ways... ]
Shell "taskkill.exe /f /t /im notepad.exe"

Related

Wait for shelled process and all child processes

Apologies is this has already been answered, I cannot find it. I have a requirement to launch an external process from a vb6 app and wait for that process to finish before continuing. Simple enough. However the process I need to launch in turn launches a child process then exits. I need to wait for the child process to complete (and and other child processes)
Existing code:
Private Const WAIT_INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Sub ShellProcess(strProcess As String, Optional blnWait As Boolean = False)
Dim hProc As Long
Dim taskId As Long
Dim cmdline As String
cmdline = strProcess
taskId = Shell(cmdline, vbNormalFocus)
If blnWait = True Then
hProc = OpenProcess(SYNCHRONIZE, True, taskId)
Call WaitForSingleObject(hProc, WAIT_INFINITE)
CloseHandle hProc
End If
MsgBox "The shelled app has ended."
End Sub
I have managed to do this in c# sometime ago but now have only vb6 to work with.

How to auto close VBScript thousands of MsgBox's

I have a rogue vbscript that went a little crazy tracing output and now I have thousands of message boxes to close. I can hold down the Enter key and close lots of them but that still takes several minutes. I could reboot but then I have to open all my apps again. Is there a quick way to auto close all the message boxes. I tried looking in task manager but it appears that the process that spawned the boxes has long sinced finished. Any ideas?
Not sure how you can have orphaned msgbox windows, you should still have cscript.exe or wscript.exe in your running processes list. The following should terminate the underlying process and close your msgboxes:
strComputer = "."
strProcessToKill = "wscript.exe"
SET objWMIService = GETOBJECT("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
SET colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '" & strProcessToKill & "'")
FOR EACH objProcess in colProcess
objProcess.Terminate()
NEXT
Obviously, change wscript.exe. to cscript.exe if that's what you're using.
Always start your vbscript with cscript.exe instead of wscript.exe. cscript outputs to the console, not the GUI. Alternatively, you could use an application such as Push The Freakin' Button to automate the button clicks.
If you're using explicit MsgBox calls, then using cscript won't help you. To use cscript as a solution, you would need to change MsgBox to Wscript.Echo calls.
This wont help your immediate problem, but you may want to change your default script host to Cscript, which will prevent this problem in the future. See: this technet article.
Public Class Form1
Private m_Title As String
'Windows API
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hWnd As Int32, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As Int32) As Int32
Declare Function SendMessage Lib "USER32" _
Alias "SendMessageA" (ByVal hWnd As Int32, _
ByVal Msg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As Int32) As Int32
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Int32
Private Const WM_CLOSE As Int32 = &H10
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Button1.Click
m_Title = "Auto Close Msg"
Me.Timer1.Interval = 2000 'timer1 placed on form
Me.Timer1.Start()
MsgBox("Auto close in 2 seconds", MsgBoxStyle.OkOnly, m_Title)
End Sub
Private Sub CloseMSGBOX()
'Use Windows API to find and close the message box
'
'http://msdn.microsoft.com/en-us/library/…
'#32770 The class for a dialog box.
'http://msdn.microsoft.com/en-us/library/…
'
'http://msdn.microsoft.com/en-us/library/…
'
Dim hWnd, retval As Int32
Dim WinTitle As String
WinTitle = m_Title '<- Title of Window
hWnd = FindWindow("#32770", WinTitle) 'Get the msgBox handle
retval = PostMessage(hWnd, WM_CLOSE, 0, 0) ' Close the msgBox
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Timer1.Tick
CloseMSGBOX()
End Sub
End Class
I found this code here
To close all the windows and stop all processes in one go, why not just open a command prompt window and type:
TASKKILL /F /IM cmd.exe /T
or
TASKKILL /F /IM wscript.exe /T
This will immediately terminate all cmd.exe or wscript.exe processes... If it has to be within a script, you can call it like WshShell.Run "TASKKILL /F /IM cmd.exe /T"
This is much more simpler and efficient...

How to wait for a shell process to finish before executing further code in VB6

I have a small VB6 app in which I use the Shell command to execute a program. I am storing the output of the program in a file. I am then reading this file and putting the output on the screen using a msgbox in VB6.
This is what my code looks like now:
sCommand = "\evaluate.exe<test.txt "
Shell ("cmd.exe /c" & App.Path & sCommand)
MsgBox Text2String(App.Path & "\experiments\" & genname & "\freq")
The problem is that the output which the VB program is printing using the msgbox is the old state of the file. Is there some way to hold the execution of the VB code until my shell command program finishes so that I get the correct state of the output file and not a previous state?
The secret sauce needed to do this is the WaitForSingleObject function, which blocks execution of your application's process until the specified process completes (or times out). It's part of the Windows API, easily called from a VB 6 application after adding the appropriate declaration to your code.
That declaration would look something like this:
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
It takes two parameters: a handle to the process that you want to wait on, and the time-out interval (in milliseconds) that indicates the maximum amount of time that you want to wait. If you do not specify a time-out interval (a value of zero), the function does not wait and returns immediately. If you specify an infinite time-out interval, the function returns only when the process signals that it has completed.
Armed with that knowledge, the only task that remains is figuring out how to get a handle to the process that you started. That turns out to be pretty simple, and can be accomplished a number of different ways:
One possibility (and the way I'd do it) is by using the ShellExecuteEx function, also from the Windows API, as a drop-in replacement for the Shell function that is built into VB 6. This version is far more versatile and powerful, yet just as easily called using the appropriate declaration.
It returns a handle to the process that it creates. All you have to do is pass that handle to the WaitForSingleObject function as the hHandle parameter, and you're in business. Execution of your application will be blocked (suspended) until the process that you've called terminates.
Another possibility is to use the CreateProcess function (once again, from the Windows API). This function creates a new process and its primary thread in the same security context as the calling process (i.e., your VB 6 application).
Microsoft has published a knowledge base article detailing this approach that even provides a complete sample implementation. You can find that article here: How To Use a 32-Bit Application to Determine When a Shelled Process Ends.
Finally, perhaps the simplest approach yet is to take advantage of the fact that the built-in Shell function's return value is an application task ID. This is a unique number that identifies the program you started, and it can be passed to the OpenProcess function to obtain a process handle that can be passed to the WaitForSingleObject function.
However, the simplicity of this approach does come at a cost. A very significant disadvantage is that it will cause your VB 6 application to become completely unresponsive. Because it will not be processing Windows messages, it will not respond to user interaction or even redraw the screen.
The good folks over at VBnet have made complete sample code available in the following article: WaitForSingleObject: Determine when a Shelled App has Ended.
I'd love to be able to reproduce the code here to help stave off link rot (VB 6 is getting up there in years now; there's no guarantee that these resources will be around forever), but the distribution license in the code itself appears to explicitly forbid that.
There is no need to resort to the extra effort of calling CreateProcess(), etc. This more or less duplicates the old Randy Birch code though it wasn't based on his example. There are only so many ways to skin a cat.
Here we have a prepackaged Function for handy use, which also returns the exit code. Drop it into a static (.BAS) module or include it inline in a Form or Class.
Option Explicit
Private Const INFINITE = &HFFFFFFFF&
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Public Function ShellSync( _
ByVal PathName As String, _
ByVal WindowStyle As VbAppWinStyle) As Long
'Shell and wait. Return exit code result, raise an
'exception on any error.
Dim lngPid As Long
Dim lngHandle As Long
Dim lngExitCode As Long
lngPid = Shell(PathName, WindowStyle)
If lngPid <> 0 Then
lngHandle = OpenProcess(SYNCHRONIZE _
Or PROCESS_QUERY_INFORMATION, 0, lngPid)
If lngHandle <> 0 Then
WaitForSingleObject lngHandle, INFINITE
If GetExitCodeProcess(lngHandle, lngExitCode) <> 0 Then
ShellSync = lngExitCode
CloseHandle lngHandle
Else
CloseHandle lngHandle
Err.Raise &H8004AA00, "ShellSync", _
"Failed to retrieve exit code, error " _
& CStr(Err.LastDllError)
End If
Else
Err.Raise &H8004AA01, "ShellSync", _
"Failed to open child process"
End If
Else
Err.Raise &H8004AA02, "ShellSync", _
"Failed to Shell child process"
End If
End Function
I know it's an old thread, but...
How about using the Windows Script Host's Run method? It has a bWaitOnReturn parameter.
object.Run (strCommand, [intWindowStyle], [bWaitOnReturn])
Set oShell = CreateObject("WSCript.shell")
oShell.run "cmd /C " & App.Path & sCommand, 0, True
intWindowStyle = 0, so cmd will be hidden
Do like this :
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
Sub Form_Click()
Dim retval As Long
retval = ExecCmd("notepad.exe")
MsgBox "Process Finished, Exit Code " & retval
End Sub
Reference : http://support.microsoft.com/kb/129796
Great code. Just one tiny little problem: you must declare in the ExecCmd (after Dim start As STARTUPINFO):
Dim ret as Long
You will get an error when trying to compile in VB6 if you don't.
But it works great :)
Kind regards
In my hands, the csaba solution hangs with intWindowStyle = 0, and never passes control back to VB. The only way out is to end process in taskmanager.
Setting intWindowStyle = 3 and closing the window manually passes control back
I've found a better & simpler solution:
Dim processID = Shell("C:/path/to/process.exe " + args
Dim p As Process = Process.GetProcessById(processID)
p.WaitForExit()
and then you just continue with your code.
Hope it helps ;-)

In Vb How TO Send Terminate message To other running Process?

I want to send Close Messge To Other Running Process
For that i have the name of that process
Not Process ID
Assuming you're using VB 6 (because you didn't specify .NET), you could the following code:
''#Module-level WinAPI Declarations
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private 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 * 260
End Type
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
''#Public function to actually kill a process, given its name
Public Sub KillProcess(ByVal ProcessName As String)
Dim uProcess As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExeName As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
If LenB(ProcessName) <> 0 Then
AppCount = 0
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
RProcessFound = ProcessFirst(hSnapshot, uProcess)
Do
i = InStr(1, uProcess.szexeFile, Chr(0))
SzExeName = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(SzExeName, Len(ProcessName)) = LCase$(ProcessName) Then
AppCount = AppCount + 1
MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
AppKill = TerminateProcess(MyProcess, ExitCode)
Call CloseHandle(MyProcess)
End If
RProcessFound = ProcessNext(hSnapshot, uProcess)
Loop While RProcessFound
Call CloseHandle(hSnapshot)
End If
End Sub
Basically what this code does is enumerate all currently running processes in order to find the one you want to kill. The CreateToolHelpSnapshot API function returns a snapshot of the processes, and then we loop through this snapshot with the Process32First and Process32Next functions. When it finds a match to the name you specified, it uses the TerminateProcess function to terminate that process and all of its threads. Note that this is untested on post-XP versions of Windows.
If you speak Win32 fluently, see the following MSDN article: Taking a Snapshot and Viewing Processes
Lots of the examples you find on the Internet (i.e., option one, option two) use EnumWindows to send a WM_CLOSE message to the windows associated with a particular process. The advantage of this is that it asks nicely—sending the WM_CLOSE message gives the process a chance to save any data and exit gracefully. TerminateProcess, as used in the above example, is not so nice—it's an instant buzz-kill. But it will allow you to end processes that don't own any windows. You didn't mention if this was a requirement in the question.
(Honestly, there isn't enough detail in the question for me to have any business trying to answer this question, but I'm procrastinating. If you need anything else, please edit your question to include more details and add a comment to let me know...)

App.PrevInstance not refreshing itself

I am trying to check to see whether another instance of the application is already running. If it does, I want to keep on checking for another 15 seconds or so before going on...
if App.PrevInstance then
dim dtStart as date
dtStart = now
do while datediff("s", dtStart, Now) < 15
Sleep 1000 ' sleep for a second
if not App.PrevInstance then exit do
loop
end if
The problem is App.PrevInstance does not seem to refresh itself. it keeps the initial value no matter what.
Is there another way to approach this? Perhaps with API calls. Note that the application may or may not have a window, thus I can't check for an existence of a window with a certain caption.
You might want to give this a look: http://www.codeguru.com/forum/showthread.php?t=293730
I use the following class:
'--------------------------------------------------------------------------------------- ' Module : CApplicationSingleton ' DateTime : 24/03/2006 15:16 ' Author : Fernando ' Purpose : Enforces a single instance of an application. Uses a Mutex ' see http://www.codeguru.com/forum/showthread.php?s=&threadid=293730 ' http://www.codeguru.com/Cpp/W-P/system/processesmodules/article.php/c5745/ ' Copyright © 2001-2007 AGBO Business Architecture S.L. '---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Const ERROR_ALREADY_EXISTS = 183&
Private m_hMutex As Long Private m_lLastDllError As Long
Private Sub Class_Initialize() '
On Error GoTo errorBlock
'
Dim s As SECURITY_ATTRIBUTES
m_hMutex = CreateMutex(s, 0, rcString(8700)) m_lLastDllError = Err.LastDllError
'
exitBlock:
Exit Sub
errorBlock:
Call GError.handleError(Err.Number, Err.Description, Erl, "CApplicationSingleton", "Class_Initialize", GApp.copyDebugFiles())
Resume exitBlock
' End Sub
Private Sub Class_Terminate() On Error GoTo errorBlock
If m_hMutex > 0 Then
Call CloseHandle(m_hMutex) End If
exitBlock:
Exit Sub
errorBlock:
Call GError.handleError(Err.Number, Err.Description, Erl, "CApplicationSingleton.cls", "Class_Terminate")
Resume exitBlock
End Sub
Public Function IsAnotherInstanceRunning() As Boolean '
On Error GoTo errorBlock
'
IsAnotherInstanceRunning = (m_lLastDllError = ERROR_ALREADY_EXISTS)
'
exitBlock:
Exit Function
errorBlock:
Call GError.handleError(Err.Number, Err.Description, Erl, "CApplicationSingleton", "IsAnotherInstanceRunning", GApp.copyDebugFiles())
Resume exitBlock
' End Function
I used the Mutex class to work out the same issue with starting the same app multiple times. It appeared to be working then stopped working returning a false positive. What I found is that the vb6 IDE was also holding a mutex while the IDE was still open.
You've gotta use the code and compile it. The EXE will work fine after you close the IDE.. Who knew? Drove me crazy(ier) for a few minutes..
I'll post a sample if anyone wants it.

Resources