[مثال] شرح بسيط لجملة إصطياد الأخطاء Try ... Catch ... Finally Statement

كود :

Namespace My



    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 frmDebug()

            frmD.rtfError.AppendText(ex.ToString())

            frmD.ShowDialog()







        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)



            '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 MyApplication_UnhandledException(sender As Object, e As Microsoft.VisualBasic.ApplicationServices.UnhandledExceptionEventArgs) Handles Me.UnhandledException



            ShowDebugOutput(e.Exception)



        End Sub

    End Class





End Namespace

كود :

Imports System.Net.Mail

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:   " & ver & vbNewLine)







        rtfError.AppendText(vbNewLine)

        rtfError.AppendText("OS Name:           " & My.Computer.Info.OSFullName & 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(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



        Me.Close()



    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.

        Text = "unexpected error occurred!"

        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









    Private Sub btnOk_Click(sender As Object, e As EventArgs) Handles btnOk.Click

        Try



            Dim Smtp_Server As New SmtpClient

            Dim e_mail As New MailMessage()

            Smtp_Server.UseDefaultCredentials = False

            Smtp_Server.Credentials = New Net.NetworkCredential("error@error.net", "pas")

            Smtp_Server.Port = 587

            Smtp_Server.EnableSsl = True

            Smtp_Server.Host = "mail.error.net"



            e_mail = New MailMessage()

            e_mail.From = New MailAddress("error@error.net")

            e_mail.To.Add("error@error.net")

            e_mail.Subject = "ERROR"

            e_mail.IsBodyHtml = False

            e_mail.Body = rtfError.Text & TextDataFormat.Text

            Smtp_Server.Send(e_mail)

            MsgBox("Mail Sent Thanks  ")



        Catch error_t As Exception

            MsgBox(error_t.ToString)

        End Try

    End Sub

End Class