Imports Independentsoft Imports System.Text.RegularExpressions Public Class ClassEmailHeaderExtractor ''' ''' Extrahiert die Headerinformationen aus einer .msg Datei mithilfe der MSG.NET Klasse ''' ''' Der Pfad einer .msg Datei ''' Headerinformationen als String oder Nothing wenn ein Fehler aufgetreten ist. Public Shared Function getMessageHeaders(path As String) Try Dim msg As New Msg.Message(path) Dim headers = msg.TransportMessageHeaders.Replace(vbCrLf, " ") Return headers Catch ex As Exception Return Nothing End Try End Function ''' ''' Extrahiert die Headerinformationen aus einem msg Objekt mithilfe der MSG.NET Klasse ''' ''' Eine Email vom Typ Msg.Message ''' Headerinformationen als String oder Nothing wenn ein Fehler aufgetreten ist. Public Shared Function getMessageHeaders(msg As Msg.Message) Try Dim headers = msg.TransportMessageHeaders.Replace(vbCrLf, " ") Return headers Catch ex As Exception Return Nothing End Try End Function ''' ''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Absenderadresse. ''' ''' Headerinformationen die von getMessageHeaders erzeugt wurden. ''' Eine Liste von Regular Expressions ''' Die Ergebnisgruppe, die die Adresse enthält ''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. Public Shared Function extractFromAddress(messageHeaders As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) If IsNothing(messageHeaders) Then Return Nothing End If For Each rx In RegexList Dim match As Match = rx.Match(messageHeaders) Dim email As String = match.Groups(RegexGroup).Value If Not String.IsNullOrWhiteSpace(email) Then Return email End If Next Return Nothing End Function ''' ''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Empfängeradresse. ''' ''' Headerinformationen die von getMessageHeaders erzeugt wurden. ''' Eine Liste von Regular Expressions ''' Die Ergebnisgruppe, die die Adresse enthält ''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. Public Shared Function extractToAddress(messageHeaders As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) If IsNothing(messageHeaders) Then Return Nothing End If For Each rx In RegexList Dim match As Match = rx.Match(messageHeaders) Dim email As String = match.Groups(RegexGroup).Value If Not String.IsNullOrWhiteSpace(email) Then Return email End If Next Return Nothing End Function End Class