Last month, I had the “opportunity” (as we’ve been trained to say) to do some maintenance on a “Classic ASP” site.
I’d forgotten how painful that can be, but it was made a bit easier by dusting off an old tool from the dark ages.
It’s an “include” file for debugging based on a Visual Basic Programmer’s Journal article by Jonathan Goodyear from way back in February, 2001: http://support.microsoft.com/kb/288965.
It automatically dumps out cookie, form, query string, session and application variable values at the bottom of the page, and adds the ability to insert “Debug.Print” or “Debug.PrintKeyAndValue” statements in your VBScript, as seen in this sample page:
I know a lot of developers are stuck supporting old ASP sites. If you’re one of them, here’s the source code for my include file. I hope it helps to dull the pain:
<%
Dim Debug ' As clsDebug
Set Debug = New clsDebug
With Debug
.Enabled = True
.AutoDisplayOnTerminate = True
End With
Class clsDebug
'============================================================
' Class Name: clsDebug
' Author: Brian Schroer
' Date: 03/06/2001
' Description: VBScript ASP debug class
' Based on article by Jonathan Goodyear
' in Visual Basic Programmer's Journal
' (February 2001, Vol. 11, No. 2, p. 68)
' Revisions:
' 09/12/2001 Brian Schroer
' Added Silent logic
'============================================================
Dim mbAutoDisplayOnTerminate ' As Boolean
Dim mDictionary ' As Scripting.Dictionary
Dim mbDispRequestDetailsEnabled ' As Boolean
Dim mbDispDebugPrintsEnabled ' As Boolean
Dim mbDispQueryStringsEnabled ' As Boolean
Dim mbDispFormDataEnabled ' As Boolean
Dim mbDispCookiesEnabled ' As Boolean
Dim mbDispServerVariablesEnabled _
' As Boolean
Dim mbDispSessionContentsEnabled _
' As Boolean
Dim mbDispSessionStaticObjectsEnabled _
' As Boolean
Dim mbDispAppContentsEnabled ' As Boolean
Dim mbDispAppStaticObjectsEnabled _
' As Boolean
Dim mbEnabled ' As Boolean
Dim mdtRequestTime ' As Date
Dim mdtFinishTime ' As Date
Dim mbShadeRow ' As Boolean
Dim mbSilent ' As Boolean
Dim mbSilentInitialized ' As Boolean
Dim msTD ' As String
Dim msTD_Close ' As String
Dim msTR ' As String
Dim msTR_Close ' As String
Private Sub Class_Initialize()
'------------------------------------------------------------
' Subroutine: Class_Initialize
' Author: Brian Schroer
' Date: 03/06/2001
' Description: When class is initialized, initialize variables
' and create dictionary object
' Revisions:
'------------------------------------------------------------
AutoDisplayOnTerminate = False
DispRequestDetailsEnabled = True
DispDebugPrintsEnabled = True
DispQueryStringsEnabled = True
Set mDictionary = Server.CreateObject("Scripting.Dictionary")
DispFormDataEnabled = True
DispCookiesEnabled = True
DispServerVariablesEnabled = True
DispSessionContentsEnabled = True
DispSessionStaticObjectsEnabled = True
DispAppContentsEnabled = True
DispAppStaticObjectsEnabled = True
Enabled = False
mdtRequestTime = Now
mbSilent = False
msTR = vbCrLf & " <tr "
msTR_Close = vbCrLf & " </tr>"
msTD = vbCrLf & " <td"
msTD_Close = vbCrLf & " </td>"
End Sub
Private Sub Class_Terminate()
'------------------------------------------------------------
' Subroutine: Class_Terminate
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Before class is terminated, release objects
' Revisions:
' 03/08/2001 Brian Schroer
' Added AutoDisplayOnTerminate logic
'------------------------------------------------------------
If mbAutoDisplayOnTerminate Then
Call Display()
End If
Set mDictionary = Nothing
End Sub
Public Property Get AutoDisplayOnTerminate() ' As Boolean
'------------------------------------------------------------
' Property: AutoDisplayOnTerminate
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Automatically invoke Display method when
' class terminates?
' Revisions:
'------------------------------------------------------------
AutoDisplayOnTerminate = mbAutoDisplayOnTerminate
End Property
Public Property Let AutoDisplayOnTerminate(ByVal Value)
mbAutoDisplayOnTerminate = Value
End Property
Public Property Get Enabled() ' As Boolean
'------------------------------------------------------------
' Property: Enabled
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Enables/disabled debugging.
' Revisions:
'------------------------------------------------------------
Enabled = mbEnabled
End Property
Public Property Let Enabled(ByVal Value)
mbEnabled = Value
End Property
Public Sub Print(ByVal Output)
'------------------------------------------------------------
' Subroutine: Print
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Add input to collection to be "Printed"
' via Display method
' Revisions:
'------------------------------------------------------------
If mbEnabled Then
' save output to internal dictionary
Call mDictionary.Add("Debug.Print#" & CStr(mDictionary.Count), Output)
End If
End Sub
Public Sub PrintKeyAndValue(ByVal sKey, ByVal sValue)
'------------------------------------------------------------
' Subroutine: PrintEx
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Add inputs to collection to be "Printed"
' via Display method
' Revisions:
'------------------------------------------------------------
If mbEnabled Then
' save output to internal dictionary
Call mDictionary.Add(sKey, sValue)
End If
End Sub
Public Sub Display()
'------------------------------------------------------------
' Subroutine: Display
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Display debug information
' Revisions:
'------------------------------------------------------------
mdtFinishTime = Now
If Enabled Then
If DispRequestDetailsEnabled Then
Call DisplayRequestDetails()
End If
If DispDebugPrintsEnabled Then
If mDictionary.Count > 0 Then
Call DisplayPrints()
End If
End If
If DispQueryStringsEnabled Then
Call DisplayQueryStrings()
End If
If DispFormDataEnabled Then
Call DisplayFormData()
End If
If DispCookiesEnabled Then
Call DisplayCookies()
End If
If DispServerVariablesEnabled Then
Call DisplayServerVariables()
End If
If DispSessionContentsEnabled Then
Call DisplaySessionContents()
End If
If DispSessionStaticObjectsEnabled Then
Call DisplaySessionStaticObjects()
End If
If DispAppContentsEnabled Then
Call DisplayAppContents()
End If
If DispAppStaticObjectsEnabled Then
Call DisplayAppStaticObjects()
End If
End If
End Sub
Public Sub DisplayRequestDetails()
'------------------------------------------------------------
' Subroutine: DisplayRequestDetails
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Display request details
' Revisions:
' 03/14/2001 Brian Schroer
' Added "no Session" logic
'------------------------------------------------------------
Dim llSeconds ' As Long
Dim lsSeconds ' As String
Dim lsSessionID ' As String
Dim lsSessionTimeout ' As String
lsSessionId = "(no session)"
lsSessionTimeout = "(no session)"
On Error Resume Next
If Not IsEmpty(Session) Then
lsSessionID = Session.SessionID
lsSessionTimeout = CStr(Session.Timeout) & " minutes"
End If
On Error GoTo 0
Err.Clear
llSeconds = DateDiff("s", mdtRequestTime, mdtFinishTime)
Select Case llSeconds
Case 0
lsSeconds = "< 1 second"
Case 1
lsSeconds = "1 second"
Case Else
lsSeconds = Cstr(llSeconds) & " seconds"
End Select
Call msb_GroupInitialize("Request Details")
With Response
msb_DebugWrite msTR & ">"
Call msb_ReqDtlShow("Session ID", lsSessionID)
Call msb_ReqDtlShow("Request Type", Request.ServerVariables("REQUEST_METHOD"))
msb_DebugWrite msTR_Close
msb_DebugWrite msTR & ">"
Call msb_ReqDtlShow("Time of Request", FormatDateTime(mdtRequestTime))
Call msb_ReqDtlShow("Status Code", .Status)
msb_DebugWrite msTR_Close
msb_DebugWrite msTR & ">"
Call msb_ReqDtlShow("Session Timeout", lsSessionTimeout)
Call msb_ReqDtlShow("Total Bytes", CStr(Request.TotalBytes))
msb_DebugWrite msTR_Close
msb_DebugWrite msTR & ">"
Call msb_ReqDtlShow("Elapsed Time", lsSeconds)
If Not IsNull(.Expires) Then
Call msb_ReqDtlShow("Expires", _
CStr(.Expires) & " minutes<BR>" _
& FormatDateTime(.ExpiresAbsolute))
End If
msb_DebugWrite msTR_Close
End With
Call msb_GroupTerminate
End Sub
Private Sub msb_ReqDtlShow(ByVal asLabel, ByVal asValue)
'------------------------------------------------------------
' Subroutine: msb_ReqDtlShow
' Author: Brian Schroer
' Date: 03/14/2001
' Description: Display request detail data
' Inputs: asLabel = label
' asValue = value
' Revisions:
'------------------------------------------------------------
If mbSilent Then
msb_MemberPrint asLabel, asValue
Else
msb_DebugWrite msTD & "><small><b>"
msb_DebugWrite asLabel
msb_DebugWrite ":</b></small>" & msTD_Close
msb_DebugWrite msTD & "><small>"
msb_DebugWrite asValue
msb_DebugWrite "</small>" & msTD_Close
End If
End Sub
Public Sub DisplayPrints()
'------------------------------------------------------------
' Subroutine: DisplayPrints
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Debug.Print collect
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Debug.Print Entries", _
mDictionary, _
False)
End Sub
Public Sub DisplayQueryStrings()
'------------------------------------------------------------
' Subroutine: DisplayQueryStrings
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Request.QueryString collection
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Request.QueryString Collection", _
Request.QueryString(), _
True)
End Sub
Public Sub DisplayFormData()
'------------------------------------------------------------
' Subroutine: DisplayFormData
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Request.Form collection
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Request.Form Collection", _
Request.Form(), _
True)
End Sub
Public Sub DisplayCookies()
'------------------------------------------------------------
' Subroutine: DisplayCookies
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Request.Cookies collection
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Request.Cookies Collection", _
Request.Cookies(), _
True)
End Sub
Public Sub DisplayServerVariables()
'------------------------------------------------------------
' Subroutine: DisplayServerVariables
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Request.ServerVariables collection
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Request.ServerVariables Collection", _
Request.ServerVariables(), _
True)
End Sub
Public Sub DisplaySessionContents()
'------------------------------------------------------------
' Subroutine: DisplaySessionContents
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Session.Contents collection
' Revisions:
'------------------------------------------------------------
If Session Is Nothing Then
Call msb_CollectionPrint("Session.Contents Collection", Nothing, True)
Else
Call msb_CollectionPrint("Session.Contents Collection", Session.Contents(), True)
End If
End Sub
Public Sub DisplaySessionStaticObjects()
'------------------------------------------------------------
' Subroutine: DisplaySessionStaticObjects
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Session.StaticObjects collection
' Revisions:
'------------------------------------------------------------
If Session Is Nothing Then
Call msb_CollectionPrint("Session.StaticObjects Collection", Session.StaticObjects(), True)
Else
Call msb_CollectionPrint("Session.StaticObjects Collection", Nothing, True)
End If
End Sub
Public Sub DisplayAppContents()
'------------------------------------------------------------
' Subroutine: DisplayAppContents
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Application.Contents collection
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Application.Contents Collection", _
Application.Contents(), _
True)
End Sub
Public Sub DisplayAppStaticObjects()
'------------------------------------------------------------
' Subroutine: DisplayAppStaticObjects
' Author: Brian Schroer
' Date: 03/08/2001
' Description: Display Application.StaticObjects collection
' Revisions:
'------------------------------------------------------------
Call msb_CollectionPrint( _
"Application.StaticObjects Collection", _
Application.StaticObjects(), _
True)
End Sub
Private Sub msb_CollectionPrint(ByVal CollectionName, ByVal Collection, ByVal abSorted)
'------------------------------------------------------------
' Subroutine: msb_CollectionPrint
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Print contents of collection
' Revisions:
' 09/12/2001 Brian Schroer
' Added abSorted logic
'------------------------------------------------------------
Dim lvItem ' As Variant
Call msb_GroupInitialize(CollectionName)
If Not Collection Is Nothing Then
If Collection.Count > 0 Then
If Not mbSilent Then
msb_DebugWrite msTR & " style=""BACKGROUND-COLOR: gray"">"
msb_DebugWrite msTD
msb_DebugWrite "><small><b>"
msb_DebugWrite "Name"
msb_DebugWrite "</b></small>" & msTD_Close
msb_DebugWrite msTD
msb_DebugWrite "><small><b> "
msb_DebugWrite "Value"
msb_DebugWrite "</b></small>" & msTD_Close
msb_DebugWrite msTR_Close
End If
End If
mbShadeRow = True
If abSorted Then
If Collection.Count > 0 Then
For Each lvItem In mfn_v_Debug_SortedDictKeys(Collection)
Call msb_MemberPrint(lvItem, Collection(lvItem))
Next
End If
Else
For Each lvItem In Collection
Call msb_MemberPrint(lvItem, Collection(lvItem))
Next
End If
End If
Call msb_GroupTerminate
End Sub
Private Sub msb_GroupInitialize(ByVal asTitle)
'------------------------------------------------------------
' Subroutine: msb_GroupInitialize
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Initialize display group
' Inputs: asTitle = group title
' Revisions:
'------------------------------------------------------------
If Not mbSilentInitialized Then
mbSilentInitialized = True
If mbSilent Then
Response.Write vbCrLf & "<!-- " _
& vbCrLf & String(60, "=") _
& vbCrLf & asTitle _
& vbCrLf & String(60, "=") & vbCrLf
Exit Sub
End If
End If
msb_DebugWrite vbCrLf & vbCrLf
msb_DebugWrite "<BR>"
msb_DebugWrite vbCrLf
msb_DebugWrite "<table style=""background: black; color: white;" _
& " font-family: Verdana, Arial, Helvetica, ""Sans Serif"";" _
& " font-size: x-small"" border=0 width=""100%"">"
msb_DebugWrite msTR & ">"
msb_DebugWrite msTD & "><b><p><small>"
msb_DebugWrite asTitle
msb_DebugWrite "</small></p></b>"
msb_DebugWrite msTD_Close
msb_DebugWrite msTR_Close
msb_DebugWrite vbCrLf
msb_DebugWrite "</table>"
msb_DebugWrite vbCrlf
msb_DebugWrite "<table style=""background: white; color: black;" _
& " font-family: Verdana, Arial, Helvetica, ""Sans Serif"";" _
& " font-size: x-small"" border=0 cellPadding=0 cellSpacing=0 width=""100%"">"
mbShadeRow = False
End Sub
Private Sub msb_MemberPrint( _
ByVal asName, _
ByVal avValue)
'------------------------------------------------------------
' Subroutine: msb_MemberPrint
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Print collection/array member
' Revisions:
'------------------------------------------------------------
Dim llBlank ' As Long
Dim lsDelim ' As String
Dim llIndex ' As Long
Dim lvItem ' As Variant
Const llMax = 30
Dim lsName ' As String
Dim lsTypeName ' As String
Dim lsValue ' As String
lsTypeName = TypeName(avValue)
lsValue = "(" & lsTypeName & " object)"
Select Case lsTypeName
Case "Variant()"
llIndex = LBound(avValue)
lsName = asName
If Right(lsName, 1) = ")" Then
lsName = Left(lsName, (Len(lsName) -1)) & ","
Else
lsName = lsName & "("
End If
For Each lvItem In avValue
Call msb_MemberPrint( _
lsName & CStr(llIndex) & ")", _
lvItem)
llIndex = llIndex + 1
Next
Case Else
mbShadeRow = Not mbShadeRow
If mbShadeRow Then
msb_DebugWrite msTR & " valign=top style=""BACKGROUND-COLOR: silver"">"
Else
msb_DebugWrite msTR & " valign=top>"
End If
lsName = asName
If Len(lsName) > llMax Then
llBlank = Instr(1, lsName, " ")
If llBlank < 1 Or llBlank > llMax Then
lsName = Left(lsName, llMax) & "<BR>" & Mid(lsName, llMax + 1)
End If
End If
If Left(asName, 12) = "Debug.Print#" Then
msb_DebugWrite msTD & " colspan=2"
lsDelim = ""
Else
If mbSilent Then
msb_DebugWrite lsName & ":" & vbCrLf
Else
msb_DebugWrite msTD
msb_DebugWrite "><small>"
msb_DebugWrite lsName
msb_DebugWrite "</small>" & msTD_Close
msb_DebugWrite msTD
End If
lsDelim = "'"
End If
msb_DebugWrite "><small>"
On Error Resume Next
lsValue = CStr(avValue)
On Error Goto 0
Select Case lsTypeName
Case "String", "IStringList", "IReadCookie"
lsValue = lsDelim & lsValue & lsDelim
Case "Empty"
lsValue = "(Empty)"
End Select
If mbSilent Then
msb_DebugWrite lsValue & vbCrLf & vbCrLf
Else
msb_DebugWrite " " & lsValue
End If
If lsTypeName = "IReadCookie" Then
If avValue.HasKeys Then
For Each lvItem In avValue
Call msb_MemberPrint( _
lsName & "(""" & lvItem & """)", _
avValue.Item(lvItem))
llIndex = llIndex + 1
Next
End If
End If
End Select
msb_DebugWrite "</small>" & msTD_Close
msb_DebugWrite msTR_Close
End Sub
Private Sub msb_GroupTerminate()
'------------------------------------------------------------
' Subroutine: msb_GroupTerminate
' Author: Brian Schroer
' Date: 03/06/2001
' Description: Terminate display group
' Revisions:
'------------------------------------------------------------
If mbSilent Then
Response.Write vbCrLf & "-->"
mbSilentInitialized = False
Else
msb_DebugWrite vbCrLf
msb_DebugWrite "</table>"
End If
End Sub
Public Property Get DispRequestDetailsEnabled() ' As Boolean
DispRequestDetailsEnabled = mbDispRequestDetailsEnabled
End Property
Public Property Let DispRequestDetailsEnabled(ByVal Value)
mbDispRequestDetailsEnabled = Value
End Property
Public Property Get DispDebugPrintsEnabled() ' As Boolean
DispDebugPrintsEnabled = mbDispDebugPrintsEnabled
End Property
Public Property Let DispDebugPrintsEnabled(ByVal Value)
mbDispDebugPrintsEnabled = Value
End Property
Public Property Get Silent() ' As Boolean
Silent = mbSilent
End Property
Public Property Let Silent(ByVal Value)
If Value <> mbSilent Then
mbSilent = Value
mbSilentInitialized = True
End If
End Property
Public Property Get DispQueryStringsEnabled() ' As Boolean
DispQueryStringsEnabled = mbDispQueryStringsEnabled
End Property
Public Property Let DispQueryStringsEnabled(ByVal Value)
mbDispQueryStringsEnabled = Value
End Property
Public Property Get DispFormDataEnabled() ' As Boolean
DispFormDataEnabled = mbDispFormDataEnabled
End Property
Public Property Let DispFormDataEnabled(ByVal Value)
mbDispFormDataEnabled = Value
End Property
Public Property Get DispCookiesEnabled() ' As Boolean
DispCookiesEnabled = mbDispCookiesEnabled
End Property
Public Property Let DispCookiesEnabled(ByVal Value)
mbDispCookiesEnabled = Value
End Property
Public Property Get DispServerVariablesEnabled() ' As Boolean
DispServerVariablesEnabled = mbDispServerVariablesEnabled
End Property
Public Property Let DispServerVariablesEnabled(ByVal Value)
mbDispServerVariablesEnabled = Value
End Property
Public Property Get DispSessionContentsEnabled() ' As Boolean
DispSessionContentsEnabled = mbDispSessionContentsEnabled
End Property
Public Property Let DispSessionContentsEnabled(ByVal Value)
mbDispSessionContentsEnabled = Value
End Property
Public Property Get DispSessionStaticObjectsEnabled() ' As Boolean
DispSessionStaticObjectsEnabled = mbDispSessionStaticObjectsEnabled
End Property
Public Property Let DispSessionStaticObjectsEnabled(ByVal Value)
mbDispSessionStaticObjectsEnabled = Value
End Property
Public Property Get DispAppContentsEnabled() ' As Boolean
DispAppContentsEnabled = mbDispAppContentsEnabled
End Property
Public Property Let DispAppContentsEnabled(ByVal Value)
mbDispAppContentsEnabled = Value
End Property
Public Property Get DispAppStaticObjectsEnabled() ' As Boolean
DispAppStaticObjectsEnabled = mbDispAppStaticObjectsEnabled
End Property
Public Property Let DispAppStaticObjectsEnabled(ByVal Value)
mbDispAppStaticObjectsEnabled = Value
End Property
Private Sub msb_DebugWrite(ByVal asString)
Dim llIndex ' As Long
If mbSilent Then
If Right(asString, 1) = ">" Then
Exit Sub
End If
For llIndex = 1 TO Len(asString)
Select Case Mid(asString, llIndex, 1)
Case vbCr, vbLf, vbTab, " "
Case "<"
Exit Sub
Case Else
Exit For
End Select
Next
End If
Response.Write asString
End Sub
Private Function mfn_v_Debug_SortedDictKeys(ByVal aDictionary)' As Scripting.Dictionary) As Variant)
'------------------------------------------------------------
' Subroutine: mfn_v_Debug_SortedDictKeys
' Author: Brian Schroer
' Description: Build array of sorted Dictionary keys
' Inputs: aDictionary = Scripting.Dictionary
' Returns: Array of sorted Dictionary Keys
' Revisions:
'------------------------------------------------------------
Dim llIndex ' As Long
Dim lvKey ' As Variant
Execute ("Dim lvArray(" & aDictionary.Count - 1 & ")")
llIndex = LBound(lvArray) - 1
For Each lvKey In aDictionary
llIndex = llIndex + 1
lvArray(llIndex) = lvKey
Next
Call msb_Debug_ShakeSort(lvArray)
mfn_v_Debug_SortedDictKeys = lvArray
End Function
Private Sub msb_Debug_ShakeSort(ByRef avArray)'As Variant
'------------------------------------------------------------
' Subroutine: msb_Debug_ShakeSort
' Author: Brian Schroer - based on VBPJ tip by Tan Shing Ho
' Description: perform "shaker" sort on array
' Inputs: avArray = array (of any data type)
' Returns: (sorted avArray)
' Revisions:
'------------------------------------------------------------
Dim lbSwap ' As Boolean
Dim lvTemp ' As Variant
Dim llX ' As Long
Dim llMin ' As Long
Dim llMax ' As Long
llMin = LBound(avArray) + 1
llMax = UBound(avArray)
Do
lbSwap = False
For llX = llMax To llMin Step -1
If avArray(llX - 1) > avArray(llX) Then
lvTemp = avArray(llX - 1)
avArray(llX - 1) = avArray(llX)
avArray(llX) = lvTemp
lbSwap = True
End If
Next
For llX = llMin To llMax
If avArray(llX - 1) > avArray(llX) Then
lvTemp = avArray(llX - 1)
avArray(llX - 1) = avArray(llX)
avArray(llX) = lvTemp
lbSwap = True
End If
Next
Loop While lbSwap
End Sub
End Class
%>