Imports System.Net.Mail Public Class clsMailClient Dim m_empfaenger As String Property Empfaenger As String Get Return m_empfaenger End Get Set(value As String) m_empfaenger = value End Set End Property Public Enum EmpfangerFrom Behandlung Rechnung LetzteRechnung Dokument End Enum Public Function Read_Empfaenger(ByVal Behandlungsnr As String, ByVal Fakturanr As String, ByVal FromLastFaktura As Boolean) As Integer Try Dim msgfirma As Integer = 0 Dim debitor As Integer Dim db As New clsDB If FromLastFaktura = True Then db.Get_Tabledata("fak", "", "select top 1 nrdebitor from faktura order by nrfaktura desc") debitor = db.dsDaten.Tables(0).Rows(0).Item(0) End If If Behandlungsnr <> "" Then db.Get_Tabledata("fak", "", "select top 1 * from behandlu where nrbehandlung=" + Behandlungsnr) If db.dsDaten.Tables(0).Rows(0).Item("nrgarant") > 0 Then debitor = db.dsDaten.Tables(0).Rows(0).Item("nrgarant") Else debitor = db.dsDaten.Tables(0).Rows(0).Item("nrpatient") End If End If If Fakturanr <> "" Then db.Get_Tabledata("fak", "", "select top 1 nrdebitor from faktura where nrfaktura=" + Fakturanr) End If If debitor > 49000 Then db.Get_Tabledata("fak", "", "Select isnull(e_mail,'') from firma where nrfirma=" + debitor.ToString) msgfirma = 1 Else db.Get_Tabledata("fak", "", "select isnull(e_mail,'') from privat where nrprivat=" + debitor.ToString) End If Me.Empfaenger = db.dsDaten.Tables(0).Rows(0).Item(0) Return msgfirma Catch ex As Exception MsgBox(ex.Message) Me.Empfaenger = "" End Try End Function Public Sub CreateOutlookMail(type As EmpfangerFrom, ByVal keyvalue As String, ByVal Attachment As String, Optional Mailtext As Integer = 0) Dim msgnrfirma As Integer Select Case type Case EmpfangerFrom.Behandlung msgnrfirma = Read_Empfaenger(keyvalue, "", False) Case EmpfangerFrom.Rechnung msgnrfirma = Read_Empfaenger("", keyvalue, False) Case EmpfangerFrom.LetzteRechnung msgnrfirma = Read_Empfaenger("", "", True) Case Else Me.Empfaenger = "" End Select If type = 1 Then End If If msgnrfirma = 1 And (Mailtext = 1 Or Mailtext = 2 Or Mailtext = 3) Then Mailtext = Mailtext + 10 Dim db As New clsDB Dim Mailclient As String = UCase(db.Get_Option(9805)) Dim betreff As String = "" Dim inhalt As String = "" Get_Mail_Text(Mailtext, betreff, inhalt, keyvalue) If UCase(db.Get_Option(51004)) = "TRUE" Then Dim f As New frmMailClient f.txtAbsender.Text = db.Get_Option(51000) f.txtEmpfaenger.Text = Me.Empfaenger f.txtBetreff.Text = betreff f.txtInhalt.Text = inhalt f.lblAttachment.Text = Attachment f.ShowDialog() If f.DialogResult = DialogResult.OK Then Me.Empfaenger = f.txtEmpfaenger.Text betreff = f.txtBetreff.Text inhalt = f.txtInhalt.Text Else Exit Sub End If End If Select Case Mailclient Case "OUTLOOK" Dim Outl As Object Outl = CreateObject("Outlook.Application") If Outl IsNot Nothing Then Dim omsg As Object omsg = Outl.CreateItem(0) omsg.To = Me.Empfaenger omsg.bcc = "" 'Dim betreff As String = "" 'Dim inhalt As String = "" 'If Mailtext <> 0 Then ' omsg.body = Get_Mail_Text(Mailtext, betreff, inhalt, keyvalue) 'End If omsg.body = inhalt omsg.subject = betreff omsg.body = inhalt omsg.Attachments.Add(Attachment) omsg.Display(True) End If Case "MAPI" 'Dim betreff As String = "" 'Dim inhalt As String = "" 'If Mailtext <> 0 Then ' Get_Mail_Text(Mailtext, betreff, inhalt, keyvalue) 'End If Dim mapi As New MapiMail mapi.AddAttachment(Attachment) mapi.AddRecipientTo(Me.Empfaenger) mapi.SendMailPopup(betreff, inhalt) Case "GMAILOld" Try Dim mdb As New clsDB 'Dim betreff As String = "" 'Dim inhalt As String = "" 'If Mailtext <> 0 Then ' Get_Mail_Text(Mailtext, betreff, inhalt, keyvalue) 'End If Dim mail As MailMessage = New MailMessage() Dim SmtpServer As SmtpClient = New SmtpClient(mdb.Get_Option(51001)) mail.From = New MailAddress(mdb.Get_Option(51000)) mail.To.Add(Me.Empfaenger) mail.Subject = betreff mail.Body = inhalt Dim gmailattachment As System.Net.Mail.Attachment gmailattachment = New System.Net.Mail.Attachment(Attachment) mail.Attachments.Add(gmailattachment) SmtpServer.Port = 578 SmtpServer.Credentials = New System.Net.NetworkCredential(mdb.Get_Option(51002), mdb.Get_Option(51003)) SmtpServer.EnableSsl = True SmtpServer.Send(mail) MessageBox.Show("mail Send") Catch ex As Exception Console.WriteLine(ex.ToString()) End Try Case "GMAIL" Dim mdb As New clsDB 'Dim betreff As String = "" 'Dim inhalt As String = "" 'If Mailtext <> 0 Then 'Get_Mail_Text(Mailtext, betreff, inhalt, keyvalue) 'End If Dim GGmail As New GGSMTP_GMAIL(mdb.Get_Option(51002), mdb.Get_Option(51003), "smtp.gmail.com", 587, True) Dim ToAddressies As String() = {Me.Empfaenger} Dim attachs() As String = {Attachment} Dim subject As String = betreff Dim body As String = inhalt Dim result As Boolean = GGmail.SendMail(ToAddressies, subject, body, attachs) If result Then MsgBox("Mail an " + Me.Empfaenger + " erfolgreich versendet.", MsgBoxStyle.Information) Else MsgBox(GGmail.ErrorText, MsgBoxStyle.Critical) End If Case Else MsgBox("Kein Mail-Client verfügbar.") End Select End Sub Public Function Get_Mail_Text(ByVal Mailtext As Integer, ByRef betreff As String, ByRef inhalt As String, ByVal keyvalue As String) Dim db As New clsDB Try betreff = Get_Mailtext(Mailtext, 1, keyvalue) inhalt = Get_Mailtext(Mailtext, 2, keyvalue) Return "" db.Get_Tabledata("Mailtext", "", "Select betreff,Inhalt from mailtexte where eintragnr=" + Mailtext.ToString) betreff = db.dsDaten.Tables(0).Rows(0).Item(0) inhalt = db.dsDaten.Tables(0).Rows(0).Item(1) db.Get_Tabledata("Behandlu", " where nrbehandlung=" + keyvalue.ToString) If db.dsDaten.Tables(0).Rows.Count > 0 Then 'replace_text(inhalt, db.dsDaten.Tables(0).Rows(0), Mailtext) 'replace_text(betreff, db.dsDaten.Tables(0).Rows(0), Mailtext) End If Return db.dsDaten.Tables(0).Rows(0).Item(0) Catch Return "" Finally db.Dispose() End Try End Function Public Function Get_Mailtext(ByVal nr As Integer, typ As Integer, keyvalue As Integer) As String Dim paramdaten As New DataTable Dim dbr As DataRow = paramdaten.NewRow Dim db As New clsDB paramdaten.Columns.Clear() paramdaten.Rows.Clear() dbr = paramdaten.NewRow paramdaten.Columns.Add("Paramname") paramdaten.Columns.Add("Paramvalue") dbr(0) = "@behandlungsnr" dbr(1) = keyvalue paramdaten.Rows.Add(dbr) dbr = paramdaten.NewRow dbr(0) = "@typ" dbr(1) = typ paramdaten.Rows.Add(dbr) dbr = paramdaten.NewRow dbr(0) = "@mailtextnr" dbr(1) = nr paramdaten.Rows.Add(dbr) db.Get_Tabledata("sp_get_mailtexte", "", "", "", True, paramdaten) Try Return db.dsDaten.Tables(0).Rows(0).Item(0) Catch ex As Exception Return "" End Try End Function End Class Public Class GGSMTP_GMAIL Dim Temp_GmailAccount As String Dim Temp_GmailPassword As String Dim Temp_SMTPSERVER As String Dim Temp_ServerPort As Int32 Dim Temp_ErrorText As String = "" Dim Temp_EnableSSl As Boolean = True Public ReadOnly Property ErrorText() As String Get Return Temp_ErrorText End Get End Property Public Property EnableSSL() As Boolean Get Return Temp_EnableSSl End Get Set(ByVal value As Boolean) Temp_EnableSSl = value End Set End Property Public Property GmailAccount() As String Get Return Temp_GmailAccount End Get Set(ByVal value As String) Temp_GmailAccount = value End Set End Property Public Property GmailPassword() As String Get Return Temp_GmailPassword End Get Set(ByVal value As String) Temp_GmailPassword = value End Set End Property Public Property SMTPSERVER() As String Get Return Temp_SMTPSERVER End Get Set(ByVal value As String) Temp_SMTPSERVER = value End Set End Property Public Property ServerPort() As Int32 Get Return Temp_ServerPort End Get Set(ByVal value As Int32) Temp_ServerPort = value End Set End Property Public Sub New(ByVal GmailAccount As String, ByVal GmailPassword As String, Optional ByVal SMTPSERVER As String = "smtp.gmail.com", Optional ByVal ServerPort As Int32 = 587, Optional ByVal EnableSSl As Boolean = True) Temp_GmailAccount = GmailAccount Temp_GmailPassword = GmailPassword Temp_SMTPSERVER = SMTPSERVER Temp_ServerPort = ServerPort Temp_EnableSSl = EnableSSl End Sub Public Function SendMail(ByVal ToAddressies As String(), ByVal Subject As String, ByVal BodyText As String, Optional ByVal AttachedFiles As String() = Nothing) As Boolean Temp_ErrorText = "" Dim Mail As New MailMessage Dim SMTP As New SmtpClient(Temp_SMTPSERVER) Mail.Subject = Subject Mail.From = New MailAddress(Temp_GmailAccount) SMTP.UseDefaultCredentials = False SMTP.Credentials = New System.Net.NetworkCredential(Temp_GmailAccount, Temp_GmailPassword) '<-- Password Here SMTP.DeliveryMethod = SmtpDeliveryMethod.Network Mail.To.Clear() For i As Int16 = 0 To ToAddressies.Length - 1 Mail.To.Add(ToAddressies(i)) Next i Mail.Body = BodyText Mail.Attachments.Clear() If AttachedFiles IsNot Nothing Then For i As Int16 = 0 To AttachedFiles.Length - 1 Mail.Attachments.Add(New Attachment(AttachedFiles(i))) Next End If SMTP.EnableSsl = Temp_EnableSSl SMTP.Port = Temp_ServerPort Try SMTP.Send(Mail) Return True Catch ex As Exception Me.Temp_ErrorText = ex.Message.ToString Return False End Try End Function End Class