Search code examples
vbscriptasp-classiciis-10

How do I generate error report emails in Classic ASP?


I want to capture 500 errors in my classic ASP application and receive an email of the error.


Solution

  • The biggest problem I had was getting a page to execute at all when an asp page crashed. Either IIS let it through for ASP to handle the error (which is useless because customErrors tag is completely ignored) or it would take over and blank out Server.GetLastError.

    In the end I figured out that if you set the defaultPath directly to httpErrors and have the defaultResponseMode to ExecuteURL it will not only execute the actual 500.asp page but it will let the page be so that Server.GetLastError can remain populated.

    web.config

    <?xml version="1.0" encoding="UTF-8"?>
    <configuration>    
        <system.webServer>
            <httpErrors defaultPath="/500.asp" defaultResponseMode="ExecuteURL" />
        </system.webServer>
    </configuration>
    

    500.asp

    <%option explicit%>
    <!DOCTYPE html>
    <%  
        'Get Error
        Dim objASPError
        Set objASPError = Server.GetLastError
    
        'Reset Response
        If Response.Buffer Then
            Response.Clear
            Response.Status = "500 Internal Server Error"
            Response.ContentType = "text/html"
            Response.Expires = 0
        End If
    
        'CSS
        dim style : style = "<style type='text/css'>"
        style = style & "table { width: 800px; } "  
        style = style & "#debugInfo th{ text-align:left; background-color:palegoldenrod; }"
        style = style & "#debugInfo td{ background-color:lightgoldenrodyellow; }"
        style = style & "#sessionInfo th{ text-align:left; background-color:cyan;}"
        style = style & "#sessionInfo td{ background-color:lightcyan; }"
        style = style & "#appInfo th{ text-align:left; background-color:tomato; }"
        style = style & "#appInfo td{ background-color:pink; }"
        style = style & "</style>"
    
        ' Error Message
        Dim errMsg : errMsg = ""    
        errMsg = errMsg &"<p>"
        errMsg = errMsg & objASPError.Category & "(0x" & hex(objASPError.Number) & ")<br />"
        errMsg = errMsg & objASPError.Description & "<br />"
        errMsg = errMsg & objASPError.File & ", line " & objASPError.Line & "<br />"
        errMsg = errMsg & objASPError.Source & "<br />"
        errMsg = errMsg & "</p>"
    
        'Debug Info
        Dim debugInfo : debugInfo = ""
        debugInfo = debugInfo & "<table id='debugInfo'>"    
        debugInfo = debugInfo & "<tr> <th colspan='2' style='text-align:center;background-color:gold;padding:2px;'>Debug Information</th> </tr>"    
        debugInfo = debugInfo & "<tr> <th>User</th>     <td>"& Request.ServerVariables("AUTH_USER") &"</td> </tr>"
        debugInfo = debugInfo & "<tr> <th>Time</th>     <td>"& Now() &"</td> </tr>"     
        debugInfo = debugInfo & "<tr> <th>Page</th>     <td>"& Request.ServerVariables("SCRIPT_NAME") &"</td> </tr>"
        debugInfo = debugInfo & "<tr> <th>User IP</th>  <td>"& Request.ServerVariables("REMOTE_HOST") & " (" & Request.ServerVariables("REMOTE_ADDR") &")</td> </tr>"
        debugInfo = debugInfo & "<tr> <th>Browser</th>  <td>"& Request.ServerVariables("HTTP_USER_AGENT") &"</td> </tr>"
        debugInfo = debugInfo & "<tr> <th>Server</th>   <td>"& Request.ServerVariables("SERVER_NAME") & " (" & Request.ServerVariables("LOCAL_ADDR") &")</td> </tr>"    
        debugInfo = debugInfo & "<tr> <th>POST</th>     <td>"& Request.Form &"</td> </tr>"
        debugInfo = debugInfo & "</table>"  
    
        'Session Variables
        Dim sessionVar, sessionVarItem, sessionTable
        sessionTable = "<table id='sessionInfo'>"   
        sessionTable = sessionTable & "<tr><th colspan='2' style='text-align:center;background-color:dodgerblue;padding:2px;'>Session Variables ("& Session.Contents.Count  &")</th></tr>"  
        For Each sessionVar in Session.Contents
            If IsArray(Session(sessionVar)) Then
                For appVarItem = LBound(Session(sessionVar)) to UBound(Session(sessionVar))
                    sessionTable = sessionTable & "<tr>"
                    sessionTable = sessionTable & "<th>" & sessionVar & " " & sessionVarItem & "</th>"
                    sessionTable = sessionTable & "<td>" & Session(sessionVar)(sessionVarItem) & "</td>"
                    sessionTable = sessionTable & "</tr>"
                Next
            Else
                sessionTable = sessionTable & "<tr>"
                sessionTable = sessionTable & "<th>" & sessionVar & "</th>"
                sessionTable = sessionTable & "<td>" & Session(sessionVar) & "</td>"
                sessionTable = sessionTable & "</tr>"
            End If
        Next
        sessionTable = sessionTable & "</table>"
    
        'Application Variables
        Dim appVar, appVarItem, appVarTable
        appVarTable = "<table id='appInfo'>"    
        appVarTable = appVarTable & "<tr><th colspan='2' style='text-align:center;background-color:lightcoral;padding:2px;'>Application Variables ("& Application.Contents.Count  &")</th></tr>"    
        For Each appVar in Application.Contents
            If IsArray(Application(appVar)) Then
                For appVarItem = LBound(Application(appVar)) to UBound(Application(appVar))
                    appVarTable = appVarTable & "<tr>"
                    appVarTable = appVarTable & "<th>" & appVar & " " & appVarItem & "</th>"
                    appVarTable = appVarTable & "<td>" & Application(item)(appVarItem) & "</td>"
                    appVarTable = appVarTable & "</tr>"
                Next
            Else
                appVarTable = appVarTable & "<tr>"
                appVarTable = appVarTable & "<th>" & appVar & "</th>"
                appVarTable = appVarTable & "<td>" & Application(appVar) & "</td>"
                appVarTable = appVarTable & "</tr>"
            End If
        Next
        appVarTable = appVarTable & "</table>"
    
    
        'Send Email
        dim tech : tech = CreateObject("WScript.Network").UserName = "ITGuy"
        If NOT tech Then
            Dim oMessage : Set oMessage = CreateObject("CDO.Message") 
            oMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
            oMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = "smtp.server.com"
            oMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            oMessage.Configuration.Fields.Update
    
            oMessage.To = "ITGuy@server.com"
            oMessage.From = "WebApp@server.com"
            oMessage.Subject="WebApp Error - " & objASPError.Category
            oMessage.htmlBody = style & errMsg & debugInfo & sessionTable & appVarTable
            oMessage.Send
        End If
    %>
    <html lang="en">
        <head>
            <meta charset="UTF-8">
            <title>System Error</title>
            <% If tech Then Response.Write style%>
        </head>
        <body>
            Sorry! The system encountered an error. An email has been sent to IT. If you have any concerns or questions please send an email to <a href="mailto:ITGuy@server.com">ITGuy@server.com</a> or call x555.
            <%If tech Then Response.Write errMsg & debugInfo & sessionTable & appVarTable %>
        </body>
    </html>