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.Show() mail_sending.bt_start.PerformClick() Me.Hide() 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() Me.Text = "Dienst ist gestoppt" 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 Me.Text = "Dienst läuft" einlesen() End Sub Private Sub Button1_Click_2(sender As Object, e As EventArgs) Handles Button1.Click einlesen() End Sub End Class