GAMBAS-BUCH 3.19.5

Der beschriebene SMTP-Client erweitert in unkomplizierter Weise das Projekt zur Langzeitmessung von Temperaturen im → Kapitel 13.6 TrayIcon. In diesem realen Experiment werden Temperaturen gemessen und protokolliert und sollen in diesem Projekt über SMTP als EMail verschickt werden. Auf eine aufwendige GUI kann verzichtet werden, denn das Programm zur Langzeitmessung wird in die System-Menüleiste geschickt. Dort erinnert nur ein Tray-Icon daran, dass im Hintergrund das Programm arbeitet.

Die Grundidee für das Projekt besteht darin,

• über einen Taktgeber in frei definierbaren Zeitintervallen die gespeicherten Messergebnisse in einer EMail zu verschicken,
• dass der Betreff jeder EMail einen Zeitstempel in lesbarem Format enthält,
• die Messergebnisse mit allen relevanten Daten im Text der EMail (Body) einzutragen,
• die Messergebnisse zusätzlich in ein Archiv zu verpacken und die Archiv-Datei als Anhang mitzusenden und
• in einem festgelegten Ordner (Log) diese Archiv-Dateien zu speichern.

Abbildung 24.4.3.1: Ausschnitt aus der Anzeige im EMail-Client Thunderbird

Hier der Quelltext, der die o.a. Idee in simulierter Form mit zufällig erzeugten Messdaten umsetzt. Eine Anpassung an reale Projekte sollte kein Problem sein:

' Gambas class file
 
Public hSMTPClient As SMTPClient
 
Public Sub Form_Open()  
  FMain.Center
  FMain.Resizable = False     
  TimerSend.Delay = 5000 ' 5 Sekunden für Tests
  TimerSend.Start  
  RMkDir(Application.Path &/ "Logs")
 
End ' Form_Open()
 
Public Sub TimerSend_Timer()  
  Dim sText, sBasisPath, sArchivPath, sLogPath As String
  Dim Cp As New Compress
 
  Randomize
 
  sText = gb.NewLine & "Protokoll zum Langzeit-Versuch LongTerm_TU" & gb.NewLine
  sText &= String$(46, "-") & gb.NewLine & gb.NewLine
  sText &= "Datum: " & Format(Now, "dd.mm.yyyy") & "  Zeit: " & Format(Now, "hh:nn:ss") & " Uhr"
  sText &= gb.NewLine & "Mess-Station: Fuchsbau (52.7904° | 11.7533°)"
  sText &= gb.NewLine & gb.NewLine & String$(44, "-") & gb.NewLine
  sText &= "Temperatur = " & Str(Rand(16, 23)) & " °C" & gb.NewLine
  sText &= "Luftdruck  = " & Str(Rand(977, 1023)) & " hPa" & gb.NewLine
  sText &= String$(44, "-") & gb.NewLine & gb.NewLine & gb.NewLine
  sText &= "Die Protokoll-Datei liegt im Anhang!"
 
  sBasisPath = Application.Path &/ "Logs" &/ Format(Now, "dd.mm.yyyy-hh:nn:ss") & "_log.txt"    
  sLogPath = sBasisPath
  File.Save(sLogPath, sText)
  Wait
  sArchivPath = sBasisPath & ".gz"    
  Cp.Type = "zlib"
  Cp.File(sLogPath, sArchivPath, 9) ' Kompression
  Wait
 
  SendProtocol(sText, sArchivPath)
 
  Kill sLogPath
 
End ' TimerSend_Timer()
 
Public Sub SendProtocol(EMailText As String, ArchivPath As String)      
  Dim sMessage As String
 
  If hSMTPClient Then hSMTPClient = Null
 
  hSMTPClient = New SMTPClient
' hSMTPClient.Debug = True ' Nur für Testzwecke einschalten 
 
' SMTP-Server
  hSMTPClient.Host = "smtp.server.net" ' <<--- ERSETZEN
' Port:
  hSMTPClient.Port = 465  ' <<--- PRÜFEN UND ERSETZEN  
' Verbindungssicherheit
  hSMTPClient.Encrypt = Net.SSL ' <<--- PRÜFEN UND ERSETZEN
