[dubai.eig]

السلام عليكم ورحمة الله

اولا اشكرا الاستاذ عبدالله الدوسري تعلمت منه شي جديد 

وكنت بغيت طريقة ارسال الايميل وطريقة ضهورة رساله الغلط بشكل جميل 

غير الشكل المزعج للعملاء
   


والحمدالله بعد عدة تجارب وبحث حصلت كود وقمت بالتعديل عليه واضافة خيار الايميل وشغال تمام الحمدالله

   

والطريقة في ملف
myapplicationevents.vb

نفس طريقة شرح استاذنا عبدالله

انا اضفت هذا الكود

كود :

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

وعملت ملف جديد باسم
frmDebug.vb

والكود

كود :

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

والرساله الي توصل فيها معلومات الجهاز والمشكله

إقتباس :       ' 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)

وفي النهاية اكرر شكري للاستاذ عبدالله تعلمنا منك شي جديد 


شكرا