لطفا منتظر باشید ...
Creating a Call Stack
While in the debugger, it is very easy to view the call stack. Unfortunately, the call stack information cannot be accessed programmatically when an error occurs. If you want to keep track of the sequence of procedures that brought you to the error condition, you must do it yourself. The code in Listing 16.26 shows three routines. Func1 calls Func2, and then Func2 calls Func3. Func3 renders an error.
Listing 16.26 Routines That Call One Another
Sub Func1()
'Invoke error handling
On Error GoTo Func1_Err
'Put routine in call stack
ERH_PushStack_TSB ("Func1")
'Print to the Immediate window
Debug.Print "I am in Function 1"
'Execute the Func2 routine
Call Func2
'Print to the Immediate window
Debug.Print "I am back in Function 1"
Func1_Exit:
'Pop error stack
ERH_PopStack_TSB
'Exit the subroutine
Exit Sub
Func1_Err:
'Display a message to the user,
'indicating that an error occurred
MsgBox "Error in Func1"
'Resume execution
Resume Func1_Exit
End Sub
Sub Func2()
'Put routine in call stack
ERH_PushStack_TSB ("Func2")
On Error GoTo Func2_Err
Debug.Print "I am in Func2"
'Execute Func3
Call Func3
'Print to the Immediate window
Debug.Print "I am still in Func2"
Func2_Exit:
'Pop error stack
ERH_PopStack_TSB
'Exit the subroutine
Exit Sub
Func2_Err:
'Display a message to the user,
'indicating that an error occurred
MsgBox "Error in Func1"
'Resume execution
Resume Func2_Exit
End Sub
Sub Func3()
Dim sngAnswer As Single
'Put routine in call stack
ERH_PushStack_TSB ("Func3")
On Error GoTo Func3_Err
'Print to the Immediate window
Debug.Print "I am in Func3"
'Oops, an error occurred
sngAnswer = 5 / 0
'This line of code will never execute
Debug.Print "I am still in Func3"
Func3_Exit:
'Pop error stack
ERH_PopStack_TSB
'Exit the subroutine
Exit Sub
Func3_Err:
Dim intCounter As Integer
Dim strCallStack As String
For intCounter = LBound(gaERH_Stack_TSB) To UBound(gaERH_Stack_TSB)
If Len(gaERH_Stack_TSB(intCounter)) Then
strCallStack = strCallStack & _
gaERH_Stack_TSB(intCounter) & vbCrLf
End If
Next intCounter
MsgBox Err.Number & ": " & Err.Description & _
vbCrLf & strCallStack
Resume Func3_Exit
End Sub
Notice that at the beginning of each routine, the ERH_PushStack_TSB subroutine is called, pushing the error into the stack, as shown in Listing 16.27.
Listing 16.27 The ERH_PushStack_TSB Function
Sub ERH_PushStack_TSB(strProc As String)
' Comments : Pushes the supplied procedure name onto the error handling stack
' Parameters: strProc - name of the currently executing procedure
' Returns : Nothing
'
gintERH_Pointer_TSB = gintERH_Pointer_TSB + 1
If gintERH_Pointer_TSB <= ERH_MAXITEMS_TSB Then
gaERH_Stack_TSB(gintERH_Pointer_TSB) = strProc
Else
gaERH_Stack_TSB(gintERH_Pointer_TSB + 2) = strProc
End If
End Sub
The code adds the name of the procedure to the gaERH Stack_TSB array. The ERH_PopStack_TSB subroutine, shown in Listing 16.28, is executed in the exit code for each procedure and removes the error from the stack.
Listing 16.28 The ERH_PopStack_TSB Function
Sub ERH_PopStack_TSB()
' Comments : Pops the current procedure name off the error handling stack
' Parameters: None
' Returns : Nothing
'
If gintERH_Pointer_TSB <= ERH_MAXITEMS_TSB Then
gaERH_Stack_TSB(gintERH_Pointer_TSB) = "
End If
gintERH_Pointer_TSB = gintERH_Pointer_TSB - 1
If gintERH_Pointer_TSB < 0 Then
gintERH_Pointer_TSB = 0
End If
End Sub
The ERH_PopStack_TSB subroutine removes the text in the largest array element.Chapter 32, "Distributing Your Application."As the code goes in and out of routines, the code adds entries to and removes entries from the array. Because the array is Public, you can review its contents at any time. Notice in Func3 in Listing 16.26 that the error handler iterates through the array, pulling out the error information.
