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) 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) As String
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) As String
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
Public Shared Function extractFromHeader(messageHeaders As String, Regex As String) As String
Try
Dim result As String = ""
Dim i As Integer = 0
If IsNothing(messageHeaders) Then
Return Nothing
End If
' einen Regulären Ausdruck laden
Dim strRegex As String = Regex
Dim myRegex As New Regex(strRegex, RegexOptions.IgnorePatternWhitespace)
Dim strTargetString As String = messageHeaders.Trim
' die Vorkommen im String auslesen
For Each myMatch As Match In myRegex.Matches(strTargetString)
If myMatch.Success Then
If myMatch.Value <> "" Then
If i = 0 Then
result = myMatch.Value.ToString
Else
result = result & ";" & myMatch.Value.ToString
End If
i += 1
End If
End If
Next
Return result
Catch ex As Exception
MsgBox("Unexpected Error in extractFromHeader: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return Nothing
End Try
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) As String
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