Detect if an application is running AND kill its processes

[sebmaurice]

Hello

I think Serge DYMKOV'S function is a good work !

I want to detect if an application is running (thanks to his function) and if it's true, to close it (kill all its processes) ! But I don't know how to do this.

For example :
I don't want an execution of an Internet Browser software. So I want to detect if, for example, Internet Explorer (thanks to its path and file names "C:\Program Files\Internet Explorer\iexplore.exe") is running. If it is true, the function must close the application (kill all IE processes).


Thank you very much in advance for your answer.

PS : I've got VB 5 Professionnal.

[csammis]

So far as I know, you can only kill a process that you (that is, your program) started. I don't think (someone correct me if I'm wrong!) that you can kill just any process.

[Matthew Gates]

Try this (code does not work for WinNT):

Private Declare Function ProcessFirst _
Lib "kernel32" Alias "Process32First" (ByVal hSnapshot _
As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Private Declare Function CreateToolhelpSnapshot _
Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal _
lFlags As Long, lProcessID As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject 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 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


Private Const MAX_PATH = 260


Private Function KillApp(myName As String) As Boolean
    Const PROCESS_ALL_ACCESS = 0
    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
    On Local Error GoTo Finish
    appCount = 0
    
    Const TH32CS_SNAPPROCESS As Long = 2&
    
    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    rProcessFound = ProcessFirst(hSnapshot, uProcess)
    
    Do While rProcessFound
        i = InStr(1, uProcess.szexeFile, Chr(0))
        szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
        If Right$(szExename, Len(myName)) = LCase$(myName) Then
            KillApp = True
            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

    Call CloseHandle(hSnapshot)
Finish:
End Function


Usage

Call KillApp("C:\Program Files\Internet Explorer\iexplore.exe")

[Megatron]

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const WM_CLOSE = &H10
Private Const WM_QUIT = &H12

Private Sub Command1_Click()
    
    Dim hApp As Long
    hApp = FindWindowEx(0, 0, "IEFrame", vbNullString)
    If hApp <> 0 Then
        PostMessage hApp, WM_CLOSE, 0, 0
        DestroyWindow hApp
        PostMessage hApp, WM_QUIT, 0, 0
    End If
    
End Sub

[Nucleus]

Try this too, which kills all instances of an application:
Option Explicit

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

Private Declare Function PostMessage Lib "user32" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_CLOSE = &H10

Private Sub Command1_Click()
 Call CloseApplication("ieframe") 'closes IE explorer
End Sub

Sub CloseApplication(ByVal sClassName$)
 Dim happ As Long
 Do
    happ = FindWindow(sClassName, vbNullString)
    If happ = 0 Then Exit Do
    PostMessage happ, WM_CLOSE, 0, 0
 Loop
End Function

I am not sure why you need destroy window or wm_quit message.

[Tygur]

Megatron,
What do you expect DestroyWindow to do?
It doesn't do anything to windows that aren't part of your app.

[Megatron]

Then send the WM_DESTROY and WM_NCDESTROY messages instead.

[Megatron]

Originally posted by Nucleus
I am not sure why you need destroy window or wm_quit message.

WM_DESTROY sends frees up the resources. The WM_CLOSE message might also trigger, but it's safe practice to do this incase it doesn't. WM_QUIT ends the actual thread. If you just used WM_CLOSE, it would close the window, but leave the thread running.

Also, you can fix up this routine with the use of While or Unitl.

Sub CloseApplication(ByVal sClassName As String)
 Dim happ As Long
 Do Until hApp = 0
    happ = FindWindow(sClassName, vbNullString)
    PostMessage happ, WM_CLOSE, 0, 0
    PostMessage happ, WM_DESTROY, 0, 0
    PostMessage happ, WM_NCDESTROY, 0, 0
    PostMessage happ, WM_QUIT, 0, 0
 Loop
End Function

[Nucleus]

Megatron your code doesn't work

Also, you can fix up this routine with the use of While or Unitl.

Nope, it needs to be like that, which is why your code failed.


If you want to incorporate wm_close,destroy and quit then this will work:

Sub CloseApplication(ByVal sClassName$)
 Dim happ As Long
 Do
    happ = FindWindow(sClassName, vbNullString)
    If happ = 0 Then Exit Do

    PostMessage happ, WM_CLOSE, 0, 0
    PostMessage happ, WM_DESTROY, 0, 0
    PostMessage happ, WM_NCDESTROY, 0, 0
    PostMessage happ, WM_QUIT, 0, 0
 Loop
End Sub

[Megatron]

No it doesn't need to be built like that. If it did then why do we have the option of using While or Until in our loops?? To make our code cleaner:

Add this to a Form with a button.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
Private Const WM_DESTROY = &H2
Private Const WM_NCDESTROY = &H82
Private Const WM_QUIT = &H12

Sub CloseApplication(ByVal sClassName As String)
 Dim happ As Long
 
 happ = FindWindow(sClassName, vbNullString)
 
 Do While happ <> 0
    happ = FindWindow(sClassName, vbNullString)
    PostMessage happ, WM_CLOSE, 0, 0
    PostMessage happ, WM_DESTROY, 0, 0
    PostMessage happ, WM_NCDESTROY, 0, 0
    PostMessage happ, WM_QUIT, 0, 0
 Loop
 
End Sub

Private Sub Command1_Click()
    CloseApplication "SciCalc"
End Sub

[Nucleus]

That works too Megatron .

If you don't need the ability to exit the loop you could also use while wend structure too.

Sub CloseApplication(ByVal sClassName As String)
 Dim happ As Long
 
 happ = FindWindow(sClassName, vbNullString)
 
 While happ
    PostMessage happ, WM_CLOSE, 0, 0
    PostMessage happ, WM_DESTROY, 0, 0
    PostMessage happ, WM_NCDESTROY, 0, 0
    PostMessage happ, WM_QUIT, 0, 0
    happ = FindWindow(sClassName, vbNullString)
 Wend
 
End Sub

[Megatron]

Yes, that will work, but, (I'm not saying it's wrong to use Wend), it's good practice to stick with the current up-to-date version (in this case, it's Do).
Again, nothing wrong with it. It's just like using _hwrite and _hread instead of ReadFileEx and WriteFileEx. Both do (for the most part) the same job, but _hread and _hwrite have both been superseded by ReadFileEx and WriteFileEx.

