Detect if an application is running AND kill its processes

[sebmaurice]

Can I have this function for Windows NT family (NT 4, W2K, XP) ?
Thank you very much in advance for your help.


'Function for Windows 9x to kill an exe file :

API declarations

(...)

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 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

[frundatz]

I have example code to see if a process is running, it would be fairly easy to kill it as well but I don't have example code on that.

API Declarations:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

In your function:

Dim CurrWnd As Long, Length As Long, TaskName As String, Parent As Long
Dim bFoundMngr As Boolean, CurrDesktop As Long

CurrDesktop = GetDesktopWindow()
CurrWnd = GetWindow(CurrDesktop, GW_CHILD)

bFoundMngr = False
Do While CurrWnd <> 0 And bFoundMngr = False
Parent = GetParent(CurrWnd)
Length = GetWindowTextLength(CurrWnd)
TaskName = Space(Length + 1)
Length = GetWindowText(CurrWnd, TaskName, Length + 1)
TaskName = Left(TaskName, Len(TaskName) - 1)

If Length > 0 Then
If TaskName = "<Put your process name here>" Then
Debug.Print TaskName
bFoundMngr = True
End If
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Loop

If bFoundMngr = False Then
' Did not find your process running
Else
' Did find process running, add code to kill it
End If

For the code to kill the process, I'm not sure which API to call. I did a :

dumpbin /exports user32.dll

And would guess something like DestroyWindow would be appropriate.

Good luck.

[Nucleus]

http://www.vbforums.com/showthread.p...612#post481612

[sebmaurice]

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


'Code wrote by Serge DYMKOV.

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


'Matthew Gates wrote this function (KillApp) and said this doesn't work with Windows NT.
'Can I have this function for Windows NT, Windows 2000, Windows XP ?

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


Thank you very much for your help !