<% '================================================== ' Module: inc_debug.asp ' ' Synopsis: Server Appliance Web Framework Error Handling ' ' Copyright (c) Microsoft Corporation. All rights reserved. '================================================== %> <% 'Server.ScriptTimeout = 300 ' ' Global variables for Error handling support ' Const MAX_TRACEFILE_SIZE = 500000 Const MINIMUM_SCRIPT_TIMEOUT = 300 ' ' ReEntrancy check variable DIM SA_INSIDE_DEBUG SA_INSIDE_DEBUG = 0 ' Last error code. ' DO NOT access this variable directly, use SA_GetLastError DIM SA_LASTERROR ' Function executing during last error ' DO NOT access this variable, it's for internal use only DIM SA_LASTERROR_FUNCTION ' Tracing options Const SA_TRACE_OUTPUT_NONE = 0 Const SA_TRACE_OUTPUT_HTML = 1 Const SA_TRACE_OUTPUT_FILE = 2 ' ' Debugging enabled, default is enabled. ' DO NOT access this variable, it's for internal use only. ' ' This variable is set in LoadRuntimeOptions() which ' is called below. We default to enabled just in case ' LoadRuntimeOptions failes to initialize. DIM SA_DEBUG_ENABLED SA_DEBUG_ENABLED = 0 ' Tracing option, default is HTML ' DO NOT access this variable, it's for internal use only. ' ' This variable is set in LoadRuntimeOptions() which ' is called below. We default to enabled just in case ' LoadRuntimeOptions failes to initialize. DIM SA_TRACE_OPTION SA_TRACE_OPTION = SA_TRACE_OUTPUT_NONE ' Current Tracing output file ' DO NOT access this variable, it's for internal use only DIM SA_TRACE_FILE ' ' Global constant error codes Const gc_ERR_SUCCESS = 0 SA_LASTERROR = gc_ERR_SUCCESS ' ' Set the Runtime options ' LoadRuntimeOptions() ' ' Set page level error handling ' If (SA_DEBUG_ENABLED <> 0) Then ' ' Debugging mode ' On Error goto 0 Else ' ' Release mode ' On Error Resume Next End If ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Private Function LoadRuntimeOptions() ON ERROR RESUME NEXT Dim objRegistry Dim dwDebugOption ' ' Prevent recursion into this module. Specifically, SA_TraceOut SA_EnterDebugModule() ' ' Disable for now ' Set objRegistry = RegConnection() If (NOT IsObject(objRegistry)) Then SA_TraceOut "LoadRuntimeOptions", "RegConnection() failed " + "(" + Hex(Err.Number) + ")" Exit Function End If ' ' Fetch debugging flag ' SA_DEBUG_ENABLED= GetRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "Debug", CONST_DWORD) If (SA_DEBUG_ENABLED <> 0) Then ' ' Debugging mode ' On Error goto 0 Else ' ' Release mode ' On Error Resume Next End If SA_TRACE_OPTION = GetRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "TraceOption", CONST_DWORD) SA_TRACE_FILE = GetRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "TraceFile", CONST_STRING) Dim iScriptTimeOut iScriptTimeOut = GetRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "ScriptTimeOut", CONST_DWORD) If ( NOT IsNumeric(iScriptTimeOut) ) Then iScriptTimeOut = MINIMUM_SCRIPT_TIMEOUT ElseIf ( iScriptTimeOut < MINIMUM_SCRIPT_TIMEOUT ) Then iScriptTimeOut = MINIMUM_SCRIPT_TIMEOUT End If Server.ScriptTimeout = CInt(iScriptTimeOut) SA_ExitDebugModule() Set objRegistry = nothing End Function ' -------------------------------------------------------------- ' ' Function: SA_EnterDebugModule ' ' Synopsis: Mark us as inside the debug module. This is used for ' reentrancy checks. We don't want to get caught in ' a recussion loop if we have an error inside this module. ' ' Arguments: ' ' -------------------------------------------------------------- Private Function SA_EnterDebugModule() SA_INSIDE_DEBUG = 1 End Function ' -------------------------------------------------------------- ' ' Function: SA_ExitDebugModule ' ' Synopsis: Mark us as exiting the debug module. This is used for ' reentrancy checks. We don't want to get caught in ' a recussion loop if we have an error inside this module. ' ' Arguments: ' ' -------------------------------------------------------------- Private Function SA_ExitDebugModule() SA_INSIDE_DEBUG = 0 End Function ' -------------------------------------------------------------- ' ' Function: SA_IsExecutingDebugModule ' ' Synopsis: Check to see if we are reentering this module ' ' -------------------------------------------------------------- Private Function SA_IsExecutingDebugModule() SA_IsExecutingDebugModule = SA_INSIDE_DEBUG End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Public Function SA_IsDebugEnabled() SA_IsDebugEnabled = SA_DEBUG_ENABLED End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Public Function SA_EnableDebug(ByVal DebugEnabled) SA_DEBUG_ENABLED = DebugEnabled Dim objRegistry Dim rc Set objRegistry = RegConnection() If (NOT IsObject(objRegistry)) Then SA_TraceOut "SA_EnableDebug", "RegConnection() failed " + "(" + Hex(Err.Number) + ")" Exit Function End If rc = UpdateRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "Debug", _ DebugEnabled, _ CONST_DWORD) Set objRegistry = nothing SA_EnableDebug = gc_ERR_SUCCESS End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Public Function SA_GetTraceOption() SA_GetTraceOption = SA_TRACE_OPTION End Function ' -------------------------------------------------------------- ' ' Function: SA_SetDebugOption ' ' Synopsis: Set the debugging option. ' ' Arguments: [in] Option - Debugging option to use which can be a combination of ' SA_TRACE_OUTPUT_HTML Debugging errors emitted with HTML response ' SA_TRACE_OUTPUT_FILE Debugging errors emitted to output file ' ' -------------------------------------------------------------- Public Function SA_SetDebugOption(ByVal DebugOption) SA_TRACE_OPTION = DebugOption Dim objRegistry Dim rc Set objRegistry = RegConnection() If (NOT IsObject(objRegistry)) Then SA_TraceOut "SA_SetDebugOption", "RegConnection() failed " + "(" + Hex(Err.Number) + ")" Exit Function End If rc = UpdateRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "TraceOption", _ DebugOption, _ CONST_DWORD) Set objRegistry = nothing SA_SetDebugOption = gc_ERR_SUCCESS End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Public Function SA_GetTraceOutputFile() SA_GetTraceOutputFile = SA_TRACE_FILE End Function ' -------------------------------------------------------------- ' ' Function: SA_SetDebugOutputFile ' ' Synopsis: Set the debugging output file ' ' Arguments: [in] File - Filename to receive debugging output ' ' -------------------------------------------------------------- Public Function SA_SetDebugOutputFile(ByVal File) SA_TRACE_FILE = File Dim objRegistry Dim rc Set objRegistry = RegConnection() If (NOT IsObject(objRegistry)) Then SA_TraceOut "SA_SetDebugOutputFile", "RegConnection() failed " + "(" + Hex(Err.Number) + ")" Exit Function End If rc = UpdateRegkeyValue( objRegistry, _ "SOFTWARE\Microsoft\ServerAppliance\WebFramework",_ "TraceFile", _ File, _ CONST_STRING) Set objRegistry = nothing SA_SetDebugOutputFile = gc_ERR_SUCCESS End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Function SA_ClearTraceLog() #ifdef DBG Dim fso Dim traceFile Const ForReading = 1, ForWriting = 2, ForAppending = 8 Set fso = CreateObject("Scripting.FileSystemObject") If ( NOT IsObject(fso)) Then SA_TraceOut "SA_ClearTraceLog", "CreateObject(Scripting.FileSystemObject) failed " + "(" + Hex(Err.Number) + ")" Exit Function End If on error resume next Set traceFile = fso.OpenTextFile(SA_TRACE_FILE, ForWriting, True) If (NOT IsObject(traceFile)) Then SA_TraceOut "LoadRuntimeOptions", _ "fso.OpenTextFile(SA_TRACE_FILE, ForWriting, True) failed " + "(" + Hex(Err.Number) + ")" If SA_IsDebugEnabled() Then on error goto 0 End If Exit Function End If traceFile.Close If SA_IsDebugEnabled() Then on error goto 0 End If Set traceFile = nothing Set fso = nothing #endif End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Function SA_ShowTraceLog() #ifdef DBG Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim fso Dim traceFile Dim str on error resume next Set fso = CreateObject("Scripting.FileSystemObject") If ( NOT IsObject(fso)) Then SA_TraceOut "SA_ShowTraceLog", "CreateObject(Scripting.FileSystemObject) failed " + "(" + Hex(Err.Number) + ")" If SA_IsDebugEnabled() Then on error goto 0 End If Exit Function End If Set traceFile = fso.OpenTextFile(SA_TRACE_FILE, ForReading, True) If (NOT IsObject(traceFile)) Then SA_TraceOut "SA_ShowTraceLog", _ "fso.OpenTextFile(SA_TRACE_FILE, ForWriting, True) failed " + "(" + Hex(Err.Number) + ")" If SA_IsDebugEnabled() Then on error goto 0 End If fso = Nothing Exit Function End If Response.Write("

