Problems W/ Task Manager saying my program is not responding

[Drew A]

I have a very long routine that is copying files over to a remote machine through the serial port. During this routine Task Manager is showing my program as Not Responding. Also some of my labels that are showing the status stop showing anything. Any Ideas would be helpful, Thanks.

[Iouri]

I experienced before that when I am running a long program the task manager shows that the program is not responding. You cannot trust it. It might be true or might not. To make sure that your program is responding include something that changes on your form from time to time. It can be a blinking light or progress bar or whatever you can come up with.

Here is the code that can check if application stopped responding


This example illustrates how to determine if an application is hung or has stopped responding. There is no
clear definition of an application hanging. Typically the application is busy processing. But from a user's
standpoint it has stopped responding.

Using the SendMessageTimeout function you can see if the target application is responding. Then you can
terminate it if it is not.



'module
'======
Public oIE As Object
Public lPid As Long
Public lHwnd As Long

Public Const SMTO_BLOCK = &H1
Public Const SMTO_ABORTIFHUNG = &H2
Public Const WM_NULL = &H0
Public Const WM_CLOSE = &H10
Public Const PROCESS_ALL_ACCESS = &H1F0FFF

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function SendMessageTimeout Lib "user32" _
Alias "SendMessageTimeoutA" (ByVal hwnd As Long, _
ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, _
ByVal fuFlags As Long, ByVal uTimeout As Long, _
pdwResult As Long) As Long

Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long

Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long

Public Function fEnumWindowsCallBack(ByVal hwnd As Long, ByVal lpData As Long) As Long
Dim lThreadId As Long
Dim lProcessId As Long
'
' This callback function is called by Windows (from the EnumWindows
' API call) for EVERY window that exists until fEnumWindowsCallBack
' is set False.
'
fEnumWindowsCallBack = 1

lThreadId = GetWindowThreadProcessId(hwnd, lProcessId)
If lProcessId = lPid Then
lHwnd = hwnd
fEnumWindowsCallBack = 0
End If
End Function

Public Function fEnumWindows() As Boolean
Dim hwnd As Long
'
' The EnumWindows function enumerates all top-level windows
' on the screen by passing the handle of each window, in turn,
' to an application-defined callback function. EnumWindows
' continues until the last top-level window is enumerated or
' the callback function returns FALSE.
'
Call EnumWindows(AddressOf fEnumWindowsCallBack, hwnd)
End Function


'form
'====
Private Sub cmdCheck_Click()'check the status if app is responding
Dim lResult As Long
Dim lReturn As Long
'
' If no app started, get out.
'
If lHwnd = 0 Then Exit Sub
'
' Check the status of the application specifying
' a timeout period of 1 second (1000 miliseconds).
'
' SMTO_ABORTIFHUNG Returns without waiting for the
' time-out period to elapse if the receiving
' process appears to be in a "hung" state.
'
' SMTO_BLOCK Prevents the calling thread from processing
' any other requests until the function returns.
'
lReturn = SendMessageTimeout(lHwnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lResult)

If lReturn Then
MsgBox "Responding", vbInformation, "Application Status"
Else
MsgBox "Not Responding", vbInformation, "Application Status"
End If
End Sub


Private Sub cmdQuit_Click()
Unload Me
End Sub

Private Sub cmdStart_Click()'2 opt - internet or other app

If optApp(1) And Trim$(txtpath) = "" Then
MsgBox "Enter a path to the application to start.", vbExclamation, "Missing or Invalid Path"
Exit Sub
End If
'
' Start Internet Explorer or the specified application.
'
If optApp(0) Then
'
' Start Explorer.
'
Set oIE = Nothing
Set oIE = CreateObject("InternetExplorer.application")
oIE.Visible = True
oIE.navigate2 "http://www.yahoo.com"
lHwnd = oIE.hwnd
Else
'
' The the specified application and get
' its window handle based on its process ID.
'
lPid = Shell(txtpath, vbNormalFocus)
Call fEnumWindows
End If
End Sub


Private Sub cmdStop_Click()'kill application
Dim lPid As Long
Dim lReturn As Long
Dim lProcess As Long
'
' If no app started, get out.
'
If lHwnd = 0 Then Exit Sub
'
' Get the process ID for the application
' from its window handle.
'
lReturn = GetWindowThreadProcessId(lHwnd, lPid)
'
' Terminate the application unconditionally.
'
lProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPid)
lReturn = TerminateProcess(lProcess, 0&)
End Sub


Private Sub Form_Load()
optApp(0).Value = True
txtpath.Enabled = False
lblpath.Enabled = False
End Sub


Private Sub Form_Unload(Cancel As Integer)
Set oIE = Nothing
End Sub


Private Sub optApp_Click(Index As Integer)
If Index = 0 Then
txtpath.Enabled = False
lblpath.Enabled = False
Else
txtpath.Enabled = True
lblpath.Enabled = True
End If
End Sub








Iouri Boutchkine
[email protected]

[DSJ]

You might try sticking a DoEvents in your process somewhere, this might help.