السلام عليكم ورحمة الله
اولا اشكرا الاستاذ عبدالله الدوسري تعلمت منه شي جديد
وكنت بغيت طريقة ارسال الايميل وطريقة ضهورة رساله الغلط بشكل جميل
غير الشكل المزعج للعملاء
[
attachment=18356]
والحمدالله بعد عدة تجارب وبحث حصلت كود وقمت بالتعديل عليه واضافة خيار الايميل وشغال تمام الحمدالله
[
attachment=18357]
والطريقة في ملف
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)
وفي النهاية اكرر شكري للاستاذ عبدالله تعلمنا منك شي جديد
شكرا
