Global Error Handler in VB.Net
I saw the earier example of a global error handler written in C#, but needed it written in VB for my company. I translated the earlier work into my version in VB. It was suggested by a couple of people that I provide my VB version, so here it is. I just hope you find it useful. You can visit the C# version at: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=948&lngWId=10 It was submitted by Joel Thoms on 2/5/2003. Thanks to all that asked me to post the VB version. Special thanks to Charles Richardson for helping me track down a bug. When you paste the code into the IDE, most of the formatting should return.
AI
AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Source Code
'Code Module
Imports System
Imports System.Data
Imports System.Web
Imports System.Web.Mail
Imports System.Collections.Specialized
Module ModError
Public Sub SendHtmlError(ByVal Ex As Exception, ByVal EmailAddress As String)
Dim Mail As New MailMessage()
Mail.From = "ERROR_HANDLER"
Mail.To = EmailAddress
Mail.Subject = "Custom Intranet Error"
Mail.Body = GetHTMLError(Ex)
Mail.BodyFormat = MailFormat.Html
SmtpMail.SmtpServer = "100.1.1.1"
SmtpMail.Send(Mail)
End Sub
Public 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
Public 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 Function CollectionToHtmlTable(ByVal Collection As HttpCookieCollection) As String
'Converts HttpCookieCollection to NameValueCollection
Dim NVC = 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(i, Collection(i).Value)
Next i
End If
Value = CollectionToHtmlTable(NVC)
Return Value
Catch MyError As Exception
MyError.ToString()
End Try
End Function
Private Function CollectionToHtmlTable(ByVal Collection As System.Web.SessionState.HttpSessionState) As String
'Converts HttpSessionState to NameValueCollection
Dim NVC = New NameValueCollection()
Dim i As Integer
Dim Value As String
If Collection.Count > 0 Then
For i = 0 To Collection.Count - 1
NVC.Add(i, Collection(i).ToString())
Next i
End If
Value = CollectionToHtmlTable(NVC)
Return Value
End Function
Private 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
End Module
Original Comments (3)
Recovered from Wayback Machine