DVAG_Mailverteiler/mail_auslesen.vb
2023-01-06 08:51:03 +01:00

242 lines
6.4 KiB
VB.net

Option Explicit On
'Imports Microsoft.Office.Interop.Outlook
Imports MySql.Data.MySqlClient
Imports System.Globalization
Imports System.Text
Imports System.IO
Imports EAGetMail
Imports Chilkat
Public Class mail_auslesen
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles bt_start.Click
Timer_mail_auslesen.Start()
My.Settings.mail_auslesen = "1"
End Sub
Function _generateFileName(ByVal sequence As Integer) As String
Dim currentDateTime As DateTime = DateTime.Now
Return String.Format("{0}-{1:000}-{2:000}.eml",
currentDateTime.ToString("yyyyMMddHHmmss", New CultureInfo("en-US")),
currentDateTime.Millisecond,
sequence)
End Function
Public Sub einlesen()
System.Windows.Forms.Application.DoEvents()
Timer_mail_auslesen.Stop()
Dim connStr As String = "server=localhost;user=root;database=dvag_mailing;port=3306;password=;charset=utf8;"
Dim conn As New MySqlConnection(connStr)
Dim sqlcmd As New MySqlCommand
Dim dr
Dim dw
Dim mailing_ohne_freigabe
Dim strFile As String
Dim strFolderpath As String
Dim imap As New Chilkat.Imap
' Connect to an IMAP server.
' Use TLS
imap.Ssl = False
imap.Port = 150
Dim success As Boolean = imap.Connect("127.0.0.1")
If (success <> True) Then
Debug.WriteLine(imap.LastErrorText)
Exit Sub
End If
' Login
success = imap.Login("vorstand@mailing.geographie-dvag.de", "0!07N8,#nvLK6LiG^+PX")
If (success <> True) Then
Debug.WriteLine(imap.LastErrorText)
Exit Sub
End If
' Select an IMAP mailbox
success = imap.SelectMailbox("Inbox")
If (success <> True) Then
Debug.WriteLine(imap.LastErrorText)
Exit Sub
End If
Dim messageSet As Chilkat.MessageSet
' We can choose to fetch UIDs or sequence numbers.
Dim fetchUids As Boolean = True
' Get the message IDs of all the emails in the mailbox
messageSet = imap.Search("UNSEEN", fetchUids)
If (imap.LastMethodSuccess = False) Then
Debug.WriteLine(imap.LastErrorText)
Exit Sub
End If
' Fetch the emails into a bundle object:
Dim bundle As Chilkat.EmailBundle
bundle = imap.FetchBundle(messageSet)
If (imap.LastMethodSuccess = False) Then
Debug.WriteLine(imap.LastErrorText)
Exit Sub
End If
' Loop over the bundle and display the FROM and SUBJECT of each.
Dim i As Integer = 0
Dim numEmails As Integer = bundle.MessageCount
While i < numEmails
' ID Auslesen
Try
conn.Open()
sqlcmd = New MySqlCommand("SELECT MAX(id) FROM data", conn)
dr = sqlcmd.ExecuteScalar()
'MsgBox(dr)
lb_id.Text = dr + 1
conn.Close()
Catch ex As System.Exception
MsgBox(ex.ToString)
End Try
' Ordner anlegen
Try
System.IO.Directory.CreateDirectory("C:\DVAG\Mailing\" & lb_id.Text)
strFolderpath = "C:\DVAG\Mailing\" & lb_id.Text & "\"
Catch ex As System.Exception
End Try
Dim email As Chilkat.Email = bundle.GetEmail(i)
'Debug.WriteLine(email.FromAddress)
'Debug.WriteLine(email.GetToAddr(i))
'Debug.WriteLine(email.Subject)
'Debug.WriteLine(email.Body)
'Debug.WriteLine("--")
tb_von.Text = (email.FromAddress)
tb_an.Text = (email.GetToAddr("0"))
tb_betreff.Text = (email.Subject)
rtb_mail_body.Text = (email.Body)
rtb_mail_body.Text = rtb_mail_body.Text.Replace("'", "''")
'Attachment speichern
email.SaveAllAttachments(strFolderpath)
'Zugriff abfragen
Try
conn.Open()
sqlcmd = New MySqlCommand("select * from zugriff where mail = '" & tb_von.Text & "' and sender_mail = '" & tb_an.Text & "'", conn)
mailing_ohne_freigabe = sqlcmd.ExecuteScalar()
lb_mailing_ohne_freigabe.Text = mailing_ohne_freigabe
conn.Close()
Catch ex As System.Exception
End Try
If lb_mailing_ohne_freigabe.Text = "" Then
lb_mailing_ohne_freigabe.Text = "0"
Else
lb_mailing_ohne_freigabe.Text = "1"
End If
' Daten in DB speichern
conn.Open()
sqlcmd = New MySqlCommand("insert into `data` (`ID`, `from`, `to`, `subject`, `text`, `send`, `mailing_ohne_freigabe`) values ('" & lb_id.Text & "','" & tb_von.Text & "','" & tb_an.Text & "','" & tb_betreff.Text & "','" & rtb_mail_body.Text & "', '0','" & lb_mailing_ohne_freigabe.Text & "' )", conn)
dw = sqlcmd.ExecuteScalar()
conn.Close()
success = imap.SetFlags(messageSet, "SEEN", 1)
' Disconnect from the IMAP server.
success = imap.Disconnect()
i = i + 1
'Felder leeren
tb_von.Text = ""
tb_an.Text = ""
tb_betreff.Text = ""
rtb_mail_body.Text = ""
lb_id.Text = ""
End While
mail_sending.bt_start.PerformClick()
End Sub
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Dashboard.Show()
Me.Hide()
End Sub
Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles bt_stop.Click
Timer_mail_auslesen.Stop()
My.Settings.mail_auslesen = "0"
End Sub
Public Shared Function Middle(str As String, startchar As String, endchar As String) As String
Dim strStart As String = str.IndexOf(startchar) + 1
Dim strEnd As Integer = str.LastIndexOf(endchar)
Return str.Substring(strStart, strEnd - strStart)
' MsgBox(Middle(Str1, " To: < ", "test.com>"))
End Function
Private Sub Timer_mail_auslesen_Tick(sender As Object, e As EventArgs) Handles Timer_mail_auslesen.Tick
einlesen()
End Sub
Private Sub Button1_Click_2(sender As Object, e As EventArgs) Handles Button1.Click
einlesen()
End Sub
End Class