Imports System.Drawing Imports System.Drawing.Imaging Imports System.IO Imports System.Reflection Imports System.Text Imports System.Windows.Forms Imports System.Management Imports iTextSharp.xmp.impl.xpath Imports Microsoft.Office.Interop Imports Microsoft.Office.Interop.Outlook Public Class frmErrorMeldung Dim err_meldung Dim err_stack Dim err_zp As DateTime = Now Dim err_title Dim screenshotUrl Sub New(err_meldung As String, err_stack As String, Optional err_title As String = "", Optional screenshotUrl As String = "") ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() Me.err_meldung = err_meldung Me.err_stack = err_stack Me.err_title = err_title Me.screenshotUrl = screenshotUrl ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnClose.Click Me.Close() End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Cursor = Cursors.WaitCursor lblErr_Nachricht.Visible = False If txtNachricht.Text.Trim = "" Then lblErr_Nachricht.Visible = True Exit Sub End If If txtNachricht.Text.Contains("neu") And txtNachricht.Text.Contains("programmier") Then MsgBox("AVISO wird neu programmiert.... fertig!" & vbNewLine & vbNewLine & "Fehler ist leider immer noch da!" & vbNewLine & "(Abbruch)") Exit Sub End If If txtNachricht.Text.Length <= 3 Then MsgBox("Etwas genauer bitte...") Exit Sub End If Dim Mail_To = "support@verag.ag" Dim Mail_Text = "" Mail_Text &= "User: " & VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME & " (" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRNAME & ")" & "
" Mail_Text &= "Zeitpunkt: " & err_zp.ToString("dd.MM.yyyy HH:mm:ss") & "

" 'Mail_Text &= "Programm: " & VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME & " (" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRNAME & ")" & vbNewLine 'Mail_Text &= "User: " & VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME & " (" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRNAME & ")" & vbNewLine Mail_Text = Mail_Text.Replace("BmWr501956", "*******") Mail_Text = Mail_Text.Replace("+d#XisdBbSt!", "*******") Mail_Text = Mail_Text.Replace("wassermann", "*******") Mail_Text &= "
" & "User-Nachricht:" & "
" & txtNachricht.Text.Trim & "
" Mail_Text &= "
" & "Error:" & "
" & TextBox2.Text.Trim Dim outl As New Outlook.Application Dim Mail As Microsoft.Office.Interop.Outlook.MailItem Mail = outl.CreateItem(0) Mail.Subject = ("ERROR-TICKET " & err_title).trim Mail.HTMLBody = Mail_Text Mail.To = Mail_To If cbxScreenshot.Checked Then Mail.Attachments.Add(screenshotUrl, Microsoft.Office.Interop.Outlook.OlAttachmentType.olByValue, , "Screenshot.jpeg") End If If cbxEnviromentVariables.Checked Then If Not My.Computer.FileSystem.DirectoryExists(My.Computer.FileSystem.SpecialDirectories.Temp & "\Screenshots_" & My.Application.Info.AssemblyName & "\") Then My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.SpecialDirectories.Temp & "\Screenshots_" & My.Application.Info.AssemblyName & "\") End If Dim filename = "SystemEnviroment_" & Now.ToFileTime & "_.txt" Dim strFile As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\Screenshots_" & My.Application.Info.AssemblyName & "\" & filename Dim fileExists As Boolean = File.Exists(strFile) Using sw As New StreamWriter(File.Open(strFile, FileMode.CreateNew)) createSystemInformation(sw) sw.Close() Mail.Attachments.Add(strFile, Microsoft.Office.Interop.Outlook.OlAttachmentType.olByValue, , filename) End Using End If Try Mail.Send() Me.Close() Catch ex As System.Exception Cursor = Cursors.WaitCursor MsgBox(ex.Message) End Try End Sub Private Sub frmErrorMeldung_Load(sender As Object, e As EventArgs) Handles Me.Load TextBox2.Text = err_meldung & vbNewLine & vbNewLine & err_stack If screenshotUrl <> "" Then cbxScreenshot.Enabled = True cbxScreenshot.Checked = True Else cbxScreenshot.Enabled = False cbxScreenshot.Checked = False End If cbxEnviromentVariables.Enabled = True cbxEnviromentVariables.Checked = True End Sub Private Sub frmErrorMeldung_Shown(sender As Object, e As EventArgs) Handles Me.Shown txtNachricht.Focus() End Sub Private Sub createSystemInformation(ByRef sw As StreamWriter) Dim str As String Dim nl As String = Environment.NewLine sw.WriteLine() sw.WriteLine("-- Environment members --") sw.WriteLine("CommandLine: {0}", Environment.CommandLine) Dim arguments As String() = Environment.GetCommandLineArgs() sw.WriteLine("GetCommandLineArgs: {0}", String.Join(", ", arguments)) sw.WriteLine("CurrentDirectory: {0}", Environment.CurrentDirectory) sw.WriteLine("ExitCode: {0}", Environment.ExitCode) sw.WriteLine("HasShutdownStarted: {0}", Environment.HasShutdownStarted) sw.WriteLine("MachineName: {0}", Environment.MachineName) sw.WriteLine("NewLine: {0} first line{0} second line{0} third line", Environment.NewLine) sw.WriteLine("OSVersion: {0}", Environment.OSVersion.ToString()) sw.WriteLine("StackTrace: '{0}'", Environment.StackTrace) sw.WriteLine("SystemDirectory: {0}", Environment.SystemDirectory) sw.WriteLine("TickCount: {0}", Environment.TickCount) sw.WriteLine("UserDomainName: {0}", Environment.UserDomainName) sw.WriteLine("UserInteractive: {0}", Environment.UserInteractive) sw.WriteLine("UserName: {0}", Environment.UserName) sw.WriteLine("Version: {0}", Environment.Version.ToString()) sw.WriteLine("WorkingSet: {0}", Environment.WorkingSet) Dim query As String = "My system drive is %SystemDrive% and my system root is %SystemRoot%" str = Environment.ExpandEnvironmentVariables(query) sw.WriteLine("ExpandEnvironmentVariables: {0} {1}", nl, str) sw.WriteLine("GetEnvironmentVariable: {0} My temporary directory is {1}.", nl, Environment.GetEnvironmentVariable("TEMP")) sw.WriteLine("GetEnvironmentVariables: ") Dim environmentVariables As IDictionary = Environment.GetEnvironmentVariables() For Each de As DictionaryEntry In environmentVariables sw.WriteLine((" {0} = {1}", de.Key, de.Value)) Next sw.WriteLine("GetFolderPath: {0}", Environment.GetFolderPath(Environment.SpecialFolder.System)) Dim drives As String() = Environment.GetLogicalDrives() sw.WriteLine("GetLogicalDrives: {0}", String.Join(", ", drives)) End Sub End Class