전역 오류 확인 및 전달 로직

1. Application.vb 에 아래 내용 셋팅

Namespace My
    ' MyApplication에 대해 다음 이벤트를 사용할 수 있습니다.
    ' Startup: 애플리케이션이 시작되고 시작 폼이 만들어지기 전에 발생합니다.
    ' Shutdown: 모든 애플리케이션 폼이 닫힌 후에 발생합니다.  이 이벤트는 애플리케이션이 비정상적으로 종료되는 경우에는 발생하지 않습니다.
    ' UnhandledException: 애플리케이션에서 처리되지 않은 예외가 발생하는 경우 이 이벤트가 발생합니다.
    ' StartupNextInstance: 단일 인스턴스 애플리케이션을 시작할 때 해당 애플리케이션이 이미 활성 상태인 경우 발생합니다.
    ' NetworkAvailabilityChanged: 네트워크가 연결되거나 연결이 끊어질 때 발생합니다.
    Partial Friend Class MyApplication

        ' 모든 전역 예외 중 하나는 안전하지 않아 안전한 쓰레드를 만듬
        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 Err_Form()   '' <<< 출력할 창을 지정
            frmD.rtfError.AppendText(ex.ToString())
            frmD.ShowDialog()

            'Perform application cleanup
            'TODO: Add your application cleanup code here.

            'Exit the application - Or try to recover from the exception:
            Environment.Exit(0)

        End Sub

        Private Sub app_ThreadException(ByVal sender As Object, ByVal e As Threading.ThreadExceptionEventArgs)

            'This is not thread safe, so make it thread safe.
            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 ApplicationStartUp(ByVal sender As Object, ByVal e As Microsoft.VisualBasic.ApplicationServices.StartupEventArgs) Handles Me.Startup

            'There are three places to catch all global unhandled exceptions:
            'AppDomain.CurrentDomain.UnhandledException event.
            'System.Windows.Forms.Application.ThreadException event.
            'MyApplication.UnhandledException event.
            AddHandler AppDomain.CurrentDomain.UnhandledException, AddressOf AppDomain_UnhandledException
            AddHandler System.Windows.Forms.Application.ThreadException, AddressOf app_ThreadException

        End Sub
        Private Sub ApplicationShutdown(ByVal sender As Object, ByVal e As Microsoft.VisualBasic.ApplicationServices.StartupEventArgs) Handles Me.Startup

        End Sub
        Private Sub MyApplication_UnhandledException(sender As Object, e As Microsoft.VisualBasic.ApplicationServices.UnhandledExceptionEventArgs) Handles Me.UnhandledException
            'MessageBox.Show(e.Exception.ToString) '<-- the exception object
            'e.ExitApplication = True '<-- True if you want the application to close; false to continue - if it can
            ShowDebugOutput(e.Exception)
        End Sub
    End Class
End Namespace

2. 에레 메시지 노출 할 Form 생성

Imports System.Reflection

Public Class Err_Form

    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 Sub Btn_Copy_Click(sender As Object, e As EventArgs) Handles Btn_Copy.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 Btn_Register_Click(sender As Object, e As EventArgs) Handles Btn_Register.Click
        'On Error Resume Next
        MsgBox("인터넷 창이 열리면 [문의접수] 버튼을 눌러주신 후 접수해주세요!")

        Dim Member_ID As String = "2104574"
        Dim Connect_URL As String = $"http://ittok.svctop-sys.com/index?mbIdx={Member_ID}"
        Process.Start(Connect_URL)

    End Sub
    Public Class AsmComparer
        Implements IComparer(Of Assembly)

        Public Function Compare(x As System.Reflection.Assembly, y As System.Reflection.Assembly) As Integer Implements IComparer(Of Reflection.Assembly).Compare

            Return String.Compare(x.ToString(), y.ToString())

        End Function
    End Class

End Class