Here is some code I lifted awhile back, sorry i forget who to credit this to
(don't this this includes items added with trace.warn):
HTH,
Greg
Option Strict On
Imports System.Collections.Specialized
Namespace eTime
Class ModError
Private Sub New()
End Sub
Public Shared Function GetHTMLError(ByVal Ex As Exception) As String
'Returns HTML an formatted error message
Dim Heading As String
Dim MyHTML As String
Dim Error_Info As New NameValueCollection
Heading = "<TABLE BORDER=""0"" WIDTH=""100%"" CELLPADDING=""1""
CELLSPACING=""0""><TR><TD bgcolor=""black"" COLSPAN=""2""><FONT
face=""Arial"" color=""white""><B>
<!--HEADER--></B></FONT></TD></TR></TABLE>"
MyHTML = "<FONT face=""Arial"" size=""4"" color=""red"">Error -
" & Ex.Message & "</FONT><BR><BR>"
Error_Info.Add("Message", CleanHTML(Ex.Message))
Error_Info.Add("Source", CleanHTML(Ex.Source))
Error_Info.Add("TargetSite",
CleanHTML(Ex.TargetSite.ToString()))
Error_Info.Add("StackTrace", CleanHTML(Ex.StackTrace))
MyHTML += Heading.Replace("<!--HEADER-->", "Error Information")
MyHTML += CollectionToHtmlTable(Error_Info)
'// QueryString Collection
MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->",
"QueryString Collection")
MyHTML +=
CollectionToHtmlTable(HttpContext.Current.Request.QueryString)
'// Form Collection
MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Form
Collection")
MyHTML +=
CollectionToHtmlTable(HttpContext.Current.Request.Form)
'// Cookies Collection
MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Cookies
Collection")
MyHTML +=
CollectionToHtmlTable(HttpContext.Current.Request.Cookies)
'// Session Variables
MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Session
Variables")
MyHTML += CollectionToHtmlTable(HttpContext.Current.Session)
'// Server Variables
MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Server
Variables")
MyHTML +=
CollectionToHtmlTable(HttpContext.Current.Request.ServerVariables)
Return MyHTML
End Function
Private Shared Function CollectionToHtmlTable(ByVal Collection As
NameValueCollection) As String
Dim TD As String
Dim MyHTML As String
Dim i As Integer
TD = "<TD><FONT face=""Arial""
size=""2""><!--VALUE--></FONT></TD>"
MyHTML = "<TABLE width=""100%"">" & _
" <TR bgcolor=""#C0C0C0"">" & _
TD.Replace("<!--VALUE-->", " <B>Name</B>") & _
" " & TD.Replace("<!--VALUE-->", " <B>Value</B>") & "</TR>"
'No Body? -> N/A
If (Collection.Count <= 0) Then
Collection = New NameValueCollection
Collection.Add("N/A", "")
Else
'Table Body
For i = 0 To Collection.Count - 1
MyHTML += "<TR valign=""top"" bgcolor=""#EEEEEE"">" & _
TD.Replace("<!--VALUE-->", Collection.Keys(i)) & " " & _
TD.Replace("<!--VALUE-->", Collection(i)) & "</TR> "
Next i
End If
'Table Footer
Return MyHTML & "</TABLE>"
End Function
Private Shared Function CollectionToHtmlTable(ByVal Collection As
HttpCookieCollection) As String
'Converts HttpCookieCollection to NameValueCollection()
Dim NVC As NameValueCollection = New NameValueCollection
Dim i As Integer
Dim Value As String
Try
If Collection.Count > 0 Then
For i = 0 To Collection.Count - 1
NVC.Add(Collection.Keys(i), Collection(i).Value)
Next i
End If
Value = CollectionToHtmlTable(NVC)
Return Value
Catch MyError As Exception
MyError.ToString()
End Try
End Function
Private Shared Function CollectionToHtmlTable(ByVal Collection As
System.Web.SessionState.HttpSessionState) As String
'Converts HttpSessionState to NameValueCollection
Dim NVC As NameValueCollection = New NameValueCollection
Dim i As Integer
Dim Value As String
If Not Collection Is Nothing Then
If Collection.Count > 0 Then
For i = 0 To Collection.Count - 1
NVC.Add(Collection.Keys(i),
Collection(i).ToString())
Next i
End If
Value = CollectionToHtmlTable(NVC)
End If
Return Value
End Function
Private Shared Function CleanHTML(ByVal HTML As String) As String
If HTML.Length <> 0 Then
HTML.Replace("<", "<").Replace("\r\n", "<BR>").Replace("&",
"&").Replace(" ", " ")
Else
HTML = ""
End If
Return HTML
End Function
Public Shared Function BuildErrorReport(ByVal exc As Exception,
ByVal iLevel As Integer) As String
'Takes information from the aspproNETException and turns it into
English.
'Returns information recursively for as many InnerExceptions as
there are.
Dim sb As New System.text.StringBuilder
sb.Length = 0 'Clear the buffer
'Info provided by Exception object
sb.Append("Exception object info for level " & iLevel.ToString &
":" & vbCrLf)
sb.Append(vbTab & "Exception Type: " & exc.GetType.ToString &
vbCrLf)
sb.Append(vbTab & "Message: " & exc.Message & vbCrLf)
sb.Append(vbTab & "Source: " & exc.Source & vbCrLf)
sb.Append(vbTab & "Target Site: " & exc.TargetSite.Name &
vbCrLf)
sb.Append("Stack Trace: " & vbCrLf & exc.StackTrace & vbCrLf &
vbCrLf)
If Not exc.InnerException Is Nothing Then
sb.Append(BuildErrorReport(exc.InnerException, iLevel + 1))
End If
Return sb.ToString
End Function
End Class
End Namespace
Sub Application_Error(ByVal sender As Object, ByVal e As EventArgs)
'Server.GetLastError is a useful method you can use pretty much
anywhere you handle exceptions programmatically.
'But what you always get from this method is an
HttpUnhandledException object.
'You must use this object's InnerException property to get
information about the exception that actually caused the problem.
'Grab a reference to the last error. Use InnerException because
'ASP.NET wraps errors here in an HttpUnhandledException.
Dim LastEx As Exception = Server.GetLastError.InnerException
Dim sb As New System.Text.StringBuilder
If Not LastEx Is Nothing Then
sb.Append(eTime.ModError.BuildErrorReport(LastEx, 1))
Else
sb.Append("No error information available.")
End If
Try
' HKLM\SYSTEM\CurrentControlSet\Services\EventLog\Security
ACCESS DENIED!
' had to grant write access ASPNET for this hive
' HKLM\SYSTEM\CurrentControlSet\Services\EventLog
Dim el As New EventLog
el.WriteEntry("TimeSheet Web App", sb.ToString, _
EventLogEntryType.Error, 65535)
el.Close()
Catch ex As Exception
HttpContext.Current.Trace.Warn("eventlog", ex.ToString)
End Try
' Build a MailMessage
Dim mailMessage As Mail.MailMessage = New Mail.MailMessage
mailMessage.From = ConfigurationSettings.AppSettings("ErrorEmail")
mailMessage.To = ConfigurationSettings.AppSettings("ErrorEmail")
mailMessage.Subject = "Error in TimeSheet App"
mailMessage.BodyFormat = Mail.MailFormat.Html
If Not LastEx Is Nothing Then
mailMessage.Body = Replace(sb.ToString, vbCrLf, "<br>") &
"<br><br><hr><br><br>" & eTime.ModError.GetHTMLError(LastEx)
Else
mailMessage.Body = sb.ToString ' send what we know at least
End If
If ConfigurationSettings.AppSettings("EnableErrorEmail") = "1" Then
Try
Mail.SmtpMail.SmtpServer = "localhost"
Mail.SmtpMail.Send(mailMessage)
Catch ex As Exception
HttpContext.Current.Trace.Warn("email", ex.ToString)
End Try
End If
End Sub