[sebmaurice]

Thank you Serge and Matthew.

This is I want (example for Internet Explorer) :

MODULE

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Declare Function Process32First Lib "kernel32" ( _
ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Public Declare Function Process32Next Lib "kernel32" ( _
ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Public Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long

Public Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, _
ByVal strModuleName As String, ByVal nSize As Long) As Long

Public Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, _
ByVal cb As Long, ByRef cbNeeded As Long) As Long

Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

Public Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

Private Declare Function ProcessFirst _
Lib "kernel32" Alias "Process32First" (ByVal hSnapshot _
As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Private Declare Function CreateToolhelpSnapshot _
Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal _
lFlags As Long, lProcessID As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject 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

Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0

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 * MAX_PATH
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long '1 = Windows 95.
'2 = Windows NT

szCSDVersion As String * 128
End Type

Public Enum ePlatform
eWin95_98 = 1
eWinNT = 2
End Enum

Public gDBType As String
Public Function IsApplicationRunning(pEXEName As String) As Boolean

On Error Resume Next

Select Case getVersion()
Case eWin95_98
Dim lProc As Long, strName As String
Dim hSnap As Long, proc As PROCESSENTRY32

hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnap = hNull Then Exit Function
proc.dwSize = Len(proc)
' Iterate through the processes
lProc = Process32First(hSnap, proc)
Do While lProc
strName = StrZToStr(proc.szexeFile)
If InStr(UCase(strName), UCase(pEXEName)) Then
IsApplicationRunning = True
Exit Function
End If
lProc = Process32Next(hSnap, proc)
Loop
Case eWinNT
Dim Result As String
Result = MsgBox("The KillApp function doesn't work on Windows NT", vbExclamation, "Windows NT")
End Select
End Function
Function StrZToStr(pString As String) As String
StrZToStr = Left$(pString, Len(pString) - 1)
End Function
Public Function getVersion() As ePlatform
Dim osinfo As OSVERSIONINFO
Dim lRetVal As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
lRetVal = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId
End Function
Public Function KillApp(myName As String) As Boolean
Const PROCESS_ALL_ACCESS = 0
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
On Local Error GoTo Finish
appCount = 0

Const TH32CS_SNAPPROCESS As Long = 2&

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)

Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
KillApp = True
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

Call CloseHandle(hSnapshot)
Finish:
End Function


BUTTON

Private Sub Command1_Click()
Dim App As String
App = "C:\Program Files\Internet Explorer\iexplore.exe"
If IsApplicationRunning(App) Then
Call KillApp(App)
Else
MsgBox "Application is not running !"
End If
End Sub

[sebmaurice]

Thank you Serge and Matthew.

This is I want (example for Internet Explorer) :

MODULE

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Declare Function Process32First Lib "kernel32" ( _
ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Public Declare Function Process32Next Lib "kernel32" ( _
ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Public Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long

Public Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, _
ByVal strModuleName As String, ByVal nSize As Long) As Long

Public Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, _
ByVal cb As Long, ByRef cbNeeded As Long) As Long

Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

Public Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

Private Declare Function ProcessFirst _
Lib "kernel32" Alias "Process32First" (ByVal hSnapshot _
As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Private Declare Function CreateToolhelpSnapshot _
Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal _
lFlags As Long, lProcessID As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject 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

Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0

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 * MAX_PATH
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long '1 = Windows 95.
'2 = Windows NT

szCSDVersion As String * 128
End Type

Public Enum ePlatform
eWin95_98 = 1
eWinNT = 2
End Enum

Public gDBType As String

Public Function IsApplicationRunning(pEXEName As String) As Boolean

On Error Resume Next

Select Case getVersion()
Case eWin95_98
Dim lProc As Long, strName As String
Dim hSnap As Long, proc As PROCESSENTRY32

hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnap = hNull Then Exit Function
proc.dwSize = Len(proc)
' Iterate through the processes
lProc = Process32First(hSnap, proc)
Do While lProc
strName = StrZToStr(proc.szexeFile)
If InStr(UCase(strName), UCase(pEXEName)) Then
IsApplicationRunning = True
Exit Function
End If
lProc = Process32Next(hSnap, proc)
Loop
Case eWinNT
Dim Result As String
Result = MsgBox("The KillApp function doesn't work on Windows NT", vbExclamation, "Windows NT")
End Select
End Function

Function StrZToStr(pString As String) As String
StrZToStr = Left$(pString, Len(pString) - 1)
End Function

Public Function getVersion() As ePlatform
Dim osinfo As OSVERSIONINFO
Dim lRetVal As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
lRetVal = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId
End Function

Public Function KillApp(myName As String) As Boolean
Const PROCESS_ALL_ACCESS = 0
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
On Local Error GoTo Finish
appCount = 0

Const TH32CS_SNAPPROCESS As Long = 2&

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)

Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
KillApp = True
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

Call CloseHandle(hSnapshot)
Finish:
End Function


BUTTON

Private Sub Command1_Click()
Dim App As String
App = "C:\Program Files\Internet Explorer\iexplore.exe"
If IsApplicationRunning(App) Then
Call KillApp(App)
Else
MsgBox "Application is not running !"
End If
End Sub