Solved

Checking whether an application is running or not.

Posted on 2001-09-02
10
1,341 Views
Last Modified: 2007-12-19
Experts,
I would like to create an app that checks whether an application is running or not on Win 2K server.  For example, if you open the task manager (ctrl-alt-del) the applications tab displays a list of apps (or tasks) and their correspnding status (running or not responding).  Basically, what I'd like to do is create a VB app that accesses that information, checks for a particular application, reviews its status, and:
if it's not running, starts it
if it's not responding, ends it and restarts it
if it's running, leaves it be.

(sort of like managing services, but the apps in question doesn't run reliably as a service)

Any feedback/solutions are greatly appreciated,

tewald
0
Comment
Question by:tewald
  • 3
  • 2
  • 2
  • +3
10 Comments
 
LVL 12

Expert Comment

by:roverm
ID: 6448888
This is how to retrieve all active windows:

http://www.thescarms.com/vbasic/VBWindowFunctions.asp

You could enumerate them and start them using ShellExecuteEx and close them by using the SendMessage WM_CLOSE (both API).

Example for execute:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'Send an E-Mail to the KPD-Team
    ShellExecute Me.hwnd, vbNullString, "mailto:KPDTeam@Allapi.net", vbNullString, "C:\", SW_SHOWNORMAL
End Sub

Example for sendmessage:

'This project needs a ListBox, named List1 and a TextBox, named Text1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'Add some items to the listbox
    With List1
        .AddItem "Computer"
        .AddItem "Screen"
        .AddItem "Modem"
        .AddItem "Printer"
        .AddItem "Scanner"
        .AddItem "Sound Blaster"
        .AddItem "Keyboard"
        .AddItem "CD-Rom"
        .AddItem "Mouse"
    End With
End Sub
Private Sub Text1_Change()
    'Retrieve the item's listindex
    List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub

Both from allapi.net ;-) as you can see...

D'Mzzl!
RoverM
0
 
LVL 12

Expert Comment

by:roverm
ID: 6448892
Some more:

Here's an example of a taskmanager like NT:

http://vbaccelerator.com/codelib/taskman/taskman.htm

0
 
LVL 8

Expert Comment

by:glass_cookie
ID: 6448934
Hi!

Here's some code for you (needs 1 listbox, 1 commmand button):

'List all task list
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
Const GW_HWNDFIRST = 0
Const GW_HWNDNEXT = 2


Sub LoadTaskList()
Dim CurrWnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long

List1.Clear
CurrWnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)

While CurrWnd <> 0
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 <> Me.Caption Then
List1.AddItem TaskName
End If
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents

Wend

End Sub

Private Sub Command1_Click()
LoadTaskList
End Sub


Here's a code for terminating a proggy:

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, lParam As Any) As Long
Private Const WM_CLOSE = &H10

Private Sub Form_Click()

Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "Cannot find server - Microsoft Internet Explorer")
Debug.Print winHwnd
If winHwnd <> 0 Then
    RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
    MsgBox "Hee..."
    If RetVal = 0 Then
        MsgBox "Error posting message."
    End If
Else
    MsgBox "IE is not open."
End If

End Sub

Here's a file for you over the net:

Download...
http://www.vb-helper.com/HowTo/activate.zip
Description: Tell when an application is activated or deactivated (2K)


Here's another one:

Downoad...
http://www.vb-helper.com/HowTo/killapp.zip
Description: Kill another application (3K)

Hope these helps!




That's it!

glass cookie : )
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 2

Author Comment

by:tewald
ID: 6449075
Okay, good info so far, but ... let me attempt to clarify the requirements.  Let's say you start up a program called ProgramX.  If you hit ctrl-alt-del and check the task manager, you'll see ProgramX - Running.  Now let's say ProgramX must be running 24 hours/day.

How could you setup a VB app to automatically and periodically (eg. every 15 minutes) check whether ProgramX is running, and if it wasn't, restart it?  I know this brings up the question "how do you know if the VB app is running", but let's just assume it's a highly reliable app that runs 24/7 and ProgramX is a cruddy program that stops several times a day.

I've bumped the points up to 200 for an appropriate solution.

Thanks again,

tewald
0
 
LVL 12

Expert Comment

by:roverm
ID: 6449126
Use one of our codes and a simple timer ;-).

D'Mzzl!
RoverM
0
 
LVL 2

Accepted Solution

by:
PeteD earned 200 total points
ID: 6449156
'Assuming your unreliable program is C:\UnReliable.exe  and "Unreliable" is displayed in the task list, create another vb exe with the following code
'Add a timer control yo your form
'The option to terminate the app is incuded in the code but not used below
Option Explicit
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
Const GW_HWNDFIRST = 0, GW_HWNDNEXT = 2
Private Declare Function EnumWindows Lib "user32" (ByVal wndenmprc As Long, ByVal lParam As Long) As Long ' GetWindowText used above
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_CLOSE = &H10
Private msTarget As String
Private sTime As Date

Private Sub Form_Load()
    sTime = Now
    Timer1.Interval = 2000
    Timer1.Enabled = True
End Sub

