Add a Form with name frmDebug in the page and write the code in it.
Imports System.Reflection
Public Class frmDebug
''Public Property ParentControl As Control = Nothing
Public Sub New()
On Error Resume Next
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
rtfError.AppendText("Product Name: " & My.Application.Info.ProductName & vbNewLine)
rtfError.AppendText("Product Version: " & My.Application.Info.Version.ToString() & vbNewLine)
Dim asms As New List(Of Assembly)
For Each asm As Assembly In My.Application.Info.LoadedAssemblies
asms.Add(asm)
Next asm
'Assemblies are listed in the order they are loaded - I prefer them alphabetical.
'But if the order in which assemblies are being loaded is important, then don't do the sort.
Dim asmc As New AsmComparer()
asms.Sort(asmc)
rtfError.AppendText(vbNewLine)
For Each asm As Assembly In asms
'Many of the assemblies are core .Net assemblies. I do not care about them.
'If you do, comemnt out this next line:
''If IO.Path.GetDirectoryName(asm.Location).ToUpper() <> My.Application.Info.DirectoryPath.ToUpper() Then Continue For
'Included in this list is the executable path - which is meaningless.
'Have to cast to Upper (or lower), because one of the paths returns as .EXE, and the other .exe
If asm.Location.ToUpper() = Application.ExecutablePath.ToUpper() Then Continue For
rtfError.AppendText("Loaded Assembly: " & asm.ToString() & vbNewLine)
Next asm
rtfError.AppendText(vbNewLine)
rtfError.AppendText("OS Name: " & My.Computer.Info.OSFullName & vbNewLine)
rtfError.AppendText("OS Version: " & My.Computer.Info.OSVersion & vbNewLine)
''IMPORTANT: This next line is .Net 4.0 only.
'' If you need to know if it is a 64 bit OS or not, you will need to use
'' a different method for any .Net older than 4.0
rtfError.AppendText("OS Platform: " & IIf(Environment.Is64BitOperatingSystem, "x64", "x86") & vbNewLine)
rtfError.AppendText("Physical Memory: " & FormatBytes(My.Computer.Info.AvailablePhysicalMemory) & " / " & FormatBytes(My.Computer.Info.TotalPhysicalMemory) & " (Free / Total)" & vbNewLine)
rtfError.AppendText("Virtual Memory: " & FormatBytes(My.Computer.Info.AvailableVirtualMemory) & " / " & FormatBytes(My.Computer.Info.TotalVirtualMemory) & " (Free / Total)" & vbNewLine)
rtfError.AppendText(vbNewLine)
rtfError.AppendText("Error Output:" & vbNewLine)
End Sub
Private Function FormatBytes(ByVal bytes As Long) As String
If bytes < 1000 Then
Return CStr(bytes) & "B"
ElseIf bytes < 1000000 Then
Return FormatNumber(bytes / 1024, 2) & "KB"
ElseIf bytes < 1000000000 Then
Return FormatNumber(bytes / 1048576, 2) & "MB"
Else
Return FormatNumber(bytes / 1073741824, 2) & "GB"
End If
End Function
Private Class AsmComparer
Implements IComparer(Of Assembly)
Public Function Compare(x As System.Reflection.Assembly, y As System.Reflection.Assembly) As Integer Implements System.Collections.Generic.IComparer(Of System.Reflection.Assembly).Compare
Return String.Compare(x.ToString(), y.ToString())
End Function
End Class
Private Sub mnuCopy_Click(sender As System.Object, e As System.EventArgs) Handles mnuCopy.Click
btnCopy_Click(btnCopy, e)
End Sub
Private Sub btnCopy_Click(sender As System.Object, e As System.EventArgs) Handles btnCopy.Click
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(rtfError.Text, TextDataFormat.Text)
My.Computer.Clipboard.SetText(rtfError.Rtf, TextDataFormat.Rtf)
End Sub
Private Sub frmDebug_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'OPTIONAL: This is just some basic code to dynamically size the output window based on the text.
On Error Resume Next
Dim longest As String = ""
For Each line As String In rtfError.Lines
If line.Length > longest.Length Then longest = line
Next line
Dim g As Graphics = rtfError.CreateGraphics()
Dim w As Integer = CInt(g.MeasureString(longest, rtfError.Font).Width) + 88
Dim h As Integer = CInt(g.MeasureString(rtfError.Text, rtfError.Font).Height) + 200
Dim s As Screen = Screen.FromControl(Me)
''If ParentControl IsNot Nothing Then s = Screen.FromControl(ParentControl)
If Me.Width < w Then
If w < (s.WorkingArea.Width - 88) Then
Me.Width = w
Else
Me.Width = (s.WorkingArea.Width - 88)
End If
Me.Left = s.WorkingArea.Left + ((s.WorkingArea.Width / 2) - (Me.Width / 2))
End If
If Me.Height < h Then
If h < (s.WorkingArea.Height - 88) Then
Me.Height = h
Else
Me.Height = (s.WorkingArea.Height - 88)
End If
Me.Top = s.WorkingArea.Top + ((s.WorkingArea.Height / 2) - (Me.Height / 2))
End If
End Sub
End Class
This will wipe out the error frmDebug is not defined and rtfError is not defined.
All codes
MyApplication
Namespace My
Partial Friend Class MyApplication
'One of the global exceptions we are catching is not thread safe, so we need to make it thread safe first.
Private Delegate Sub SafeApplicationThreadException(ByVal sender As Object, ByVal e As Threading.ThreadExceptionEventArgs)
Private Sub ShowDebugOutput(ByVal ex As Exception)
'Display the output form
Dim frmD As New frmDebug()
frmD.rtfError.AppendText(ex.ToString())
frmD.ShowDialog()
Environment.Exit(0)
End Sub
Private Sub MyApplication_Startup(ByVal sender As Object, ByVal e As Microsoft.VisualBasic.ApplicationServices.StartupEventArgs) Handles Me.Startup
AddHandler AppDomain.CurrentDomain.UnhandledException, AddressOf AppDomain_UnhandledException
AddHandler System.Windows.Forms.Application.ThreadException, AddressOf app_ThreadException
End Sub
Private Sub app_ThreadException(ByVal sender As Object, ByVal e As Threading.ThreadExceptionEventArgs)
If MainForm.InvokeRequired Then
' Invoke back to the main thread
MainForm.Invoke(New SafeApplicationThreadException(AddressOf app_ThreadException), New Object() {sender, e})
Else
ShowDebugOutput(e.Exception)
End If
End Sub
Private Sub AppDomain_UnhandledException(ByVal sender As Object, ByVal e As UnhandledExceptionEventArgs)
ShowDebugOutput(DirectCast(e.ExceptionObject, Exception))
End Sub
Private Sub MyApplication_UnhandledException(sender As Object, e As Microsoft.VisualBasic.ApplicationServices.UnhandledExceptionEventArgs) Handles Me.UnhandledException
ShowDebugOutput(e.Exception)
End Sub
End Class
End Namespace
frmMain
Public Class frmMain
Private Sub btnThrow_Click(sender As System.Object, e As System.EventArgs) Handles btnThrow.Click
Dim ctl As Control
ctl.Text = "This will throw a null exception!"
End Sub
End Class
frmDebug
Imports System.Reflection
Public Class frmDebug
''Public Property ParentControl As Control = Nothing
Public Sub New()
On Error Resume Next
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
rtfError.AppendText("Product Name: " & My.Application.Info.ProductName & vbNewLine)
rtfError.AppendText("Product Version: " & My.Application.Info.Version.ToString() & vbNewLine)
Dim asms As New List(Of Assembly)
For Each asm As Assembly In My.Application.Info.LoadedAssemblies
asms.Add(asm)
Next asm
Dim asmc As New AsmComparer()
asms.Sort(asmc)
rtfError.AppendText(vbNewLine)
For Each asm As Assembly In asms
If asm.Location.ToUpper() = Application.ExecutablePath.ToUpper() Then Continue For
rtfError.AppendText("Loaded Assembly: " & asm.ToString() & vbNewLine)
Next asm
rtfError.AppendText(vbNewLine)
rtfError.AppendText("OS Name: " & My.Computer.Info.OSFullName & vbNewLine)
rtfError.AppendText("OS Version: " & My.Computer.Info.OSVersion & vbNewLine)
rtfError.AppendText("OS Platform: " & IIf(Environment.Is64BitOperatingSystem, "x64", "x86") & vbNewLine)
rtfError.AppendText("Physical Memory: " & FormatBytes(My.Computer.Info.AvailablePhysicalMemory) & " / " & FormatBytes(My.Computer.Info.TotalPhysicalMemory) & " (Free / Total)" & vbNewLine)
rtfError.AppendText("Virtual Memory: " & FormatBytes(My.Computer.Info.AvailableVirtualMemory) & " / " & FormatBytes(My.Computer.Info.TotalVirtualMemory) & " (Free / Total)" & vbNewLine)
rtfError.AppendText(vbNewLine)
rtfError.AppendText("Error Output:" & vbNewLine)
End Sub
Private Function FormatBytes(ByVal bytes As Long) As String
If bytes < 1000 Then
Return CStr(bytes) & "B"
ElseIf bytes < 1000000 Then
Return FormatNumber(bytes / 1024, 2) & "KB"
ElseIf bytes < 1000000000 Then
Return FormatNumber(bytes / 1048576, 2) & "MB"
Else
Return FormatNumber(bytes / 1073741824, 2) & "GB"
End If
End Function
Private Class AsmComparer
Implements IComparer(Of Assembly)
Public Function Compare(x As System.Reflection.Assembly, y As System.Reflection.Assembly) As Integer Implements System.Collections.Generic.IComparer(Of System.Reflection.Assembly).Compare
Return String.Compare(x.ToString(), y.ToString())
End Function
End Class
Private Sub mnuCopy_Click(sender As System.Object, e As System.EventArgs) Handles mnuCopy.Click
btnCopy_Click(btnCopy, e)
End Sub
Private Sub btnCopy_Click(sender As System.Object, e As System.EventArgs) Handles btnCopy.Click
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(rtfError.Text, TextDataFormat.Text)
My.Computer.Clipboard.SetText(rtfError.Rtf, TextDataFormat.Rtf)
End Sub
Private Sub frmDebug_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'OPTIONAL: This is just some basic code to dynamically size the output window based on the text.
On Error Resume Next
Dim longest As String = ""
For Each line As String In rtfError.Lines
If line.Length > longest.Length Then longest = line
Next line
Dim g As Graphics = rtfError.CreateGraphics()
Dim w As Integer = CInt(g.MeasureString(longest, rtfError.Font).Width) + 88
Dim h As Integer = CInt(g.MeasureString(rtfError.Text, rtfError.Font).Height) + 200
Dim s As Screen = Screen.FromControl(Me)
''If ParentControl IsNot Nothing Then s = Screen.FromControl(ParentControl)
If Me.Width < w Then
If w < (s.WorkingArea.Width - 88) Then
Me.Width = w
Else
Me.Width = (s.WorkingArea.Width - 88)
End If
Me.Left = s.WorkingArea.Left + ((s.WorkingArea.Width / 2) - (Me.Width / 2))
End If
If Me.Height < h Then
If h < (s.WorkingArea.Height - 88) Then
Me.Height = h
Else
Me.Height = (s.WorkingArea.Height - 88)
End If
Me.Top = s.WorkingArea.Top + ((s.WorkingArea.Height / 2) - (Me.Height / 2))
End If
End Sub
End Class