' EMail-Absender: Konto-Daten (Username und Passwort)
  hSMTPClient.User = "userXY" ' <<--- ERSETZEN
  hSMTPClient.Password = "passwordXY" ' <<--- ERSETZEN
 
' EMail-Absender: EMail-Adresse
  hSMTPClient.From = "Vorname Nachname <xyz@smtp.server.net>" ' <<--- ERSETZEN
 
' Liste der EMail-Empfänger
  hSMTPClient.To.Add("abc@freenet.de")  ' <<--- ERSETZEN
' hSMTPClient.To.Add("to2@freenet.de") ' <<--- ERSETZEN
 
' Option: Liste zusätzlicher EMail-Empfänger (CC = CarbonCopy)
' hSMTPClient.Cc.Add("echo@tu-berlin.de") ' <<--- ERSETZEN ODER LÖSCHEN  
' Option: Liste zusätzlicher, versteckter EMail-Empfänger (BCC = BlindCarbonCopy)
' hSMTPClient.Bcc.Add("echo@tu-berlin.de") ' <<--- ERSETZEN ODER LÖSCHEN
 
' Inhalt der Betreff-Zeile
  hSMTPClient.Subject = "Protokoll vom " & Format(Now, "dd.mm.yyyy hh:nn:ss")
 
' EMail-Text (Mime-Typ: text/plain;charset=utf-8)
  hSMTPClient.Body = EMailText
 
' Option: EMail-Anhänge
' Syntax: hSMTP.Add(Datei-Pfad, [ Mime-Typ, anzuzeigender Datei-Name ])  
  hSMTPClient.Add(File.Load(ArchivPath),"application/gzip",Format(Now,"dd.mm.yyyy-hh:nn:ss")&"_log.txt.gz")
 
  Try hSMTPClient.Send
  If Error Then     
     sMessage = "Fehler beim Senden der EMail!" 
     sMessage &= gb.NewLine
     sMessage &= Format(Now, "dd.mm.yyyy hh:nn:ss") & " Uhr"
     File.Save(Application.Path &/ "Logs" &/ "error.log", sMessage)
  Endif    
End ' SendProtocol()
 
Public Sub MkFile(sFilePath As String)
  Dim hFile As File
 
  If Not Exist(sFilePath) Then
     hFile = Open sFilePath For Create
     Close #hFile
  Endif    
End ' MkFile(...)
 
Public Sub RMkDir(sDirectory As String)
  If Not sDirectory Or If Exist(sDirectory) Then Return
  RMkDir(File.Dir(sDirectory))
  Mkdir sDirectory  
End ' RMkDir(...)
 
Public Sub Form_Close() 
  TimerSend.Stop
  If hSMTPClient Then hSMTPClient = Null
End ' Form_Close()
 
Public Sub btnClose_Click()
  FMain.Close
End ' btnClose_Click()

Hinweise:

• Den Wert für das Zeitintervall müssen Sie an Ihre Notwendigkeiten anpassen. Für einen täglichen Bericht ergibt sich Wert für die Eigenschaft TimerSend.Delay von 24 * 60 * 60 * 1000 ms.
• Für das Erzeugen des erforderlichen Log-Ordners und der Dateien werden die beiden Prozeduren: RMkDir(sDirectory As String) und MkFile(sFilePath As String) eingesetzt.
• Die Temperatur- und Luftdruckwerte werden über Zufallszahlen erzeugt und sind für den praktischen Einsatz durch die experimentell ermittelten Werte zu ersetzen!
• Die originale Log-Datei wird nach dem Senden gelöscht, da nur die Archiv-Datei abgespeichert wird.
• Die Kompressionsrate für das eingesetzte Kompressionsverfahren wird auf den maximalen Wert (→ 9) eingestellt.

Hier sehen Sie den Inhalt der Datei error.log bei einem (initiierten) Fehler:

Fehler beim Senden der EMail!
30.01.2016 14:56:59 Uhr

Achtung: Das Projekt nutzt nicht die originale Komponente gb.net.smtp, sondern eine vom Autor korrigierte und nun fehlerfreie Version im Projektordner. Die Komponente gb.net.smtp ist deshalb in den Projekt-Einstellungen nicht zu aktivieren! Die fehlerfreie Version steht ab Gambas 3.8.3 auch über die Gambas-Quellen zur Verfügung.