Solved

Checking whether an application is running or not.

Posted on 2001-09-02
10
1,306 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 2

Author Comment

by:tewald
Comment Utility
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
Comment Utility
Use one of our codes and a simple timer ;-).

D'Mzzl!
RoverM
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 2

Accepted Solution

by:
PeteD earned 200 total points
Comment Utility
'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
Comment Utility
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
Comment Utility
hearing...
0
 
LVL 8

Expert Comment

by:glass_cookie
Comment Utility
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
Comment Utility
All, thanks for the help.
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

762 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now