Private Function TaskRunning(sTitle As String, Optional bTerminate As Boolean) As Boolean
    Dim lCurrWnd As Long, lLength As Long, sTaskName As String, lParent As Long
    lCurrWnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)
    While lCurrWnd <> 0
        lParent = GetParent(lCurrWnd)
        lLength = GetWindowTextLength(lCurrWnd)
        sTaskName = Space$(lLength + 1)
        lLength = GetWindowText(lCurrWnd, sTaskName, lLength + 1)
        sTaskName = Left$(sTaskName, Len(sTaskName) - 1)
        If lLength > 0 Then
            If InStr(1, UCase(sTaskName), UCase(sTitle)) <> 0 Then
                TaskRunning = True
                If bTerminate Then TerminateTask sTaskName
            End If
        End If
        lCurrWnd = GetWindow(lCurrWnd, GW_HWNDNEXT)
        DoEvents
    Wend
End Function

Private Function EnumCallback(ByVal lAppHwnd As Long, ByVal lParam As Long) As Long
    Dim sBuf As String * 256, sTitle As String, lLength As Long
    lLength = GetWindowText(lAppHwnd, sBuf, Len(sBuf)) ' Get the window's title.
    sTitle = Left$(sBuf, lLength)
    If InStr(sTitle, msTarget) <> 0 Then SendMessage lAppHwnd, WM_CLOSE, 0, 0 ' if this is the target window, kill the window.
    EnumCallback = 1 ' Continue searching.
End Function

Private Sub TerminateTask(sAppName As String)
    msTarget = sAppName
    EnumWindows AddressOf EnumCallback, 0
End Sub


Private Sub Timer1_Timer()
    If DateDiff("m", sTime, Now) >= 15 Then
        If TaskRunning("YourUnreliable") = False Then
            Shell "C:\YourUnreliable.exe", vbNormalFocus
            sTime = Now
        End If
    End If
End Sub


'If you want to check if the program is hung and end it if it is, then look at the following example from www.codearchive.com

'Processes and Threads - by Konstantin Tretyakov (kt_ee@yahoo.com)

'This project enumerates processes, running on your system
' and the threads for each process.
'What may be really interesting, is that it shows, which threads
' are "not responding" (like in task manager)

'It uses the undocumented function "IsHungThread" (User32)
'That's the trick

'If you find the code interesting to use in your projects
' I would appreciate if you give me credit

'It would be also interesting to look at your projects, made using this stuff
'You may E-mail, for instance, a link to it. I will be happy :)
'Thanx, Yours Sincerely, Konstantin Tretyakov

Option Explicit

Private Sub cmdQuit_Click()
Unload Me
End
End Sub


Private Sub Form_Load()
Dim ExeName As String
Dim lSnapShot As Long
Dim CanEnum As Long
Dim uProcess  As PROCESSENTRY32

lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> 0 Then
   lstProcss.Clear
    uProcess.lSize = Len(uProcess)
    CanEnum = Process32First(lSnapShot, uProcess)
    Do While CanEnum
        ExeName = Left(uProcess.sExeFile, InStr(1, uProcess.sExeFile, vbNullChar) - 1)
        lstProcss.AddItem ExeName
'Rather ugly and slow, but simple solution
        EnumThreads (uProcess.lProcessId)
        CanEnum = Process32Next(lSnapShot, uProcess)
    Loop
    CloseHandle (lSnapShot)
Else: MsgBox "Your system can't enumerate running processes. Please format your drive c:, reinstall the system and try again" _
          , vbExclamation, "Error"    'Scared ya? :)
End If
End Sub

Private Sub EnumThreads(ByVal PrcID As Long)
'Ctrl+C  Ctrl+V from the previous sub plus some corrections :)
Dim lSnapShot As Long
Dim CanEnum As Long
Dim uThread  As THREADENTRY32
Dim ItemToAdd As String
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0&)
If lSnapShot <> 0 Then
    uThread.lSize = Len(uThread)
    CanEnum = Thread32First(lSnapShot, uThread)
    Do While CanEnum
        If uThread.lOwnerProcessID = PrcID Then
           ItemToAdd = Chr(9) & "Thread: " & uThread.lThreadID
           If IsHungThread(uThread.lThreadID) Then ItemToAdd = ItemToAdd + " [not responding]"
           lstProcss.AddItem ItemToAdd
        End If
        CanEnum = Thread32Next(lSnapShot, uThread)
    Loop
    CloseHandle (lSnapShot)
End If
End Sub

0
 
LVL 38

Expert Comment

by:PaulHews
ID: 6449159
Use this code with a timer:

Determine if an Application has Stopped Responding

See if an application is hung or has stopped responding then kill it if is has.
 
http://www.thescarms.com/vbasic/AppResponse.asp
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6449343
hearing...
0
 
LVL 8

Expert Comment

by:glass_cookie
ID: 6449488
Hee hee heee... everybody's talking about timers...

Here's one file to check whether a proggy is responding or not:

Download...
http://www.planetsourcecode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=4925&strZipAccessCode=ODE%5F49259121
Descrtipion: This project enumerates processes, running on your system and the threads for each process. What may be REALLY INTERESTING, is that it shows, which threads are "not responding" (like in task manager)

Here's another method:

Dim i as Integer

Private Sub Timer1_Timer()

If i = 15 Then
'Use code for checking
i = 0
Else
i = i + 1
End If
End Sub
0
 
LVL 2

Author Comment

by:tewald
ID: 6463063
All, thanks for the help.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Problem to skip loop 6 64
VBA error replacing data 6 40
Using "ScreenUpdating" 6 73
checkbox to hide entire section 10 42
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

838 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question