Trace Log

") Response.Write("") While NOT traceFile.AtEndOfStream str = traceFile.ReadLine() Response.Write("") Response.Flush WEnd Response.Write("
"+str+"
") traceFile.Close If SA_IsDebugEnabled() Then on error goto 0 End If Set traceFile = nothing Set fso = nothing #endif End Function ' -------------------------------------------------------------- ' ' Function: ' ' Synopsis: ' ' Arguments: ' ' -------------------------------------------------------------- Function SA_ShowRuntimeOptions() #ifdef DBG SA_TraceOut "CheckRuntimeOptions", "Begin" Response.Write("

Runtime Options

") Response.Write(""+vbCrLf) Response.Write("") Response.Write("") Response.Write("") Response.Write(""+vbCrLf) Response.Write("") Response.Write("") Response.Write("") Response.Write(""+vbCrLf) Response.Write("") Response.Write("") Response.Write("") Response.Write(""+vbCrLf) Response.Write("") Response.Write("") Response.Write("") Response.Write(""+vbCrLf) Response.Write("
SettingValue
Debug enabled" + CStr(SA_IsDebugEnabled()) + "
Trace option" + CStr(SA_GetTraceOption()) + "
Trace output" + Trim(SA_GetTraceOutputFile()) + "
"+vbCrLf) SA_TraceOut "CheckRuntimeOptions", "End" #endif End Function ' -------------------------------------------------------------- ' ' Function: SA_TraceOut ' ' Synopsis: Output tracing information ' ' Arguments: [in] Module - Module/Function issuing the tracing message ' [in] Message - Message to be output ' ' -------------------------------------------------------------- Public Function SA_TraceOut(ByVal Module, ByVal Message) #ifdef DBG If (NOT SA_IsExecutingDebugModule() ) Then SA_EnterDebugModule() SA_InternalTraceOut Module, Message SA_ExitDebugModule() End If #endif SA_TraceOut = gc_ERR_SUCCESS End Function ' -------------------------------------------------------------- ' ' Function: SA_TraceErrorOut ' ' Synopsis: Output tracing information for error conditions. Errors are ' flaged with the keyword ISSUE. ' ' Arguments: [in] Module - Module/Function issuing the tracing message ' [in] Message - Message to be output ' ' -------------------------------------------------------------- Public Function SA_TraceErrorOut(ByVal Module, ByVal Message) Dim rc rc = SA_TraceOut("ISSUE: " + Module, Message) SA_TraceErrorOut = rc End Function ' -------------------------------------------------------------- ' ' Function: SA_SetLastError ' ' Synopsis: Set the last error code. ' ' Arguments: [in] ErrorCode - Error code ' [in] FunctionName - Name of function where error occured ' ' -------------------------------------------------------------- Public Function SA_GetLastError() SA_GetLastError = SA_LASTERROR End Function ' -------------------------------------------------------------- ' ' Function: SA_SetLastError ' ' Synopsis: Set the last error code. ' ' Arguments: [in] ErrorCode - Error code ' [in] FunctionName - Name of function where error occured ' ' Returns: The error code specified in ErrorCode parameter ' ' -------------------------------------------------------------- Public Function SA_SetLastError(ByVal ErrorCode, ByVal FunctionName ) SA_LASTERROR = ErrorCode SA_LASTERROR_FUNCTION = FunctionName Err.Number = ErrorCode SA_SetLastError = ErrorCode ' ' If we had an error then emit trace output. An error is ' any error code other than gc_ERR_SUCCESS. ' If ( ErrorCode <> gc_ERR_SUCCESS ) Then SA_InternalTraceOut "ISSUE: "+FunctionName, CStr(ErrorCode) End If End Function ' -------------------------------------------------------------- ' ' Function: SA_SetLastError ' ' Synopsis: Set the last error code. ' ' Arguments: [in] ErrorCode - Error code ' [in] FunctionName - Name of function where error occured ' ' -------------------------------------------------------------- Public Function SA_ClearError() SA_LASTERROR = gc_ERR_SUCCESS Err.Number = 0 SA_ClearError = gc_ERR_SUCCESS End Function ' -------------------------------------------------------------- ' ' Function: _SA_InternalTraceOut ' ' Synopsis: Internal function to handle output tracing. ' ' Arguments: [in] Module - Module/Function issuing the tracing message ' [in] Message - Message to be output ' ' -------------------------------------------------------------- Private Function SA_InternalTraceOut(ByVal Module, ByVal Message) #ifdef DBG on error resume next ' ' Trace errors to HTML response buffer ' If (SA_TRACE_OPTION AND SA_TRACE_OUTPUT_HTML) Then Response.Write("") Response.Write("
") Response.Write("

" + Module + " : " + Message) Response.Write("
") Response.Write("") End If ' ' Trace to file ' If (SA_TRACE_OPTION AND SA_TRACE_OUTPUT_FILE) Then Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim fso Dim traceFile Set fso = CreateObject("Scripting.FileSystemObject") If ( NOT IsObject(fso)) Then ' ' Can not call SA_TraceOut here since we are in it. ' If SA_IsDebugEnabled() Then on error goto 0 Else on error resume next End If Exit Function End If Dim enOpenOption enOpenOption = ForAppending Err.Clear Set traceFile = fso.GetFile(SA_TRACE_FILE) If ( Err.Number = 0 ) Then If ( traceFile.size > MAX_TRACEFILE_SIZE ) Then enOpenOption = ForWriting End If End If Set traceFile = nothing Set traceFile = fso.OpenTextFile(SA_TRACE_FILE, enOpenOption, True) If (NOT IsObject(traceFile)) Then ' ' Can not call SA_TraceOut here since we are in it. ' Set fso = nothing If SA_IsDebugEnabled() Then on error goto 0 Else on error resume next End If Exit Function End If traceFile.WriteLine CStr(Now())+": " + Module + " : " + Message traceFile.Close Set traceFile = Nothing Set fso = Nothing End If If SA_IsDebugEnabled() Then on error goto 0 Else on error resume next End If #endif SA_InternalTraceOut = gc_ERR_SUCCESS End Function %>