AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: AppStd:ec309b5afbf9662e7780a67b1e7330ad79b00913
Branches Tags
AppStd:master AppStd:upgrade-to-NET8-1 AppStd:Modules-Update-.Net-8 AppStd:Update-Net-8 AppStd:Database_SqlConnection
...
compare: AppStd:86d61e720f32ea9f6357a9062b1dcd4b6f3da311
Branches Tags
AppStd:upgrade-to-NET8-1 AppStd:master AppStd:Modules-Update-.Net-8 AppStd:Update-Net-8 AppStd:Database_SqlConnection

6 Commits
ec309b5afb ... 86d61e720f

Author SHA1 Message Date
Jonathan Jenne
86d61e720f Base: Version 1.3.5.0 2023-08-22 08:40:09 +02:00
Jonathan Jenne
002931d6dd Filesystem: Version 1.5.2.0 2023-08-22 08:39:40 +02:00
Jonathan Jenne
77d8a0825f Messaging: WIP MailFetcher, MailSession 2023-08-22 08:38:46 +02:00
Jonathan Jenne
f6046aec54 Base: migrate functions from other modules, add new functions 2023-08-22 08:38:21 +02:00
Jonathan Jenne
72f7211d63 Jobs/Zugferd: Improve structure 2023-08-22 08:37:15 +02:00
Jonathan Jenne
7fea3dc1ff Fix GetVersionedFileName 2023-08-22 08:35:47 +02:00
21 changed files with 1847 additions and 1348 deletions
Expand all files Collapse all files

1
Base/Base.vbproj
View File

@@ -81,6 +81,7 @@
<Compile Include="BaseUtils.vb" /> <Compile Include="BaseUtils.vb" />
<Compile Include="DatabaseEx.vb" /> <Compile Include="DatabaseEx.vb" />
<Compile Include="ECM\ECM.vb" /> <Compile Include="ECM\ECM.vb" />
<Compile Include="MimeEx.vb" />
<Compile Include="WindowsEx.vb" /> <Compile Include="WindowsEx.vb" />
<Compile Include="ModuleExtensions.vb" /> <Compile Include="ModuleExtensions.vb" />
<Compile Include="FileEx.vb" /> <Compile Include="FileEx.vb" />

713
Base/FileEx.vb
View File

@@ -7,7 +7,7 @@ Public Class FileEx
''' </summary> ''' </summary>
''' <param name="pFilePath"></param> ''' <param name="pFilePath"></param>
''' <returns></returns> ''' <returns></returns>
Public Function GetChecksumFromFileContents(pFilePath As String) As String Public Shared Function GetChecksumFromFileContents(pFilePath As String) As String
Try Try
Using oFileStream = IO.File.OpenRead(pFilePath) Using oFileStream = IO.File.OpenRead(pFilePath)
Using oStream As New BufferedStream(oFileStream, 1200000) Using oStream As New BufferedStream(oFileStream, 1200000)
@@ -20,684 +20,59 @@ Public Class FileEx
End Try End Try
End Function End Function
Public Function GetHashFromFileContents(pFilePath As String) As String Public Shared Function GetHashFromFileContents(pFilePath As String) As String
Return GetChecksumFromFileContents(pFilePath) Return GetChecksumFromFileContents(pFilePath)
End Function End Function
Public Function GetMimeType(ByVal extension As String) As String ''' <summary>
If extension Is Nothing Then ''' Returns a Dictionary path in the form of [Base]\[Year]\[Month]\[Day]
Throw New ArgumentNullException("extension") ''' </summary>
End If ''' <param name="pBaseDirectory">The basedirectory</param>
''' <param name="pDate">The date to be used</param>
If Not extension.StartsWith(".") Then ''' <returns>The final directory path</returns>
extension = "." & extension Public Shared Function GetDateDirectory(pBaseDirectory As String, pDate As Date) As String
End If Dim oDateDirectory = StringEx.GetDateString(pDate)
Dim oFinalDirectory As String = Path.Combine(pBaseDirectory, oDateDirectory)
Dim value = Nothing Return oFinalDirectory
If Not _mappings.Value.TryGetValue(extension, value) Then
Return "application/octet-stream"
End If
Return value
End Function End Function
Public Function GetExtension(ByVal mimeType As String) As String ''' <summary>
If mimeType Is Nothing Then ''' Returns a Dictionary path in the form of [Base]\[Year]\[Month]\[Day] based on the current date
Throw New ArgumentNullException("mimeType") ''' </summary>
End If ''' <param name="pBaseDirectory">The basedirectory</param>
''' <returns>The final directory path</returns>
If mimeType.StartsWith(".") Then Public Shared Function GetDateDirectory(pBaseDirectory As String) As String
Throw New ArgumentException("Requested mime type is not valid: " & mimeType) Return GetDateDirectory(pBaseDirectory, Now)
End If
Dim value = Nothing
If _mappings.Value.TryGetValue(mimeType, value) Then
Return value
End If
Throw New ArgumentException("Requested mime type is not registered: " & mimeType)
End Function End Function
Private ReadOnly _mappings As New Lazy(Of IDictionary(Of String, String))(AddressOf BuildMappings) ''' <summary>
''' Creates a Dictionary in the form of [Base]\[Year]\[Month]\[Day]
''' </summary>
''' <param name="pBaseDirectory">The basedirectory</param>
''' <param name="pDate">The date to be used</param>
''' <returns>The created path. If the directory cannot be created, Nothing.</returns>
Public Shared Function CreateDateDirectory(pBaseDirectory As String, pDate As Date) As String
Dim oDateDirectory = StringEx.GetDateString(pDate)
Dim oFinalDirectory As String = Path.Combine(pBaseDirectory, oDateDirectory)
Private Function BuildMappings() As IDictionary(Of String, String) If Directory.Exists(oFinalDirectory) = False Then
Dim dictionary As New Dictionary(Of String, String)(StringComparer.InvariantCultureIgnoreCase) From { Try
{".323", "text/h323"}, Directory.CreateDirectory(oFinalDirectory)
{".3g2", "video/3gpp2"}, Catch ex As Exception
{".3gp", "video/3gpp"}, Return Nothing
{".3gp2", "video/3gpp2"}, End Try
{".3gpp", "video/3gpp"}, End If
{".7z", "application/x-7z-compressed"},
{".aa", "audio/audible"},
{".AAC", "audio/aac"},
{".aaf", "application/octet-stream"},
{".aax", "audio/vnd.audible.aax"},
{".ac3", "audio/ac3"},
{".aca", "application/octet-stream"},
{".accda", "application/msaccess.addin"},
{".accdb", "application/msaccess"},
{".accdc", "application/msaccess.cab"},
{".accde", "application/msaccess"},
{".accdr", "application/msaccess.runtime"},
{".accdt", "application/msaccess"},
{".accdw", "application/msaccess.webapplication"},
{".accft", "application/msaccess.ftemplate"},
{".acx", "application/internet-property-stream"},
{".AddIn", "text/xml"},
{".ade", "application/msaccess"},
{".adobebridge", "application/x-bridge-url"},
{".adp", "application/msaccess"},
{".ADT", "audio/vnd.dlna.adts"},
{".ADTS", "audio/aac"},
{".afm", "application/octet-stream"},
{".ai", "application/postscript"},
{".aif", "audio/x-aiff"},
{".aifc", "audio/aiff"},
{".aiff", "audio/aiff"},
{".air", "application/vnd.adobe.air-application-installer-package+zip"},
{".amc", "application/x-mpeg"},
{".application", "application/x-ms-application"},
{".art", "image/x-jg"},
{".asa", "application/xml"},
{".asax", "application/xml"},
{".ascx", "application/xml"},
{".asd", "application/octet-stream"},
{".asf", "video/x-ms-asf"},
{".ashx", "application/xml"},
{".asi", "application/octet-stream"},
{".asm", "text/plain"},
{".asmx", "application/xml"},
{".aspx", "application/xml"},
{".asr", "video/x-ms-asf"},
{".asx", "video/x-ms-asf"},
{".atom", "application/atom+xml"},
{".au", "audio/basic"},
{".avi", "video/x-msvideo"},
{".axs", "application/olescript"},
{".bas", "text/plain"},
{".bcpio", "application/x-bcpio"},
{".bin", "application/octet-stream"},
{".bmp", "image/bmp"},
{".c", "text/plain"},
{".cab", "application/octet-stream"},
{".caf", "audio/x-caf"},
{".calx", "application/vnd.ms-office.calx"},
{".cat", "application/vnd.ms-pki.seccat"},
{".cc", "text/plain"},
{".cd", "text/plain"},
{".cdda", "audio/aiff"},
{".cdf", "application/x-cdf"},
{".cer", "application/x-x509-ca-cert"},
{".chm", "application/octet-stream"},
{".class", "application/x-java-applet"},
{".clp", "application/x-msclip"},
{".cmx", "image/x-cmx"},
{".cnf", "text/plain"},
{".cod", "image/cis-cod"},
{".config", "application/xml"},
{".contact", "text/x-ms-contact"},
{".coverage", "application/xml"},
{".cpio", "application/x-cpio"},
{".cpp", "text/plain"},
{".crd", "application/x-mscardfile"},
{".crl", "application/pkix-crl"},
{".crt", "application/x-x509-ca-cert"},
{".cs", "text/plain"},
{".csdproj", "text/plain"},
{".csh", "application/x-csh"},
{".csproj", "text/plain"},
{".css", "text/css"},
{".csv", "text/csv"},
{".cur", "application/octet-stream"},
{".cxx", "text/plain"},
{".dat", "application/octet-stream"},
{".datasource", "application/xml"},
{".dbproj", "text/plain"},
{".dcr", "application/x-director"},
{".def", "text/plain"},
{".deploy", "application/octet-stream"},
{".der", "application/x-x509-ca-cert"},
{".dgml", "application/xml"},
{".dib", "image/bmp"},
{".dif", "video/x-dv"},
{".dir", "application/x-director"},
{".disco", "text/xml"},
{".divx", "video/divx"},
{".dll", "application/x-msdownload"},
{".dll.config", "text/xml"},
{".dlm", "text/dlm"},
{".doc", "application/msword"},
{".docm", "application/vnd.ms-word.document.macroEnabled.12"},
{".docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document"},
{".dot", "application/msword"},
{".dotm", "application/vnd.ms-word.template.macroEnabled.12"},
{".dotx", "application/vnd.openxmlformats-officedocument.wordprocessingml.template"},
{".dsp", "application/octet-stream"},
{".dsw", "text/plain"},
{".dtd", "text/xml"},
{".dtsConfig", "text/xml"},
{".dv", "video/x-dv"},
{".dvi", "application/x-dvi"},
{".dwf", "drawing/x-dwf"},
{".dwp", "application/octet-stream"},
{".dxr", "application/x-director"},
{".eml", "message/rfc822"},
{".emz", "application/octet-stream"},
{".eot", "application/octet-stream"},
{".eps", "application/postscript"},
{".etl", "application/etl"},
{".etx", "text/x-setext"},
{".evy", "application/envoy"},
{".exe", "application/octet-stream"},
{".exe.config", "text/xml"},
{".fdf", "application/vnd.fdf"},
{".fif", "application/fractals"},
{".filters", "application/xml"},
{".fla", "application/octet-stream"},
{".flr", "x-world/x-vrml"},
{".flv", "video/x-flv"},
{".fsscript", "application/fsharp-script"},
{".fsx", "application/fsharp-script"},
{".generictest", "application/xml"},
{".gif", "image/gif"},
{".group", "text/x-ms-group"},
{".gsm", "audio/x-gsm"},
{".gtar", "application/x-gtar"},
{".gz", "application/x-gzip"},
{".h", "text/plain"},
{".hdf", "application/x-hdf"},
{".hdml", "text/x-hdml"},
{".hhc", "application/x-oleobject"},
{".hhk", "application/octet-stream"},
{".hhp", "application/octet-stream"},
{".hlp", "application/winhlp"},
{".hpp", "text/plain"},
{".hqx", "application/mac-binhex40"},
{".hta", "application/hta"},
{".htc", "text/x-component"},
{".htm", "text/html"},
{".html", "text/html"},
{".htt", "text/webviewhtml"},
{".hxa", "application/xml"},
{".hxc", "application/xml"},
{".hxd", "application/octet-stream"},
{".hxe", "application/xml"},
{".hxf", "application/xml"},
{".hxh", "application/octet-stream"},
{".hxi", "application/octet-stream"},
{".hxk", "application/xml"},
{".hxq", "application/octet-stream"},
{".hxr", "application/octet-stream"},
{".hxs", "application/octet-stream"},
{".hxt", "text/html"},
{".hxv", "application/xml"},
{".hxw", "application/octet-stream"},
{".hxx", "text/plain"},
{".i", "text/plain"},
{".ico", "image/x-icon"},
{".ics", "application/octet-stream"},
{".idl", "text/plain"},
{".ief", "image/ief"},
{".iii", "application/x-iphone"},
{".inc", "text/plain"},
{".inf", "application/octet-stream"},
{".inl", "text/plain"},
{".ins", "application/x-internet-signup"},
{".ipa", "application/x-itunes-ipa"},
{".ipg", "application/x-itunes-ipg"},
{".ipproj", "text/plain"},
{".ipsw", "application/x-itunes-ipsw"},
{".iqy", "text/x-ms-iqy"},
{".isp", "application/x-internet-signup"},
{".ite", "application/x-itunes-ite"},
{".itlp", "application/x-itunes-itlp"},
{".itms", "application/x-itunes-itms"},
{".itpc", "application/x-itunes-itpc"},
{".IVF", "video/x-ivf"},
{".jar", "application/java-archive"},
{".java", "application/octet-stream"},
{".jck", "application/liquidmotion"},
{".jcz", "application/liquidmotion"},
{".jfif", "image/pjpeg"},
{".jnlp", "application/x-java-jnlp-file"},
{".jpb", "application/octet-stream"},
{".jpe", "image/jpeg"},
{".jpeg", "image/jpeg"},
{".jpg", "image/jpeg"},
{".js", "application/x-javascript"},
{".json", "application/json"},
{".jsx", "text/jscript"},
{".jsxbin", "text/plain"},
{".latex", "application/x-latex"},
{".library-ms", "application/windows-library+xml"},
{".lit", "application/x-ms-reader"},
{".loadtest", "application/xml"},
{".lpk", "application/octet-stream"},
{".lsf", "video/x-la-asf"},
{".lst", "text/plain"},
{".lsx", "video/x-la-asf"},
{".lzh", "application/octet-stream"},
{".m13", "application/x-msmediaview"},
{".m14", "application/x-msmediaview"},
{".m1v", "video/mpeg"},
{".m2t", "video/vnd.dlna.mpeg-tts"},
{".m2ts", "video/vnd.dlna.mpeg-tts"},
{".m2v", "video/mpeg"},
{".m3u", "audio/x-mpegurl"},
{".m3u8", "audio/x-mpegurl"},
{".m4a", "audio/m4a"},
{".m4b", "audio/m4b"},
{".m4p", "audio/m4p"},
{".m4r", "audio/x-m4r"},
{".m4v", "video/x-m4v"},
{".mac", "image/x-macpaint"},
{".mak", "text/plain"},
{".man", "application/x-troff-man"},
{".manifest", "application/x-ms-manifest"},
{".map", "text/plain"},
{".master", "application/xml"},
{".mda", "application/msaccess"},
{".mdb", "application/x-msaccess"},
{".mde", "application/msaccess"},
{".mdp", "application/octet-stream"},
{".me", "application/x-troff-me"},
{".mfp", "application/x-shockwave-flash"},
{".mht", "message/rfc822"},
{".mhtml", "message/rfc822"},
{".mid", "audio/mid"},
{".midi", "audio/mid"},
{".mix", "application/octet-stream"},
{".mk", "text/plain"},
{".mmf", "application/x-smaf"},
{".mno", "text/xml"},
{".mny", "application/x-msmoney"},
{".mod", "video/mpeg"},
{".mov", "video/quicktime"},
{".movie", "video/x-sgi-movie"},
{".mp2", "video/mpeg"},
{".mp2v", "video/mpeg"},
{".mp3", "audio/mpeg"},
{".mp4", "video/mp4"},
{".mp4v", "video/mp4"},
{".mpa", "video/mpeg"},
{".mpe", "video/mpeg"},
{".mpeg", "video/mpeg"},
{".mpf", "application/vnd.ms-mediapackage"},
{".mpg", "video/mpeg"},
{".mpp", "application/vnd.ms-project"},
{".mpv2", "video/mpeg"},
{".mqv", "video/quicktime"},
{".ms", "application/x-troff-ms"},
{".msg", "application/vnd.ms-outlook"},
{".msi", "application/octet-stream"},
{".mso", "application/octet-stream"},
{".mts", "video/vnd.dlna.mpeg-tts"},
{".mtx", "application/xml"},
{".mvb", "application/x-msmediaview"},
{".mvc", "application/x-miva-compiled"},
{".mxp", "application/x-mmxp"},
{".nc", "application/x-netcdf"},
{".nsc", "video/x-ms-asf"},
{".nws", "message/rfc822"},
{".ocx", "application/octet-stream"},
{".oda", "application/oda"},
{".odb", "application/vnd.oasis.opendocument.database"},
{".odc", "application/vnd.oasis.opendocument.chart"},
{".odf", "application/vnd.oasis.opendocument.formula"},
{".odg", "application/vnd.oasis.opendocument.graphics"},
{".odh", "text/plain"},
{".odi", "application/vnd.oasis.opendocument.image"},
{".odl", "text/plain"},
{".odm", "application/vnd.oasis.opendocument.text-master"},
{".odp", "application/vnd.oasis.opendocument.presentation"},
{".ods", "application/vnd.oasis.opendocument.spreadsheet"},
{".odt", "application/vnd.oasis.opendocument.text"},
{".ogv", "video/ogg"},
{".one", "application/onenote"},
{".onea", "application/onenote"},
{".onepkg", "application/onenote"},
{".onetmp", "application/onenote"},
{".onetoc", "application/onenote"},
{".onetoc2", "application/onenote"},
{".orderedtest", "application/xml"},
{".osdx", "application/opensearchdescription+xml"},
{".otg", "application/vnd.oasis.opendocument.graphics-template"},
{".oth", "application/vnd.oasis.opendocument.text-web"},
{".otp", "application/vnd.oasis.opendocument.presentation-template"},
{".ots", "application/vnd.oasis.opendocument.spreadsheet-template"},
{".ott", "application/vnd.oasis.opendocument.text-template"},
{".oxt", "application/vnd.openofficeorg.extension"},
{".p10", "application/pkcs10"},
{".p12", "application/x-pkcs12"},
{".p7b", "application/x-pkcs7-certificates"},
{".p7c", "application/pkcs7-mime"},
{".p7m", "application/pkcs7-mime"},
{".p7r", "application/x-pkcs7-certreqresp"},
{".p7s", "application/pkcs7-signature"},
{".pbm", "image/x-portable-bitmap"},
{".pcast", "application/x-podcast"},
{".pct", "image/pict"},
{".pcx", "application/octet-stream"},
{".pcz", "application/octet-stream"},
{".pdf", "application/pdf"},
{".pfb", "application/octet-stream"},
{".pfm", "application/octet-stream"},
{".pfx", "application/x-pkcs12"},
{".pgm", "image/x-portable-graymap"},
{".pic", "image/pict"},
{".pict", "image/pict"},
{".pkgdef", "text/plain"},
{".pkgundef", "text/plain"},
{".pko", "application/vnd.ms-pki.pko"},
{".pls", "audio/scpls"},
{".pma", "application/x-perfmon"},
{".pmc", "application/x-perfmon"},
{".pml", "application/x-perfmon"},
{".pmr", "application/x-perfmon"},
{".pmw", "application/x-perfmon"},
{".png", "image/png"},
{".pnm", "image/x-portable-anymap"},
{".pnt", "image/x-macpaint"},
{".pntg", "image/x-macpaint"},
{".pnz", "image/png"},
{".pot", "application/vnd.ms-powerpoint"},
{".potm", "application/vnd.ms-powerpoint.template.macroEnabled.12"},
{".potx", "application/vnd.openxmlformats-officedocument.presentationml.template"},
{".ppa", "application/vnd.ms-powerpoint"},
{".ppam", "application/vnd.ms-powerpoint.addin.macroEnabled.12"},
{".ppm", "image/x-portable-pixmap"},
{".pps", "application/vnd.ms-powerpoint"},
{".ppsm", "application/vnd.ms-powerpoint.slideshow.macroEnabled.12"},
{".ppsx", "application/vnd.openxmlformats-officedocument.presentationml.slideshow"},
{".ppt", "application/vnd.ms-powerpoint"},
{".pptm", "application/vnd.ms-powerpoint.presentation.macroEnabled.12"},
{".pptx", "application/vnd.openxmlformats-officedocument.presentationml.presentation"},
{".prf", "application/pics-rules"},
{".prm", "application/octet-stream"},
{".prx", "application/octet-stream"},
{".ps", "application/postscript"},
{".psc1", "application/PowerShell"},
{".psd", "application/octet-stream"},
{".psess", "application/xml"},
{".psm", "application/octet-stream"},
{".psp", "application/octet-stream"},
{".pub", "application/x-mspublisher"},
{".pwz", "application/vnd.ms-powerpoint"},
{".qht", "text/x-html-insertion"},
{".qhtm", "text/x-html-insertion"},
{".qt", "video/quicktime"},
{".qti", "image/x-quicktime"},
{".qtif", "image/x-quicktime"},
{".qtl", "application/x-quicktimeplayer"},
{".qxd", "application/octet-stream"},
{".ra", "audio/x-pn-realaudio"},
{".ram", "audio/x-pn-realaudio"},
{".rar", "application/octet-stream"},
{".ras", "image/x-cmu-raster"},
{".rat", "application/rat-file"},
{".rc", "text/plain"},
{".rc2", "text/plain"},
{".rct", "text/plain"},
{".rdlc", "application/xml"},
{".resx", "application/xml"},
{".rf", "image/vnd.rn-realflash"},
{".rgb", "image/x-rgb"},
{".rgs", "text/plain"},
{".rm", "application/vnd.rn-realmedia"},
{".rmi", "audio/mid"},
{".rmp", "application/vnd.rn-rn_music_package"},
{".roff", "application/x-troff"},
{".rpm", "audio/x-pn-realaudio-plugin"},
{".rqy", "text/x-ms-rqy"},
{".rtf", "application/rtf"},
{".rtx", "text/richtext"},
{".ruleset", "application/xml"},
{".s", "text/plain"},
{".safariextz", "application/x-safari-safariextz"},
{".scd", "application/x-msschedule"},
{".sct", "text/scriptlet"},
{".sd2", "audio/x-sd2"},
{".sdp", "application/sdp"},
{".sea", "application/octet-stream"},
{".searchConnector-ms", "application/windows-search-connector+xml"},
{".setpay", "application/set-payment-initiation"},
{".setreg", "application/set-registration-initiation"},
{".settings", "application/xml"},
{".sgimb", "application/x-sgimb"},
{".sgml", "text/sgml"},
{".sh", "application/x-sh"},
{".shar", "application/x-shar"},
{".shtml", "text/html"},
{".sit", "application/x-stuffit"},
{".sitemap", "application/xml"},
{".skin", "application/xml"},
{".sldm", "application/vnd.ms-powerpoint.slide.macroEnabled.12"},
{".sldx", "application/vnd.openxmlformats-officedocument.presentationml.slide"},
{".slk", "application/vnd.ms-excel"},
{".sln", "text/plain"},
{".slupkg-ms", "application/x-ms-license"},
{".smd", "audio/x-smd"},
{".smi", "application/octet-stream"},
{".smx", "audio/x-smd"},
{".smz", "audio/x-smd"},
{".snd", "audio/basic"},
{".snippet", "application/xml"},
{".snp", "application/octet-stream"},
{".sol", "text/plain"},
{".sor", "text/plain"},
{".spc", "application/x-pkcs7-certificates"},
{".spl", "application/futuresplash"},
{".src", "application/x-wais-source"},
{".srf", "text/plain"},
{".SSISDeploymentManifest", "text/xml"},
{".ssm", "application/streamingmedia"},
{".sst", "application/vnd.ms-pki.certstore"},
{".stl", "application/vnd.ms-pki.stl"},
{".sv4cpio", "application/x-sv4cpio"},
{".sv4crc", "application/x-sv4crc"},
{".svc", "application/xml"},
{".svg", "image/svg+xml"},
{".swf", "application/x-shockwave-flash"},
{".t", "application/x-troff"},
{".tar", "application/x-tar"},
{".tcl", "application/x-tcl"},
{".testrunconfig", "application/xml"},
{".testsettings", "application/xml"},
{".tex", "application/x-tex"},
{".texi", "application/x-texinfo"},
{".texinfo", "application/x-texinfo"},
{".tgz", "application/x-compressed"},
{".thmx", "application/vnd.ms-officetheme"},
{".thn", "application/octet-stream"},
{".tif", "image/tiff"},
{".tiff", "image/tiff"},
{".tlh", "text/plain"},
{".tli", "text/plain"},
{".toc", "application/octet-stream"},
{".tr", "application/x-troff"},
{".trm", "application/x-msterminal"},
{".trx", "application/xml"},
{".ts", "video/vnd.dlna.mpeg-tts"},
{".tsv", "text/tab-separated-values"},
{".ttf", "application/octet-stream"},
{".tts", "video/vnd.dlna.mpeg-tts"},
{".txt", "text/plain"},
{".u32", "application/octet-stream"},
{".uls", "text/iuls"},
{".user", "text/plain"},
{".ustar", "application/x-ustar"},
{".vb", "text/plain"},
{".vbdproj", "text/plain"},
{".vbk", "video/mpeg"},
{".vbproj", "text/plain"},
{".vbs", "text/vbscript"},
{".vcf", "text/x-vcard"},
{".vcproj", "application/xml"},
{".vcs", "text/plain"},
{".vcxproj", "application/xml"},
{".vddproj", "text/plain"},
{".vdp", "text/plain"},
{".vdproj", "text/plain"},
{".vdx", "application/vnd.ms-visio.viewer"},
{".vml", "text/xml"},
{".vscontent", "application/xml"},
{".vsct", "text/xml"},
{".vsd", "application/vnd.visio"},
{".vsi", "application/ms-vsi"},
{".vsix", "application/vsix"},
{".vsixlangpack", "text/xml"},
{".vsixmanifest", "text/xml"},
{".vsmdi", "application/xml"},
{".vspscc", "text/plain"},
{".vss", "application/vnd.visio"},
{".vsscc", "text/plain"},
{".vssettings", "text/xml"},
{".vssscc", "text/plain"},
{".vst", "application/vnd.visio"},
{".vstemplate", "text/xml"},
{".vsto", "application/x-ms-vsto"},
{".vsw", "application/vnd.visio"},
{".vsx", "application/vnd.visio"},
{".vtx", "application/vnd.visio"},
{".wav", "audio/wav"},
{".wave", "audio/wav"},
{".wax", "audio/x-ms-wax"},
{".wbk", "application/msword"},
{".wbmp", "image/vnd.wap.wbmp"},
{".wcm", "application/vnd.ms-works"},
{".wdb", "application/vnd.ms-works"},
{".wdp", "image/vnd.ms-photo"},
{".webarchive", "application/x-safari-webarchive"},
{".webm", "video/webm"},
{".webp", "image/webp"},
{".webtest", "application/xml"},
{".wiq", "application/xml"},
{".wiz", "application/msword"},
{".wks", "application/vnd.ms-works"},
{".WLMP", "application/wlmoviemaker"},
{".wlpginstall", "application/x-wlpg-detect"},
{".wlpginstall3", "application/x-wlpg3-detect"},
{".wm", "video/x-ms-wm"},
{".wma", "audio/x-ms-wma"},
{".wmd", "application/x-ms-wmd"},
{".wmf", "application/x-msmetafile"},
{".wml", "text/vnd.wap.wml"},
{".wmlc", "application/vnd.wap.wmlc"},
{".wmls", "text/vnd.wap.wmlscript"},
{".wmlsc", "application/vnd.wap.wmlscriptc"},
{".wmp", "video/x-ms-wmp"},
{".wmv", "video/x-ms-wmv"},
{".wmx", "video/x-ms-wmx"},
{".wmz", "application/x-ms-wmz"},
{".wpl", "application/vnd.ms-wpl"},
{".wps", "application/vnd.ms-works"},
{".wri", "application/x-mswrite"},
{".wrl", "x-world/x-vrml"},
{".wrz", "x-world/x-vrml"},
{".wsc", "text/scriptlet"},
{".wsdl", "text/xml"},
{".wvx", "video/x-ms-wvx"},
{".x", "application/directx"},
{".xaf", "x-world/x-vrml"},
{".xaml", "application/xaml+xml"},
{".xap", "application/x-silverlight-app"},
{".xbap", "application/x-ms-xbap"},
{".xbm", "image/x-xbitmap"},
{".xdr", "text/plain"},
{".xht", "application/xhtml+xml"},
{".xhtml", "application/xhtml+xml"},
{".xla", "application/vnd.ms-excel"},
{".xlam", "application/vnd.ms-excel.addin.macroEnabled.12"},
{".xlc", "application/vnd.ms-excel"},
{".xld", "application/vnd.ms-excel"},
{".xlk", "application/vnd.ms-excel"},
{".xll", "application/vnd.ms-excel"},
{".xlm", "application/vnd.ms-excel"},
{".xls", "application/vnd.ms-excel"},
{".xlsb", "application/vnd.ms-excel.sheet.binary.macroEnabled.12"},
{".xlsm", "application/vnd.ms-excel.sheet.macroEnabled.12"},
{".xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"},
{".xlt", "application/vnd.ms-excel"},
{".xltm", "application/vnd.ms-excel.template.macroEnabled.12"},
{".xltx", "application/vnd.openxmlformats-officedocument.spreadsheetml.template"},
{".xlw", "application/vnd.ms-excel"},
{".xml", "text/xml"},
{".xmta", "application/xml"},
{".xof", "x-world/x-vrml"},
{".XOML", "text/plain"},
{".xpm", "image/x-xpixmap"},
{".xps", "application/vnd.ms-xpsdocument"},
{".xrm-ms", "text/xml"},
{".xsc", "application/xml"},
{".xsd", "text/xml"},
{".xsf", "text/xml"},
{".xsl", "text/xml"},
{".xslt", "text/xml"},
{".xsn", "application/octet-stream"},
{".xss", "application/xml"},
{".xtp", "application/octet-stream"},
{".xwd", "image/x-xwindowdump"},
{".z", "application/x-compress"},
{".zip", "application/x-zip-compressed"},
{"application/fsharp-script", ".fsx"},
{"application/msaccess", ".adp"},
{"application/msword", ".doc"},
{"application/octet-stream", ".bin"},
{"application/onenote", ".one"},
{"application/postscript", ".eps"},
{"application/vnd.ms-excel", ".xls"},
{"application/vnd.ms-powerpoint", ".ppt"},
{"application/vnd.ms-works", ".wks"},
{"application/vnd.visio", ".vsd"},
{"application/x-director", ".dir"},
{"application/x-shockwave-flash", ".swf"},
{"application/x-x509-ca-cert", ".cer"},
{"application/xhtml+xml", ".xhtml"},
{"application/xml", ".xml"},
{"audio/aac", ".AAC"},
{"audio/aiff", ".aiff"},
{"audio/basic", ".snd"},
{"audio/mid", ".midi"},
{"audio/wav", ".wav"},
{"audio/x-mpegurl", ".m3u"},
{"audio/x-pn-realaudio", ".ra"},
{"audio/x-smd", ".smd"},
{"image/bmp", ".bmp"},
{"image/jpeg", ".jpg"},
{"image/pict", ".pic"},
{"image/png", ".png"},
{"image/tiff", ".tiff"},
{"image/x-macpaint", ".mac"},
{"image/x-quicktime", ".qti"},
{"message/rfc822", ".eml"},
{"text/html", ".html"},
{"text/plain", ".txt"},
{"text/scriptlet", ".wsc"},
{"text/xml", ".xml"},
{"video/3gpp", ".3gp"},
{"video/3gpp2", ".3gp2"},
{"video/mp4", ".mp4"},
{"video/mpeg", ".mpg"},
{"video/quicktime", ".mov"},
{"video/vnd.dlna.mpeg-tts", ".m2t"},
{"video/x-dv", ".dv"},
{"video/x-la-asf", ".lsf"},
{"video/x-ms-asf", ".asf"},
{"x-world/x-vrml", ".xof"}
}
Dim dictionary2 As Dictionary(Of String, String) = dictionary
Dim list As List(Of KeyValuePair(Of String, String)) = dictionary2.ToList()
For Each item As KeyValuePair(Of String, String) In list Return oFinalDirectory
End Function
If Not dictionary2.ContainsKey(item.Value) Then ''' <summary>
dictionary2.Add(item.Value, item.Key) ''' Creates a Dictionary in the form of [Base]\[Year]\[Month]\[Day] based on the current date
End If ''' </summary>
Next ''' <param name="pBaseDirectory">The basedirectory</param>
''' <returns>The created path. If the directory cannot be created, Nothing.</returns>
Return dictionary2 Public Shared Function CreateDateDirectory(pBaseDirectory As String) As String
Return CreateDateDirectory(pBaseDirectory, Now)
End Function End Function
End Class End Class

685
Base/MimeEx.vb Normal file
View File

@@ -0,0 +1,685 @@
Imports DigitalData.Modules.Logging
Public Class MimeEx
Inherits BaseClass
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
End Sub
Public Function GetMimeType(ByVal extension As String) As String
If extension Is Nothing Then
Throw New ArgumentNullException("extension")
End If
If Not extension.StartsWith(".") Then
extension = "." & extension
End If
Dim value = Nothing
If Not _mappings.Value.TryGetValue(extension, value) Then
Return "application/octet-stream"
End If
Return value
End Function
Public Function GetExtension(ByVal mimeType As String) As String
If mimeType Is Nothing Then
Throw New ArgumentNullException("mimeType")
End If
If mimeType.StartsWith(".") Then
Throw New ArgumentException("Requested mime type is not valid: " & mimeType)
End If
Dim value = Nothing
If _mappings.Value.TryGetValue(mimeType, value) Then
Return value
End If
Throw New ArgumentException("Requested mime type is not registered: " & mimeType)
End Function
Private ReadOnly _mappings As New Lazy(Of IDictionary(Of String, String))(AddressOf BuildMappings)
Private Function BuildMappings() As IDictionary(Of String, String)
Dim dictionary As New Dictionary(Of String, String)(StringComparer.InvariantCultureIgnoreCase) From {
{".323", "text/h323"},
{".3g2", "video/3gpp2"},
{".3gp", "video/3gpp"},
{".3gp2", "video/3gpp2"},
{".3gpp", "video/3gpp"},
{".7z", "application/x-7z-compressed"},
{".aa", "audio/audible"},
{".AAC", "audio/aac"},
{".aaf", "application/octet-stream"},
{".aax", "audio/vnd.audible.aax"},
{".ac3", "audio/ac3"},
{".aca", "application/octet-stream"},
{".accda", "application/msaccess.addin"},
{".accdb", "application/msaccess"},
{".accdc", "application/msaccess.cab"},
{".accde", "application/msaccess"},
{".accdr", "application/msaccess.runtime"},
{".accdt", "application/msaccess"},
{".accdw", "application/msaccess.webapplication"},
{".accft", "application/msaccess.ftemplate"},
{".acx", "application/internet-property-stream"},
{".AddIn", "text/xml"},
{".ade", "application/msaccess"},
{".adobebridge", "application/x-bridge-url"},
{".adp", "application/msaccess"},
{".ADT", "audio/vnd.dlna.adts"},
{".ADTS", "audio/aac"},
{".afm", "application/octet-stream"},
{".ai", "application/postscript"},
{".aif", "audio/x-aiff"},
{".aifc", "audio/aiff"},
{".aiff", "audio/aiff"},
{".air", "application/vnd.adobe.air-application-installer-package+zip"},
{".amc", "application/x-mpeg"},
{".application", "application/x-ms-application"},
{".art", "image/x-jg"},
{".asa", "application/xml"},
{".asax", "application/xml"},
{".ascx", "application/xml"},
{".asd", "application/octet-stream"},
{".asf", "video/x-ms-asf"},
{".ashx", "application/xml"},
{".asi", "application/octet-stream"},
{".asm", "text/plain"},
{".asmx", "application/xml"},
{".aspx", "application/xml"},
{".asr", "video/x-ms-asf"},
{".asx", "video/x-ms-asf"},
{".atom", "application/atom+xml"},
{".au", "audio/basic"},
{".avi", "video/x-msvideo"},
{".axs", "application/olescript"},
{".bas", "text/plain"},
{".bcpio", "application/x-bcpio"},
{".bin", "application/octet-stream"},
{".bmp", "image/bmp"},
{".c", "text/plain"},
{".cab", "application/octet-stream"},
{".caf", "audio/x-caf"},
{".calx", "application/vnd.ms-office.calx"},
{".cat", "application/vnd.ms-pki.seccat"},
{".cc", "text/plain"},
{".cd", "text/plain"},
{".cdda", "audio/aiff"},
{".cdf", "application/x-cdf"},
{".cer", "application/x-x509-ca-cert"},
{".chm", "application/octet-stream"},
{".class", "application/x-java-applet"},
{".clp", "application/x-msclip"},
{".cmx", "image/x-cmx"},
{".cnf", "text/plain"},
{".cod", "image/cis-cod"},
{".config", "application/xml"},
{".contact", "text/x-ms-contact"},
{".coverage", "application/xml"},
{".cpio", "application/x-cpio"},
{".cpp", "text/plain"},
{".crd", "application/x-mscardfile"},
{".crl", "application/pkix-crl"},
{".crt", "application/x-x509-ca-cert"},
{".cs", "text/plain"},
{".csdproj", "text/plain"},
{".csh", "application/x-csh"},
{".csproj", "text/plain"},
{".css", "text/css"},
{".csv", "text/csv"},
{".cur", "application/octet-stream"},
{".cxx", "text/plain"},
{".dat", "application/octet-stream"},
{".datasource", "application/xml"},
{".dbproj", "text/plain"},
{".dcr", "application/x-director"},
{".def", "text/plain"},
{".deploy", "application/octet-stream"},
{".der", "application/x-x509-ca-cert"},
{".dgml", "application/xml"},
{".dib", "image/bmp"},
{".dif", "video/x-dv"},
{".dir", "application/x-director"},
{".disco", "text/xml"},
{".divx", "video/divx"},
{".dll", "application/x-msdownload"},
{".dll.config", "text/xml"},
{".dlm", "text/dlm"},
{".doc", "application/msword"},
{".docm", "application/vnd.ms-word.document.macroEnabled.12"},
{".docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document"},
{".dot", "application/msword"},
{".dotm", "application/vnd.ms-word.template.macroEnabled.12"},
{".dotx", "application/vnd.openxmlformats-officedocument.wordprocessingml.template"},
{".dsp", "application/octet-stream"},
{".dsw", "text/plain"},
{".dtd", "text/xml"},
{".dtsConfig", "text/xml"},
{".dv", "video/x-dv"},
{".dvi", "application/x-dvi"},
{".dwf", "drawing/x-dwf"},
{".dwp", "application/octet-stream"},
{".dxr", "application/x-director"},
{".eml", "message/rfc822"},
{".emz", "application/octet-stream"},
{".eot", "application/octet-stream"},
{".eps", "application/postscript"},
{".etl", "application/etl"},
{".etx", "text/x-setext"},
{".evy", "application/envoy"},
{".exe", "application/octet-stream"},
{".exe.config", "text/xml"},
{".fdf", "application/vnd.fdf"},
{".fif", "application/fractals"},
{".filters", "application/xml"},
{".fla", "application/octet-stream"},
{".flr", "x-world/x-vrml"},
{".flv", "video/x-flv"},
{".fsscript", "application/fsharp-script"},
{".fsx", "application/fsharp-script"},
{".generictest", "application/xml"},
{".gif", "image/gif"},
{".group", "text/x-ms-group"},
{".gsm", "audio/x-gsm"},
{".gtar", "application/x-gtar"},
{".gz", "application/x-gzip"},
{".h", "text/plain"},
{".hdf", "application/x-hdf"},
{".hdml", "text/x-hdml"},
{".hhc", "application/x-oleobject"},
{".hhk", "application/octet-stream"},
{".hhp", "application/octet-stream"},
{".hlp", "application/winhlp"},
{".hpp", "text/plain"},
{".hqx", "application/mac-binhex40"},
{".hta", "application/hta"},
{".htc", "text/x-component"},
{".htm", "text/html"},
{".html", "text/html"},
{".htt", "text/webviewhtml"},
{".hxa", "application/xml"},
{".hxc", "application/xml"},
{".hxd", "application/octet-stream"},
{".hxe", "application/xml"},
{".hxf", "application/xml"},
{".hxh", "application/octet-stream"},
{".hxi", "application/octet-stream"},
{".hxk", "application/xml"},
{".hxq", "application/octet-stream"},
{".hxr", "application/octet-stream"},
{".hxs", "application/octet-stream"},
{".hxt", "text/html"},
{".hxv", "application/xml"},
{".hxw", "application/octet-stream"},
{".hxx", "text/plain"},
{".i", "text/plain"},
{".ico", "image/x-icon"},
{".ics", "application/octet-stream"},
{".idl", "text/plain"},
{".ief", "image/ief"},
{".iii", "application/x-iphone"},
{".inc", "text/plain"},
{".inf", "application/octet-stream"},
{".inl", "text/plain"},
{".ins", "application/x-internet-signup"},
{".ipa", "application/x-itunes-ipa"},
{".ipg", "application/x-itunes-ipg"},
{".ipproj", "text/plain"},
{".ipsw", "application/x-itunes-ipsw"},
{".iqy", "text/x-ms-iqy"},
{".isp", "application/x-internet-signup"},
{".ite", "application/x-itunes-ite"},
{".itlp", "application/x-itunes-itlp"},
{".itms", "application/x-itunes-itms"},
{".itpc", "application/x-itunes-itpc"},
{".IVF", "video/x-ivf"},
{".jar", "application/java-archive"},
{".java", "application/octet-stream"},
{".jck", "application/liquidmotion"},
{".jcz", "application/liquidmotion"},
{".jfif", "image/pjpeg"},
{".jnlp", "application/x-java-jnlp-file"},
{".jpb", "application/octet-stream"},
{".jpe", "image/jpeg"},
{".jpeg", "image/jpeg"},
{".jpg", "image/jpeg"},
{".js", "application/x-javascript"},
{".json", "application/json"},
{".jsx", "text/jscript"},
{".jsxbin", "text/plain"},
{".latex", "application/x-latex"},
{".library-ms", "application/windows-library+xml"},
{".lit", "application/x-ms-reader"},
{".loadtest", "application/xml"},
{".lpk", "application/octet-stream"},
{".lsf", "video/x-la-asf"},
{".lst", "text/plain"},
{".lsx", "video/x-la-asf"},
{".lzh", "application/octet-stream"},
{".m13", "application/x-msmediaview"},
{".m14", "application/x-msmediaview"},
{".m1v", "video/mpeg"},
{".m2t", "video/vnd.dlna.mpeg-tts"},
{".m2ts", "video/vnd.dlna.mpeg-tts"},
{".m2v", "video/mpeg"},
{".m3u", "audio/x-mpegurl"},
{".m3u8", "audio/x-mpegurl"},
{".m4a", "audio/m4a"},
{".m4b", "audio/m4b"},
{".m4p", "audio/m4p"},
{".m4r", "audio/x-m4r"},
{".m4v", "video/x-m4v"},
{".mac", "image/x-macpaint"},
{".mak", "text/plain"},
{".man", "application/x-troff-man"},
{".manifest", "application/x-ms-manifest"},
{".map", "text/plain"},
{".master", "application/xml"},
{".mda", "application/msaccess"},
{".mdb", "application/x-msaccess"},
{".mde", "application/msaccess"},
{".mdp", "application/octet-stream"},
{".me", "application/x-troff-me"},
{".mfp", "application/x-shockwave-flash"},
{".mht", "message/rfc822"},
{".mhtml", "message/rfc822"},
{".mid", "audio/mid"},
{".midi", "audio/mid"},
{".mix", "application/octet-stream"},
{".mk", "text/plain"},
{".mmf", "application/x-smaf"},
{".mno", "text/xml"},
{".mny", "application/x-msmoney"},
{".mod", "video/mpeg"},
{".mov", "video/quicktime"},
{".movie", "video/x-sgi-movie"},
{".mp2", "video/mpeg"},
{".mp2v", "video/mpeg"},
{".mp3", "audio/mpeg"},
{".mp4", "video/mp4"},
{".mp4v", "video/mp4"},
{".mpa", "video/mpeg"},
{".mpe", "video/mpeg"},
{".mpeg", "video/mpeg"},
{".mpf", "application/vnd.ms-mediapackage"},
{".mpg", "video/mpeg"},
{".mpp", "application/vnd.ms-project"},
{".mpv2", "video/mpeg"},
{".mqv", "video/quicktime"},
{".ms", "application/x-troff-ms"},
{".msg", "application/vnd.ms-outlook"},
{".msi", "application/octet-stream"},
{".mso", "application/octet-stream"},
{".mts", "video/vnd.dlna.mpeg-tts"},
{".mtx", "application/xml"},
{".mvb", "application/x-msmediaview"},
{".mvc", "application/x-miva-compiled"},
{".mxp", "application/x-mmxp"},
{".nc", "application/x-netcdf"},
{".nsc", "video/x-ms-asf"},
{".nws", "message/rfc822"},
{".ocx", "application/octet-stream"},
{".oda", "application/oda"},
{".odb", "application/vnd.oasis.opendocument.database"},
{".odc", "application/vnd.oasis.opendocument.chart"},
{".odf", "application/vnd.oasis.opendocument.formula"},
{".odg", "application/vnd.oasis.opendocument.graphics"},
{".odh", "text/plain"},
{".odi", "application/vnd.oasis.opendocument.image"},
{".odl", "text/plain"},
{".odm", "application/vnd.oasis.opendocument.text-master"},
{".odp", "application/vnd.oasis.opendocument.presentation"},
{".ods", "application/vnd.oasis.opendocument.spreadsheet"},
{".odt", "application/vnd.oasis.opendocument.text"},
{".ogv", "video/ogg"},
{".one", "application/onenote"},
{".onea", "application/onenote"},
{".onepkg", "application/onenote"},
{".onetmp", "application/onenote"},
{".onetoc", "application/onenote"},
{".onetoc2", "application/onenote"},
{".orderedtest", "application/xml"},
{".osdx", "application/opensearchdescription+xml"},
{".otg", "application/vnd.oasis.opendocument.graphics-template"},
{".oth", "application/vnd.oasis.opendocument.text-web"},
{".otp", "application/vnd.oasis.opendocument.presentation-template"},
{".ots", "application/vnd.oasis.opendocument.spreadsheet-template"},
{".ott", "application/vnd.oasis.opendocument.text-template"},
{".oxt", "application/vnd.openofficeorg.extension"},
{".p10", "application/pkcs10"},
{".p12", "application/x-pkcs12"},
{".p7b", "application/x-pkcs7-certificates"},
{".p7c", "application/pkcs7-mime"},
{".p7m", "application/pkcs7-mime"},
{".p7r", "application/x-pkcs7-certreqresp"},
{".p7s", "application/pkcs7-signature"},
{".pbm", "image/x-portable-bitmap"},
{".pcast", "application/x-podcast"},
{".pct", "image/pict"},
{".pcx", "application/octet-stream"},
{".pcz", "application/octet-stream"},
{".pdf", "application/pdf"},
{".pfb", "application/octet-stream"},
{".pfm", "application/octet-stream"},
{".pfx", "application/x-pkcs12"},
{".pgm", "image/x-portable-graymap"},
{".pic", "image/pict"},
{".pict", "image/pict"},
{".pkgdef", "text/plain"},
{".pkgundef", "text/plain"},
{".pko", "application/vnd.ms-pki.pko"},
{".pls", "audio/scpls"},
{".pma", "application/x-perfmon"},
{".pmc", "application/x-perfmon"},
{".pml", "application/x-perfmon"},
{".pmr", "application/x-perfmon"},
{".pmw", "application/x-perfmon"},
{".png", "image/png"},
{".pnm", "image/x-portable-anymap"},
{".pnt", "image/x-macpaint"},
{".pntg", "image/x-macpaint"},
{".pnz", "image/png"},
{".pot", "application/vnd.ms-powerpoint"},
{".potm", "application/vnd.ms-powerpoint.template.macroEnabled.12"},
{".potx", "application/vnd.openxmlformats-officedocument.presentationml.template"},
{".ppa", "application/vnd.ms-powerpoint"},
{".ppam", "application/vnd.ms-powerpoint.addin.macroEnabled.12"},
{".ppm", "image/x-portable-pixmap"},
{".pps", "application/vnd.ms-powerpoint"},
{".ppsm", "application/vnd.ms-powerpoint.slideshow.macroEnabled.12"},
{".ppsx", "application/vnd.openxmlformats-officedocument.presentationml.slideshow"},
{".ppt", "application/vnd.ms-powerpoint"},
{".pptm", "application/vnd.ms-powerpoint.presentation.macroEnabled.12"},
{".pptx", "application/vnd.openxmlformats-officedocument.presentationml.presentation"},
{".prf", "application/pics-rules"},
{".prm", "application/octet-stream"},
{".prx", "application/octet-stream"},
{".ps", "application/postscript"},
{".psc1", "application/PowerShell"},
{".psd", "application/octet-stream"},
{".psess", "application/xml"},
{".psm", "application/octet-stream"},
{".psp", "application/octet-stream"},
{".pub", "application/x-mspublisher"},
{".pwz", "application/vnd.ms-powerpoint"},
{".qht", "text/x-html-insertion"},
{".qhtm", "text/x-html-insertion"},
{".qt", "video/quicktime"},
{".qti", "image/x-quicktime"},
{".qtif", "image/x-quicktime"},
{".qtl", "application/x-quicktimeplayer"},
{".qxd", "application/octet-stream"},
{".ra", "audio/x-pn-realaudio"},
{".ram", "audio/x-pn-realaudio"},
{".rar", "application/octet-stream"},
{".ras", "image/x-cmu-raster"},
{".rat", "application/rat-file"},
{".rc", "text/plain"},
{".rc2", "text/plain"},
{".rct", "text/plain"},
{".rdlc", "application/xml"},
{".resx", "application/xml"},
{".rf", "image/vnd.rn-realflash"},
{".rgb", "image/x-rgb"},
{".rgs", "text/plain"},
{".rm", "application/vnd.rn-realmedia"},
{".rmi", "audio/mid"},
{".rmp", "application/vnd.rn-rn_music_package"},
{".roff", "application/x-troff"},
{".rpm", "audio/x-pn-realaudio-plugin"},
{".rqy", "text/x-ms-rqy"},
{".rtf", "application/rtf"},
{".rtx", "text/richtext"},
{".ruleset", "application/xml"},
{".s", "text/plain"},
{".safariextz", "application/x-safari-safariextz"},
{".scd", "application/x-msschedule"},
{".sct", "text/scriptlet"},
{".sd2", "audio/x-sd2"},
{".sdp", "application/sdp"},
{".sea", "application/octet-stream"},
{".searchConnector-ms", "application/windows-search-connector+xml"},
{".setpay", "application/set-payment-initiation"},
{".setreg", "application/set-registration-initiation"},
{".settings", "application/xml"},
{".sgimb", "application/x-sgimb"},
{".sgml", "text/sgml"},
{".sh", "application/x-sh"},
{".shar", "application/x-shar"},
{".shtml", "text/html"},
{".sit", "application/x-stuffit"},
{".sitemap", "application/xml"},
{".skin", "application/xml"},
{".sldm", "application/vnd.ms-powerpoint.slide.macroEnabled.12"},
{".sldx", "application/vnd.openxmlformats-officedocument.presentationml.slide"},
{".slk", "application/vnd.ms-excel"},
{".sln", "text/plain"},
{".slupkg-ms", "application/x-ms-license"},
{".smd", "audio/x-smd"},
{".smi", "application/octet-stream"},
{".smx", "audio/x-smd"},
{".smz", "audio/x-smd"},
{".snd", "audio/basic"},
{".snippet", "application/xml"},
{".snp", "application/octet-stream"},
{".sol", "text/plain"},
{".sor", "text/plain"},
{".spc", "application/x-pkcs7-certificates"},
{".spl", "application/futuresplash"},
{".src", "application/x-wais-source"},
{".srf", "text/plain"},
{".SSISDeploymentManifest", "text/xml"},
{".ssm", "application/streamingmedia"},
{".sst", "application/vnd.ms-pki.certstore"},
{".stl", "application/vnd.ms-pki.stl"},
{".sv4cpio", "application/x-sv4cpio"},
{".sv4crc", "application/x-sv4crc"},
{".svc", "application/xml"},
{".svg", "image/svg+xml"},
{".swf", "application/x-shockwave-flash"},
{".t", "application/x-troff"},
{".tar", "application/x-tar"},
{".tcl", "application/x-tcl"},
{".testrunconfig", "application/xml"},
{".testsettings", "application/xml"},
{".tex", "application/x-tex"},
{".texi", "application/x-texinfo"},
{".texinfo", "application/x-texinfo"},
{".tgz", "application/x-compressed"},
{".thmx", "application/vnd.ms-officetheme"},
{".thn", "application/octet-stream"},
{".tif", "image/tiff"},
{".tiff", "image/tiff"},
{".tlh", "text/plain"},
{".tli", "text/plain"},
{".toc", "application/octet-stream"},
{".tr", "application/x-troff"},
{".trm", "application/x-msterminal"},
{".trx", "application/xml"},
{".ts", "video/vnd.dlna.mpeg-tts"},
{".tsv", "text/tab-separated-values"},
{".ttf", "application/octet-stream"},
{".tts", "video/vnd.dlna.mpeg-tts"},
{".txt", "text/plain"},
{".u32", "application/octet-stream"},
{".uls", "text/iuls"},
{".user", "text/plain"},
{".ustar", "application/x-ustar"},
{".vb", "text/plain"},
{".vbdproj", "text/plain"},
{".vbk", "video/mpeg"},
{".vbproj", "text/plain"},
{".vbs", "text/vbscript"},
{".vcf", "text/x-vcard"},
{".vcproj", "application/xml"},
{".vcs", "text/plain"},
{".vcxproj", "application/xml"},
{".vddproj", "text/plain"},
{".vdp", "text/plain"},
{".vdproj", "text/plain"},
{".vdx", "application/vnd.ms-visio.viewer"},
{".vml", "text/xml"},
{".vscontent", "application/xml"},
{".vsct", "text/xml"},
{".vsd", "application/vnd.visio"},
{".vsi", "application/ms-vsi"},
{".vsix", "application/vsix"},
{".vsixlangpack", "text/xml"},
{".vsixmanifest", "text/xml"},
{".vsmdi", "application/xml"},
{".vspscc", "text/plain"},
{".vss", "application/vnd.visio"},
{".vsscc", "text/plain"},
{".vssettings", "text/xml"},
{".vssscc", "text/plain"},
{".vst", "application/vnd.visio"},
{".vstemplate", "text/xml"},
{".vsto", "application/x-ms-vsto"},
{".vsw", "application/vnd.visio"},
{".vsx", "application/vnd.visio"},
{".vtx", "application/vnd.visio"},
{".wav", "audio/wav"},
{".wave", "audio/wav"},
{".wax", "audio/x-ms-wax"},
{".wbk", "application/msword"},
{".wbmp", "image/vnd.wap.wbmp"},
{".wcm", "application/vnd.ms-works"},
{".wdb", "application/vnd.ms-works"},
{".wdp", "image/vnd.ms-photo"},
{".webarchive", "application/x-safari-webarchive"},
{".webm", "video/webm"},
{".webp", "image/webp"},
{".webtest", "application/xml"},
{".wiq", "application/xml"},
{".wiz", "application/msword"},
{".wks", "application/vnd.ms-works"},
{".WLMP", "application/wlmoviemaker"},
{".wlpginstall", "application/x-wlpg-detect"},
{".wlpginstall3", "application/x-wlpg3-detect"},
{".wm", "video/x-ms-wm"},
{".wma", "audio/x-ms-wma"},
{".wmd", "application/x-ms-wmd"},
{".wmf", "application/x-msmetafile"},
{".wml", "text/vnd.wap.wml"},
{".wmlc", "application/vnd.wap.wmlc"},
{".wmls", "text/vnd.wap.wmlscript"},
{".wmlsc", "application/vnd.wap.wmlscriptc"},
{".wmp", "video/x-ms-wmp"},
{".wmv", "video/x-ms-wmv"},
{".wmx", "video/x-ms-wmx"},
{".wmz", "application/x-ms-wmz"},
{".wpl", "application/vnd.ms-wpl"},
{".wps", "application/vnd.ms-works"},
{".wri", "application/x-mswrite"},
{".wrl", "x-world/x-vrml"},
{".wrz", "x-world/x-vrml"},
{".wsc", "text/scriptlet"},
{".wsdl", "text/xml"},
{".wvx", "video/x-ms-wvx"},
{".x", "application/directx"},
{".xaf", "x-world/x-vrml"},
{".xaml", "application/xaml+xml"},
{".xap", "application/x-silverlight-app"},
{".xbap", "application/x-ms-xbap"},
{".xbm", "image/x-xbitmap"},
{".xdr", "text/plain"},
{".xht", "application/xhtml+xml"},
{".xhtml", "application/xhtml+xml"},
{".xla", "application/vnd.ms-excel"},
{".xlam", "application/vnd.ms-excel.addin.macroEnabled.12"},
{".xlc", "application/vnd.ms-excel"},
{".xld", "application/vnd.ms-excel"},
{".xlk", "application/vnd.ms-excel"},
{".xll", "application/vnd.ms-excel"},
{".xlm", "application/vnd.ms-excel"},
{".xls", "application/vnd.ms-excel"},
{".xlsb", "application/vnd.ms-excel.sheet.binary.macroEnabled.12"},
{".xlsm", "application/vnd.ms-excel.sheet.macroEnabled.12"},
{".xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"},
{".xlt", "application/vnd.ms-excel"},
{".xltm", "application/vnd.ms-excel.template.macroEnabled.12"},
{".xltx", "application/vnd.openxmlformats-officedocument.spreadsheetml.template"},
{".xlw", "application/vnd.ms-excel"},
{".xml", "text/xml"},
{".xmta", "application/xml"},
{".xof", "x-world/x-vrml"},
{".XOML", "text/plain"},
{".xpm", "image/x-xpixmap"},
{".xps", "application/vnd.ms-xpsdocument"},
{".xrm-ms", "text/xml"},
{".xsc", "application/xml"},
{".xsd", "text/xml"},
{".xsf", "text/xml"},
{".xsl", "text/xml"},
{".xslt", "text/xml"},
{".xsn", "application/octet-stream"},
{".xss", "application/xml"},
{".xtp", "application/octet-stream"},
{".xwd", "image/x-xwindowdump"},
{".z", "application/x-compress"},
{".zip", "application/x-zip-compressed"},
{"application/fsharp-script", ".fsx"},
{"application/msaccess", ".adp"},
{"application/msword", ".doc"},
{"application/octet-stream", ".bin"},
{"application/onenote", ".one"},
{"application/postscript", ".eps"},
{"application/vnd.ms-excel", ".xls"},
{"application/vnd.ms-powerpoint", ".ppt"},
{"application/vnd.ms-works", ".wks"},
{"application/vnd.visio", ".vsd"},
{"application/x-director", ".dir"},
{"application/x-shockwave-flash", ".swf"},
{"application/x-x509-ca-cert", ".cer"},
{"application/xhtml+xml", ".xhtml"},
{"application/xml", ".xml"},
{"audio/aac", ".AAC"},
{"audio/aiff", ".aiff"},
{"audio/basic", ".snd"},
{"audio/mid", ".midi"},
{"audio/wav", ".wav"},
{"audio/x-mpegurl", ".m3u"},
{"audio/x-pn-realaudio", ".ra"},
{"audio/x-smd", ".smd"},
{"image/bmp", ".bmp"},
{"image/jpeg", ".jpg"},
{"image/pict", ".pic"},
{"image/png", ".png"},
{"image/tiff", ".tiff"},
{"image/x-macpaint", ".mac"},
{"image/x-quicktime", ".qti"},
{"message/rfc822", ".eml"},
{"text/html", ".html"},
{"text/plain", ".txt"},
{"text/scriptlet", ".wsc"},
{"text/xml", ".xml"},
{"video/3gpp", ".3gp"},
{"video/3gpp2", ".3gp2"},
{"video/mp4", ".mp4"},
{"video/mpeg", ".mpg"},
{"video/quicktime", ".mov"},
{"video/vnd.dlna.mpeg-tts", ".m2t"},
{"video/x-dv", ".dv"},
{"video/x-la-asf", ".lsf"},
{"video/x-ms-asf", ".asf"},
{"x-world/x-vrml", ".xof"}
}
Dim dictionary2 As Dictionary(Of String, String) = dictionary
Dim list As List(Of KeyValuePair(Of String, String)) = dictionary2.ToList()
For Each item As KeyValuePair(Of String, String) In list
If Not dictionary2.ContainsKey(item.Value) Then
dictionary2.Add(item.Value, item.Key)
End If
Next
Return dictionary2
End Function
End Class

9
Base/ModuleExtensions.vb
View File

@@ -19,6 +19,15 @@ Public Module ModuleExtensions
Return New Date(UnixEraStartTicks + pTimestamp * 10000) Return New Date(UnixEraStartTicks + pTimestamp * 10000)
End Function End Function
' ======================================================
' === LIST
' ======================================================
<Extension()>
Public Function JoinToString(pList As IEnumerable(Of String), pSeparator As Char)
Return String.Join(pSeparator, pList)
End Function
' ====================================================== ' ======================================================
' === STRING ' === STRING
' ====================================================== ' ======================================================

6
Base/My Project/AssemblyInfo.vb
View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("")> <Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Base")> <Assembly: AssemblyProduct("Base")>
<Assembly: AssemblyCopyright("Copyright © 2023")> <Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyTrademark("1.3.4.0")> <Assembly: AssemblyTrademark("1.3.5.0")>
<Assembly: ComVisible(False)> <Assembly: ComVisible(False)>
@@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' indem Sie "*" wie unten gezeigt eingeben: ' indem Sie "*" wie unten gezeigt eingeben:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.3.4.0")> <Assembly: AssemblyVersion("1.3.5.0")>
<Assembly: AssemblyFileVersion("1.3.4.0")> <Assembly: AssemblyFileVersion("1.3.5.0")>

21
Base/StringEx.vb
View File

@@ -21,6 +21,11 @@ Public Class StringEx
If Char.IsLetterOrDigit(oChar) Then If Char.IsLetterOrDigit(oChar) Then
oBuilder.Append(Char.ToLower(oChar)) oBuilder.Append(Char.ToLower(oChar))
oWasHyphen = False oWasHyphen = False
ElseIf oChar = "_"c Or oChar = "-"c Then
oBuilder.Append(oChar)
oWasHyphen = True
ElseIf Char.IsWhiteSpace(oChar) AndAlso Not oWasHyphen Then ElseIf Char.IsWhiteSpace(oChar) AndAlso Not oWasHyphen Then
oBuilder.Append("-"c) oBuilder.Append("-"c)
oWasHyphen = True oWasHyphen = True
@@ -111,6 +116,22 @@ Public Class StringEx
Return GetChecksum(pStringToCheck).Substring(0, 32) Return GetChecksum(pStringToCheck).Substring(0, 32)
End Function End Function
Public Shared Function GetDateString() As String
Return $"{Now:yyyy\\MM\\dd}"
End Function
Public Shared Function GetDateString(pDate As Date) As String
Return $"{pDate:yyyy\\MM\\dd}"
End Function
Public Shared Function GetDateTimeString() As String
Return $"{Now:yyyy-MM-dd_hh-mm-ffff}"
End Function
Public Shared Function GetDateTimeString(pDate As Date) As String
Return $"{pDate:yyyy-MM-dd_hh-mm-ffff}"
End Function
Friend Class InvalidChars Friend Class InvalidChars
Public Shared Filenames As String = Regex.Escape(New String(IO.Path.GetInvalidFileNameChars())) Public Shared Filenames As String = Regex.Escape(New String(IO.Path.GetInvalidFileNameChars()))
Public Shared Paths As String = Regex.Escape(New String(IO.Path.GetInvalidPathChars())) Public Shared Paths As String = Regex.Escape(New String(IO.Path.GetInvalidPathChars()))

30
Filesystem/File.vb
View File

@@ -41,6 +41,7 @@ Public Class File
' This prevents an infinite loop when no file can be created in a location ' This prevents an infinite loop when no file can be created in a location
Private Const MAX_FILE_VERSION = 100 Private Const MAX_FILE_VERSION = 100
Private Const VERSION_SEPARATOR As Char = "~"c
Private Const FILE_NAME_ACCESS_TEST = "accessTest.txt" Private Const FILE_NAME_ACCESS_TEST = "accessTest.txt"
@@ -123,7 +124,7 @@ Public Class File
''' <param name="pFilePath">Filepath to check</param> ''' <param name="pFilePath">Filepath to check</param>
''' <returns>Versioned string</returns> ''' <returns>Versioned string</returns>
Public Function GetVersionedFilename(pFilePath As String) As String Public Function GetVersionedFilename(pFilePath As String) As String
Return GetVersionedFilenameWithFilecheck(pFilePath, Function(pPath As String) IO.File.Exists(pFilePath)) Return GetVersionedFilenameWithFilecheck(pFilePath, Function(pPath As String) IO.File.Exists(pPath))
End Function End Function
''' <summary> ''' <summary>
@@ -140,14 +141,11 @@ Public Class File
Dim oDestinationDir = Path.GetDirectoryName(oFileName) Dim oDestinationDir = Path.GetDirectoryName(oFileName)
Dim oExtension = Path.GetExtension(oFileName) Dim oExtension = Path.GetExtension(oFileName)
Dim oVersionSeparator As Char = "~"c
Dim oFileNameWithoutExtension = Path.GetFileNameWithoutExtension(oFileName) Dim oFileNameWithoutExtension = Path.GetFileNameWithoutExtension(oFileName)
Dim oSplitResult = GetVersionedString(oFileNameWithoutExtension, oVersionSeparator) Dim oSplitResult = GetVersionedString(oFileNameWithoutExtension)
oFileNameWithoutExtension = oSplitResult.Item1 oFileNameWithoutExtension = oSplitResult.Item1
Dim oFileVersion = oSplitResult.Item2 Dim oFileVersion As Integer = oSplitResult.Item2
' Shorten the filename (only filename, without extension or version) ' Shorten the filename (only filename, without extension or version)
' by cutting the length in half. This should work no matter how long the path and/or filename are. ' by cutting the length in half. This should work no matter how long the path and/or filename are.
@@ -165,15 +163,15 @@ Public Class File
' while file exists, increment version. ' while file exists, increment version.
' version cannot go above MAX_FILE_VERSION, to prevent infinite loop ' version cannot go above MAX_FILE_VERSION, to prevent infinite loop
Do Do
If oFileVersion >= MAX_FILE_VERSION Then oFinalFileName = Path.Combine(oDestinationDir, GetFilenameWithVersion(oFileNameWithoutExtension, oFileVersion, oExtension))
Throw New OverflowException($"Tried '{MAX_FILE_VERSION}' times to version filename before giving up. Sorry.")
End If
oFinalFileName = Path.Combine(oDestinationDir, GetFilenameWithVersion(oFileNameWithoutExtension, oVersionSeparator, oFileVersion, oExtension))
_Logger.Debug("Intermediate Filename is {0}", oFinalFileName) _Logger.Debug("Intermediate Filename is {0}", oFinalFileName)
_Logger.Debug("File version: {0}", oFileVersion) _Logger.Debug("File version: {0}", oFileVersion)
oFileVersion += 1 oFileVersion += 1
Loop While pFileExistsAction(oFinalFileName) = True Loop While pFileExistsAction(oFinalFileName) = True And oFileVersion < MAX_FILE_VERSION
If oFileVersion >= MAX_FILE_VERSION Then
Throw New OverflowException($"Tried '{MAX_FILE_VERSION}' times to version filename before giving up. Sorry.")
End If
_Logger.Debug("Final Filename is {0}", oFinalFileName) _Logger.Debug("Final Filename is {0}", oFinalFileName)
@@ -200,8 +198,8 @@ Public Class File
''' <param name="pString">The string to versioned</param> ''' <param name="pString">The string to versioned</param>
''' <param name="pSeparator">The character to split at</param> ''' <param name="pSeparator">The character to split at</param>
''' <returns>Tuple of string and version</returns> ''' <returns>Tuple of string and version</returns>
Public Function GetVersionedString(pString As String, pSeparator As Char) As Tuple(Of String, Integer) Public Function GetVersionedString(pString As String) As Tuple(Of String, Integer)
Dim oSplitString = pString.Split(pSeparator).ToList() Dim oSplitString = pString.Split(VERSION_SEPARATOR).ToList()
Dim oStringVersion As Integer Dim oStringVersion As Integer
' if string is already versioned, extract string version ' if string is already versioned, extract string version
@@ -231,11 +229,11 @@ Public Class File
Return Path.Combine(oLocalAppData, CompanyName, ProductName) Return Path.Combine(oLocalAppData, CompanyName, ProductName)
End Function End Function
Private Function GetFilenameWithVersion(FileNameWithoutExtension As String, VersionSeparator As Char, FileVersion As Integer, Extension As String) As String Private Function GetFilenameWithVersion(FileNameWithoutExtension As String, FileVersion As Integer, Extension As String) As String
If FileVersion <= 1 Then If FileVersion <= 1 Then
Return $"{FileNameWithoutExtension}{Extension}" Return $"{FileNameWithoutExtension}{Extension}"
Else Else
Return $"{FileNameWithoutExtension}{VersionSeparator}{FileVersion}{Extension}" Return $"{FileNameWithoutExtension}{VERSION_SEPARATOR}{FileVersion}{Extension}"
End If End If
End Function End Function

6
Filesystem/My Project/AssemblyInfo.vb
View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")> <Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Filesystem")> <Assembly: AssemblyProduct("Modules.Filesystem")>
<Assembly: AssemblyCopyright("Copyright © 2023")> <Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyTrademark("1.5.1.1")> <Assembly: AssemblyTrademark("1.5.2.0")>
<Assembly: ComVisible(False)> <Assembly: ComVisible(False)>
@@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben: ' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.5.1.1")> <Assembly: AssemblyVersion("1.5.2.0")>
<Assembly: AssemblyFileVersion("1.5.1.1")> <Assembly: AssemblyFileVersion("1.5.2.0")>

2
Jobs/Jobs.vbproj
View File

@@ -100,6 +100,8 @@
<Compile Include="ZUGFeRD\EmailData.vb" /> <Compile Include="ZUGFeRD\EmailData.vb" />
<Compile Include="ZUGFeRD\EmailFunctions.vb" /> <Compile Include="ZUGFeRD\EmailFunctions.vb" />
<Compile Include="ZUGFeRD\EmailStrings.vb" /> <Compile Include="ZUGFeRD\EmailStrings.vb" />
<Compile Include="ZUGFeRD\FileFunctions.vb" />
<Compile Include="ZUGFeRD\HistoryFunctions.vb" />
<Compile Include="ZUGFeRD\ImportZUGFeRDFiles.vb" /> <Compile Include="ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="ZUGFeRD\WorkerArgs.vb" /> <Compile Include="ZUGFeRD\WorkerArgs.vb" />
<Compile Include="Exceptions.vb" /> <Compile Include="Exceptions.vb" />

290
Jobs/ZUGFeRD/EmailFunctions.vb
View File

@@ -1,113 +1,68 @@
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Language Imports DigitalData.Modules.Base
Imports System.Data Imports System.Data
Imports System.IO Imports System.IO
Imports System.Data.SqlClient Imports System.Data.SqlClient
Imports System.Collections.Generic
Public Class EmailFunctions Namespace ZUGFeRD
Private ReadOnly _logConfig As LogConfig Public Class EmailFunctions
Private ReadOnly _logger As Logger Private ReadOnly _logConfig As LogConfig
Private ReadOnly _mssql As MSSQLServer Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer) Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig _logConfig = LogConfig
_logger = _logConfig.GetLogger() _logger = _logConfig.GetLogger()
_mssql = MSSQL _mssql = MSSQL
End Sub End Sub
'Public Sub AddToEmailQueueFB(MessageId As String, BodyText As String, EmailData As EmailData, NamePortal As String) Public Sub AddToEmailQueueMSSQL(MessageId As String, BodyText As String, pEmailData As EmailData, SourceProcedure As String, pEmailAccountId As Integer, NamePortal As String)
' If EmailData Is Nothing Then If pEmailData Is Nothing Then
' _logger.Warn("EmailData is empty. Email will not be sent!") _logger.Warn("EmailData is empty. Email will not be sent!")
' Exit Sub Exit Sub
' End If End If
' Try Try
' Dim oJobId = RandomValue(1, 10000) Dim oJobId = RandomValue(1, 10000)
' Dim oReference = MessageId Dim oReference = MessageId
' Dim oEmailTo = "" Dim oEmailTo = ""
' Dim oSubject = EmailStrings.EMAIL_SUBJECT_REJECTED.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal) Dim oSubject = EmailStrings.EMAIL_SUBJECT_REJECTED.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal)
' Dim oAccountId = 1 Dim oCreatedWho = "ZUGFeRD Service"
' Dim oCreatedWho = "ZUGFeRD Service"
' Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), BodyText)
' Dim oEmailAddress = EmailData.From Dim oMaskedBodyText = BodyText.Replace("'", "''")
' Dim oAttachment = EmailData.Attachment Dim oSubjectBodyText = String.Format(EmailStrings.EMAIL_SUBJECT_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), pEmailData.Subject).Replace("'", "''")
Dim oCompleteBodyText = oMaskedBodyText & oSubjectBodyText
' If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), oCompleteBodyText)
' _logger.Warn("Could not find email-address for MessageId {0}", MessageId)
' oEmailTo = String.Empty
' Else
' oEmailTo = oEmailAddress
' End If
' _logger.Debug("Generated Email:") Dim oEmailAddress = pEmailData.From
' _logger.Debug("To: {0}", oEmailTo) Dim oAttachmentPath = pEmailData.Attachment
' _logger.Debug("Subject: {0}", oSubject) If oAttachmentPath <> String.Empty Then
' _logger.Debug("Body {0}", oFinalBodyText) _logger.Debug($"Attachment_String [{oAttachmentPath}]!")
' Dim osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE1 = '{oReference} and EMAIL_TO = ''{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'" If IO.File.Exists(oAttachmentPath) = False Then
_logger.Info($"Attachment.File [{oAttachmentPath}] is not existing!!!")
' Dim oDTResult As DataTable = _firebird.GetDatatable(osql) End If
' If oDTResult.Rows.Count = 0 Then
' Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE "
' oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES "
' oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{oFinalBodyText.Replace("'", "''")}', '{oCreatedWho}', '{oAttachment}')"
' _firebird.ExecuteNonQuery(oSQLInsert)
' _logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo)
' Else
' _logger.Debug("Email has already been sent!!")
' End If
' Catch ex As Exception
' _logger.Error(ex)
' End Try
'End Sub
Public Sub AddToEmailQueueMSSQL(MessageId As String, BodyText As String, pEmailData As EmailData, SourceProcedure As String, pEmailAccountId As Integer, NamePortal As String)
If pEmailData Is Nothing Then
_logger.Warn("EmailData is empty. Email will not be sent!")
Exit Sub
End If
Try
Dim oJobId = RandomValue(1, 10000)
Dim oReference = MessageId
Dim oEmailTo = ""
Dim oSubject = EmailStrings.EMAIL_SUBJECT_REJECTED.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal)
Dim oCreatedWho = "ZUGFeRD Service"
Dim oMaskedBodyText = BodyText.Replace("'", "''")
Dim oSubjectBodyText = String.Format(EmailStrings.EMAIL_SUBJECT_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), pEmailData.Subject).Replace("'", "''")
Dim oCompleteBodyText = oMaskedBodyText & oSubjectBodyText
Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), oCompleteBodyText)
Dim oEmailAddress = pEmailData.From
Dim oAttachmentPath = pEmailData.Attachment
If oAttachmentPath <> String.Empty Then
_logger.Debug($"Attachment_String [{oAttachmentPath}]!")
If IO.File.Exists(oAttachmentPath) = False Then
_logger.Info($"Attachment.File [{oAttachmentPath}] is not existing!!!")
End If End If
End If Dim oAttachmentPathEscaped = oAttachmentPath.Replace("'", "''")
Dim oAttachmentPathEscaped = oAttachmentPath.Replace("'", "''")
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId) _logger.Warn("Could not find email-address for MessageId {0}", MessageId)
oEmailTo = String.Empty oEmailTo = String.Empty
Else Else
oEmailTo = oEmailAddress oEmailTo = oEmailAddress
End If End If
_logger.Debug("Generated Email:") _logger.Debug("Generated Email:")
_logger.Debug("To: {0}", oEmailTo) _logger.Debug("To: {0}", oEmailTo)
_logger.Debug("Subject: {0}", oSubject) _logger.Debug("Subject: {0}", oSubject)
_logger.Debug("Body {0}", oFinalBodyText) _logger.Debug("Body {0}", oFinalBodyText)
Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'" Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Dim oHistoryID = _mssql.GetScalarValue(osql) Dim oHistoryID = _mssql.GetScalarValue(osql)
If IsNumeric(oHistoryID) Then If IsNumeric(oHistoryID) Then
Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT]
([REMINDER_TYPE_ID] ([REMINDER_TYPE_ID]
,[SENDING_PROFILE] ,[SENDING_PROFILE]
,[REFERENCE_ID] ,[REFERENCE_ID]
@@ -131,70 +86,97 @@ Public Class EmailFunctions
,'{SourceProcedure}' ,'{SourceProcedure}'
,'{oCreatedWho}' ,'{oCreatedWho}'
,'{oAttachmentPathEscaped}')" ,'{oAttachmentPathEscaped}')"
_mssql.ExecuteNonQuery(oInsert) _mssql.ExecuteNonQuery(oInsert)
Else Else
_logger.Warn("Could not get oHistoryID in AddToEmailQueueMSSQL!!") _logger.Warn("Could not get oHistoryID in AddToEmailQueueMSSQL!!")
End If End If
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
End Try End Try
End Sub End Sub
Public Function GetEmailDataForMessageId(MessageId As String) As EmailData Public Function GetEmailDataForMessageId(MessageId As String) As EmailData
Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'" Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Try Try
Dim oDatatable = _mssql.GetDatatable(oSQL) Dim oDatatable = _mssql.GetDatatable(oSQL)
Dim oRow As DataRow Dim oRow As DataRow
If oDatatable.Rows.Count = 0 Then If oDatatable.Rows.Count = 0 Then
_logger.Warn("Got no results for MessageId {0}", MessageId) _logger.Warn("Got no results for MessageId {0}", MessageId)
Return Nothing
ElseIf oDatatable.Rows.Count > 1 Then
_logger.Warn("Got too many results for MessageId {0}. Using last row.", MessageId)
End If
_logger.Debug("Got Email Data for FileId {0}", MessageId)
oRow = oDatatable.Rows.Item(oDatatable.Rows.Count - 1)
Dim oFromDefault = String.Format("No Sender found for ({0})", MessageId)
Dim oFrom = oRow.ItemEx("EMAIL_FROM", oFromDefault)
Dim oSubjectDefault = String.Format("No Subject found for ({0})", MessageId)
Dim oSubject = oRow.ItemEx("EMAIL_SUBJECT", oSubjectDefault)
_logger.Info("Email Data for [{0}] fetched!", MessageId)
Return New EmailData() With {
.From = oFrom,
.Subject = oSubject
}
Catch ex As Exception
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
Return Nothing Return Nothing
ElseIf oDatatable.Rows.Count > 1 Then End Try
_logger.Warn("Got too many results for MessageId {0}. Using last row.", MessageId) End Function
Public Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
Dim oAttachmentFile = MessageId & ".eml"
Dim oAttachmentPath = Path.Combine(OriginalEmailDirectory, oAttachmentFile)
If File.Exists(oAttachmentPath) Then
Return oAttachmentPath
Else
_logger.Warn("Email File {0} does not exist. Empty String will be returned.", oAttachmentPath)
Return String.Empty
End If
End Function
Public Function GetEmailPathWithSubjectAsName(RejectedEmailDirectory As String, UncleanedSubject As String) As String
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
Dim oAttachmentFile = oCleanSubject & ".eml"
_logger.Debug("Email Filename is [{0}]", oAttachmentFile)
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
Return oAttachmentPath
End Function
Private Function RandomValue(lowerBound As Integer, upperBound As Integer) As Integer
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
Return oRandomValue
End Function
Public Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) As String
Dim oBody = String.Format(EmailStrings.EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then
oBody &= $"{vbNewLine}{vbNewLine}"
oBody &= EmailStrings.EMAIL_MISSINGPROPERTIES_2
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties
oBody &= $"- {prop}"
Next
End If End If
_logger.Debug("Got Email Data for FileId {0}", MessageId) Return oBody
oRow = oDatatable.Rows.Item(oDatatable.Rows.Count - 1) End Function
Dim oFromDefault = String.Format("No Sender found for ({0})", MessageId) Public Function CreateBodyForUnhandledException(MessageId As String, Exception As Exception) As String
Dim oFrom = oRow.ItemEx("EMAIL_FROM", oFromDefault) Dim oBody = String.Format(EmailStrings.EMAIL_UNHANDLED_EXCEPTION, MessageId, Exception.Message, Exception.StackTrace)
Dim oSubjectDefault = String.Format("No Subject found for ({0})", MessageId) Return oBody
Dim oSubject = oRow.ItemEx("EMAIL_SUBJECT", oSubjectDefault) End Function
End Class
Return New EmailData() With { End Namespace
.From = oFrom,
.Subject = oSubject
}
Catch ex As Exception
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
Return Nothing
End Try
End Function
Public Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
Dim oAttachmentFile = MessageId & ".eml"
Dim oAttachmentPath = Path.Combine(OriginalEmailDirectory, oAttachmentFile)
If File.Exists(oAttachmentPath) Then
Return oAttachmentPath
Else
_logger.Warn("Email File {0} does not exist. Empty String will be returned.", oAttachmentPath)
Return String.Empty
End If
End Function
Public Function GetEmailPathWithSubjectAsName(RejectedEmailDirectory As String, UncleanedSubject As String) As String
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
Dim oAttachmentFile = oCleanSubject & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
Return oAttachmentPath
End Function
Private Function RandomValue(lowerBound As Integer, upperBound As Integer) As Integer
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
Return oRandomValue
End Function
End Class

112
Jobs/ZUGFeRD/FileFunctions.vb Normal file
View File

@@ -0,0 +1,112 @@
Imports System.Collections.Generic
Imports System.IO
Imports System.Linq
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD
Public Class FileFunctions
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _filesystem As Filesystem.File
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_mssql = MSSQL
_filesystem = New Filesystem.File(LogConfig)
End Sub
Public Sub MoveFiles(
Args As WorkerArgs,
MessageId As String,
Files As List(Of FileInfo),
AttachmentFiles As List(Of FileInfo),
EmbeddedAttachments As List(Of PDFEmbeds.EmbeddedFile),
MoveDirectory As String,
IsSuccess As Boolean)
Dim oFinalMoveDirectory As String = MoveDirectory
Dim oDateSubDirectoryName As String = Now.ToString("yyyy\\MM\\dd")
Dim oAttachmentDirectory As String = Path.Combine(oFinalMoveDirectory, Args.AttachmentsSubDirectory, oDateSubDirectoryName)
' Files will be moved to a subfolder for the current day if they are rejected
If Not IsSuccess Then
oFinalMoveDirectory = Path.Combine(oFinalMoveDirectory, oDateSubDirectoryName)
End If
' Create directories if they don't exist
If Not Directory.Exists(oFinalMoveDirectory) Then
Try
Directory.CreateDirectory(oFinalMoveDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
If Not Directory.Exists(oAttachmentDirectory) And AttachmentFiles.Count > 0 Then
Try
Directory.CreateDirectory(oAttachmentDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
' Filter out Attachments from `Files`
Dim oInvoiceFiles As List(Of FileInfo) = Files.Except(AttachmentFiles).ToList()
' Move PDF/A Files
For Each oFile In oInvoiceFiles
Try
Dim oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oFinalMoveDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFilePath, oFinalMoveDirectory)
_logger.Info("File moved to {0}", oFilePath)
Catch ex As Exception
_logger.Warn("Could not move file {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Move non-PDF/A Email Attachments/Files
For Each oFile In AttachmentFiles
Try
Dim oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oAttachmentDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFilePath, oAttachmentDirectory)
_logger.Info("Attachment moved to {0}", oFilePath)
Catch ex As Exception
_logger.Warn("Could not move attachment {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Write Embedded Files to disk
For Each oResult In EmbeddedAttachments
Try
Dim oFileName As String = $"{MessageId}~{oResult.FileName}"
Dim oFilePath As String = Path.Combine(oAttachmentDirectory, oFileName)
If Not File.Exists(oAttachmentDirectory) Then
Directory.CreateDirectory(oAttachmentDirectory)
End If
Using oWriter As New FileStream(oFilePath, FileMode.Create)
oWriter.Write(oResult.FileContents, 0, oResult.FileContents.Length)
_logger.Info("Embedded Attachment moved to {0}", oFilePath)
End Using
Catch ex As Exception
_logger.Warn("Could not save embedded attachment {0}", oResult.FileName)
_logger.Error(ex)
End Try
Next
_logger.Info("Finished moving files")
End Sub
End Class
End Namespace

68
Jobs/ZUGFeRD/HistoryFunctions.vb Normal file
View File

@@ -0,0 +1,68 @@
Imports System.Data.SqlClient
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD
Public Class HistoryFunctions
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_mssql = MSSQL
End Sub
Public Function Create_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Creating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
Dim oSQL = $"INSERT INTO TBEMLP_HISTORY (COMMENT, MD5HASH, EMAIL_MSGID) VALUES ('{Message}', '{MD5Checksum}', '{MessageId}')"
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
If Message.Contains("REJECTED") Then
oSQL = $"UPDATE TBEMLP_HISTORY SET STATUS = 'REJECTED', COMMENT = '{Message}', CUST_REJECTED = 1,CUST_REJECTED_WHEN = GETDATE() WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End If
_logger.Debug("History Entry created!")
End Using
Return True
Catch ex As Exception
_logger.Warn("History Entry count not be created for message id [{0}] and md5 [{1}]", MessageId, MD5Checksum)
_logger.Error(ex)
Return False
End Try
End Function
Public Function Update_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Updating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
' Only look for history entry by MessageId since the MD5 Hash might not be generated yet
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
Dim oSQL = $"UPDATE TBEMLP_HISTORY SET COMMENT = '{Message}' WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End Using
_logger.Debug("History Entry created!")
Return True
Catch ex As Exception
_logger.Warn("History Entry count not be updated for message id [{0}] and md5 [{1}]", MessageId, MD5Checksum)
_logger.Error(ex)
Return False
End Try
End Function
End Class
End Namespace

256
Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@@ -9,7 +9,6 @@ Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Interfaces.Exceptions Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Jobs.Exceptions Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports FirebirdSql.Data.FirebirdClient
Imports System.Data.SqlClient Imports System.Data.SqlClient
Public Class ImportZUGFeRDFiles Public Class ImportZUGFeRDFiles
@@ -35,7 +34,10 @@ Public Class ImportZUGFeRDFiles
Private ReadOnly _logConfig As LogConfig Private ReadOnly _logConfig As LogConfig
Private ReadOnly _filesystem As Filesystem.File Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _mssql As MSSQLServer Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions Private ReadOnly _email As ZUGFeRD.EmailFunctions
Private ReadOnly _file As ZUGFeRD.FileFunctions
Private ReadOnly _history As ZUGFeRD.HistoryFunctions
Private ReadOnly _gdpictureLicenseKey As String Private ReadOnly _gdpictureLicenseKey As String
Private _zugferd As ZUGFeRDInterface Private _zugferd As ZUGFeRDInterface
@@ -51,7 +53,9 @@ Public Class ImportZUGFeRDFiles
_logger = LogConfig.GetLogger() _logger = LogConfig.GetLogger()
_filesystem = New Filesystem.File(_logConfig) _filesystem = New Filesystem.File(_logConfig)
_mssql = MSSQL _mssql = MSSQL
_email = New EmailFunctions(LogConfig, _mssql) _email = New ZUGFeRD.EmailFunctions(LogConfig, _mssql)
_file = New ZUGFeRD.FileFunctions(LogConfig, _mssql)
_history = New ZUGFeRD.HistoryFunctions(LogConfig, _mssql)
_logger.Debug("Registering GDPicture License") _logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then If _mssql IsNot Nothing Then
@@ -63,18 +67,23 @@ Public Class ImportZUGFeRDFiles
End If End If
End Sub End Sub
Private Function MoveAndRenameEmailToRejected(Args As WorkerArgs, MessageId As String) As EmailData Private Function MoveAndRenameEmailToRejected(pArgs As WorkerArgs, pMessageId As String) As EmailData
_logger.Info("Moving Mail with MessageId [{0}] to Rejected folder", MessageId) _logger.Info("Moving Mail with MessageId [{0}] to Rejected folder", pMessageId)
_logger.Debug("Fetching Email Data") _logger.Debug("Fetching Email Data")
Dim oEmailData = _email.GetEmailDataForMessageId(MessageId) Dim oEmailData = _email.GetEmailDataForMessageId(pMessageId)
Dim oSource = _email.GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId) _logger.Debug("Email Data fetched!")
Dim oSource = _email.GetOriginalEmailPath(pArgs.OriginalEmailDirectory, pMessageId)
_logger.Debug("Original email path: [{0}]", oSource)
Dim oDateSubDirectoryName As String = Now.ToString("yyyy-MM-dd") Dim oDateSubDirectoryName As String = Now.ToString("yyyy-MM-dd")
Dim oDestination As String Dim oDestination As String
Dim oRejectedDirectory As String = Path.Combine(Args.RejectedEmailDirectory, oDateSubDirectoryName) Dim oRejectedDirectory As String = Path.Combine(pArgs.RejectedEmailDirectory, oDateSubDirectoryName)
' Create the destination directory if it does not exist ' Create the destination directory if it does not exist
_logger.Debug("Creating destination directory [{0}]", oRejectedDirectory)
If Not Directory.Exists(oRejectedDirectory) Then If Not Directory.Exists(oRejectedDirectory) Then
Try Try
Directory.CreateDirectory(oRejectedDirectory) Directory.CreateDirectory(oRejectedDirectory)
@@ -83,12 +92,17 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End If End If
If oSource = String.Empty Then
_logger.Warn("Original Email for [{0}] could not be found. Exiting.", pMessageId)
Return Nothing
End If
' If oEmailData is Nothing, TBEDM_EMAIL_PROFILER_HISTORY for MessageId was not found. ' If oEmailData is Nothing, TBEDM_EMAIL_PROFILER_HISTORY for MessageId was not found.
' This only should happen when testing and db-tables are deleted frequently ' This only should happen when testing and db-tables are deleted frequently
If oEmailData Is Nothing Then If oEmailData Is Nothing Then
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, MessageId) oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, pMessageId)
Else Else
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, oEmailData.Subject) oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, StringEx.ConvertTextToSlug(oEmailData.Subject))
End If End If
_logger.Debug("Destination for eml file is {0}", oDestination) _logger.Debug("Destination for eml file is {0}", oDestination)
@@ -102,6 +116,8 @@ Public Class ImportZUGFeRDFiles
Return Nothing Return Nothing
End If End If
'---------------------------
Try Try
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName) _logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
File.Move(oSource, oFinalFileName) File.Move(oSource, oFinalFileName)
@@ -112,6 +128,8 @@ Public Class ImportZUGFeRDFiles
oEmailData.Attachment = oSource oEmailData.Attachment = oSource
End Try End Try
_logger.Info("Email [{0}] moved to rejected folder!", pMessageId)
Return oEmailData Return oEmailData
End Function End Function
@@ -351,20 +369,9 @@ Public Class ImportZUGFeRDFiles
'If no errors occurred... 'If no errors occurred...
'Log the History 'Log the History
If oMD5CheckSum <> String.Empty Then If oMD5CheckSum <> String.Empty Then
Create_HistoryEntry(oMessageId, oMD5CheckSum, "SUCCESS", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "SUCCESS", oSQLTransaction)
'Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oMessageId}', '{oMD5CheckSum}')"
'_firebird.ExecuteNonQueryWithConnection(oInsertCommand, oFBConnection, Firebird.TransactionMode.ExternalTransaction, oFBTransaction)
'' History ID is only need in case of an error
'oFBTransaction.Commit()
'Try
' Dim oSQL = $"SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE MESSAGE_ID = '{oMessageId}'"
' HISTORY_ID = _firebird.GetScalarValue(oSQL)
'Catch ex As Exception
' HISTORY_ID = 0
'End Try
Else Else
Create_HistoryEntry(oMessageId, String.Empty, "SUCCESS (with empty MD5Hash)", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, String.Empty, "SUCCESS (with empty MD5Hash)", oSQLTransaction)
End If End If
oIsSuccess = True oIsSuccess = True
@@ -375,7 +382,7 @@ Public Class ImportZUGFeRDFiles
Dim oErrors = ex.ValidationErrors Dim oErrors = ex.ValidationErrors
Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!" Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage, oSQLTransaction) _history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage, oSQLTransaction)
Dim oErrorList As String = "" Dim oErrorList As String = ""
For Each oError In oErrors For Each oError In oErrors
@@ -384,7 +391,6 @@ Public Class ImportZUGFeRDFiles
Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList) Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "ValidationException", "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction) AddRejectedState(oMessageId, "ValidationException", "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction)
@@ -394,7 +400,7 @@ Public Class ImportZUGFeRDFiles
' When MD5HashException is thrown, we don't have a MD5Hash yet. ' When MD5HashException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here. ' That 's why we set it to String.Empty here.
Dim oMessage = "REJECTED - Already processed (MD5Hash)" Dim oMessage = "REJECTED - Already processed (MD5Hash)"
Update_HistoryEntry(oMessageId, String.Empty, oMessage, oSQLTransaction) _history.Update_HistoryEntry(oMessageId, String.Empty, oMessage, oSQLTransaction)
Dim oBody = EmailStrings.EMAIL_MD5_ERROR Dim oBody = EmailStrings.EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
@@ -406,7 +412,7 @@ Public Class ImportZUGFeRDFiles
' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet. ' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here. ' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile) Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile)
@@ -419,7 +425,7 @@ Public Class ImportZUGFeRDFiles
' When InvalidFerdException is thrown, we don't have a MD5Hash yet. ' When InvalidFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here. ' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject) Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
@@ -430,7 +436,7 @@ Public Class ImportZUGFeRDFiles
Catch ex As TooMuchFerdsException Catch ex As TooMuchFerdsException
_logger.Error(ex) _logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject) Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
@@ -441,7 +447,7 @@ Public Class ImportZUGFeRDFiles
Catch ex As NoFerdsException Catch ex As NoFerdsException
_logger.Error(ex) _logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject) Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
@@ -449,11 +455,6 @@ Public Class ImportZUGFeRDFiles
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction) AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction)
Catch ex As NoFerdsAlternateException
' TODO: Maybe dont even log this 'error', since it's not really an error and it might happen *A LOT*
_logger.Error(ex)
oMoveDirectory = oArgs.NonZugferdDirectory
Catch ex As MissingValueException Catch ex As MissingValueException
_logger.Error(ex) _logger.Error(ex)
@@ -462,9 +463,9 @@ Public Class ImportZUGFeRDFiles
oMessage &= $"- {prop}" oMessage &= $"- {prop}"
Next Next
Create_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]", oSQLTransaction)
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties) Dim oBody = _email.CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage, oSQLTransaction) AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage, oSQLTransaction)
@@ -472,7 +473,7 @@ Public Class ImportZUGFeRDFiles
Catch ex As FileSizeLimitReachedException Catch ex As FileSizeLimitReachedException
_logger.Error(ex) _logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached", oSQLTransaction) _history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
@@ -487,12 +488,18 @@ Public Class ImportZUGFeRDFiles
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "FileSizeLimitReachedException", "Erlaubte Dateigröße überschritten", "", oSQLTransaction) AddRejectedState(oMessageId, "FileSizeLimitReachedException", "Erlaubte Dateigröße überschritten", "", oSQLTransaction)
Catch ex As NoFerdsAlternateException
' TODO: Maybe dont even log this 'error', since it's not really an error and it might happen *A LOT*
_logger.Error(ex)
oMoveDirectory = oArgs.NonZugferdDirectory
Catch ex As OutOfMemoryException Catch ex As OutOfMemoryException
_logger.Warn("OutOfMemory Error occurred: {0}", ex.Message) _logger.Warn("OutOfMemory Error occurred: {0}", ex.Message)
_logger.Error(ex) _logger.Error(ex)
' Send Email to Digital Data ' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex) Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With { Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress, .From = oArgs.ExceptionEmailAddress,
.Subject = $"OutOfMemoryException im ZUGFeRD-Parser @ {oMessageId}" .Subject = $"OutOfMemoryException im ZUGFeRD-Parser @ {oMessageId}"
@@ -511,7 +518,7 @@ Public Class ImportZUGFeRDFiles
_logger.Error(ex) _logger.Error(ex)
' Send Email to Digital Data ' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex) Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With { Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress, .From = oArgs.ExceptionEmailAddress,
.Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}" .Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}"
@@ -532,12 +539,12 @@ Public Class ImportZUGFeRDFiles
_logger.Info("Application Error occurred. Files for message Id {0} will not be moved.", oMessageId) _logger.Info("Application Error occurred. Files for message Id {0} will not be moved.", oMessageId)
Else Else
' Move all files of the current group ' Move all files of the current group
MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess) _file.MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess)
End If End If
_logger.Info("Finished processing file group {0}", oMessageId) _logger.Info("Finished processing file group {0}", oMessageId)
Catch ex As Exception Catch ex As Exception
' Send Email to Digital Data ' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex) Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With { Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress, .From = oArgs.ExceptionEmailAddress,
.Subject = $"FileMoveException im ZUGFeRD-Parser @ {oMessageId}" .Subject = $"FileMoveException im ZUGFeRD-Parser @ {oMessageId}"
@@ -612,123 +619,6 @@ Public Class ImportZUGFeRDFiles
End If End If
End Sub End Sub
Private Function DoGetPropertyMapFor(pWorkerArgs As WorkerArgs, pSpecification As String) As Dictionary(Of String, XmlItemProperty)
Return pWorkerArgs.PropertyMap.
Where(Function(kv) kv.Value.Specification = pSpecification).
ToDictionary(Function(kv) kv.Key, Function(kv) kv.Value)
End Function
Private Sub MoveFiles(
Args As WorkerArgs,
MessageId As String,
Files As List(Of FileInfo),
AttachmentFiles As List(Of FileInfo),
EmbeddedAttachments As List(Of PDFEmbeds.EmbeddedFile),
MoveDirectory As String,
IsSuccess As Boolean)
Dim oFinalMoveDirectory As String = MoveDirectory
Dim oDateSubDirectoryName As String = Now.ToString("yyyy\\MM\\dd")
Dim oAttachmentDirectory As String = Path.Combine(oFinalMoveDirectory, Args.AttachmentsSubDirectory, oDateSubDirectoryName)
' Files will be moved to a subfolder for the current day if they are rejected
If Not IsSuccess Then
oFinalMoveDirectory = Path.Combine(oFinalMoveDirectory, oDateSubDirectoryName)
End If
' Create directories if they don't exist
If Not Directory.Exists(oFinalMoveDirectory) Then
Try
Directory.CreateDirectory(oFinalMoveDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
If Not Directory.Exists(oAttachmentDirectory) And AttachmentFiles.Count > 0 Then
Try
Directory.CreateDirectory(oAttachmentDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
' Filter out Attachments from `Files`
Dim oInvoiceFiles As List(Of FileInfo) = Files.Except(AttachmentFiles).ToList()
' Move PDF/A Files
For Each oFile In oInvoiceFiles
Try
Dim oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oFinalMoveDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFilePath, oFinalMoveDirectory)
_logger.Info("File moved to {0}", oFilePath)
Catch ex As Exception
_logger.Warn("Could not move file {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Move non-PDF/A Email Attachments/Files
For Each oFile In AttachmentFiles
Try
Dim oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oAttachmentDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFilePath, oAttachmentDirectory)
_logger.Info("Attachment moved to {0}", oFilePath)
Catch ex As Exception
_logger.Warn("Could not move attachment {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Write Embedded Files to disk
For Each oResult In EmbeddedAttachments
Try
Dim oFileName As String = $"{MessageId}~{oResult.FileName}"
Dim oFilePath As String = Path.Combine(oAttachmentDirectory, oFileName)
If Not File.Exists(oAttachmentDirectory) Then
Directory.CreateDirectory(oAttachmentDirectory)
End If
Using oWriter As New FileStream(oFilePath, FileMode.Create)
oWriter.Write(oResult.FileContents, 0, oResult.FileContents.Length)
_logger.Info("Embedded Attachment moved to {0}", oFilePath)
End Using
Catch ex As Exception
_logger.Warn("Could not save embedded attachment {0}", oResult.FileName)
_logger.Error(ex)
End Try
Next
_logger.Info("Finished moving files")
End Sub
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) As String
Dim oBody = String.Format(EmailStrings.EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then
oBody &= $"{vbNewLine}{vbNewLine}"
oBody &= EmailStrings.EMAIL_MISSINGPROPERTIES_2
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties
oBody &= $"- {prop}"
Next
End If
Return oBody
End Function
Private Function CreateBodyForUnhandledException(MessageId As String, Exception As Exception) As String
Dim oBody = String.Format(EmailStrings.EMAIL_UNHANDLED_EXCEPTION, MessageId, Exception.Message, Exception.StackTrace)
Return oBody
End Function
Private Function CreateMD5(ByVal Filename As String) As String Private Function CreateMD5(ByVal Filename As String) As String
Try Try
Dim oMD5 As New MD5CryptoServiceProvider Dim oMD5 As New MD5CryptoServiceProvider
@@ -749,55 +639,7 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Function End Function
Private Function Create_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Creating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
Dim oSQL = $"INSERT INTO TBEMLP_HISTORY (COMMENT, MD5HASH, EMAIL_MSGID) VALUES ('{Message}', '{MD5Checksum}', '{MessageId}')"
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
If Message.Contains("REJECTED") Then
oSQL = $"UPDATE TBEMLP_HISTORY SET STATUS = 'REJECTED', COMMENT = '{Message}', CUST_REJECTED = 1,CUST_REJECTED_WHEN = GETDATE() WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End If
_logger.Debug("History Entry created!")
End Using
Return True
Catch ex As Exception
_logger.Warn("History Entry count not be created for message id [{0}] and md5 [{1}]", MessageId, MD5Checksum)
_logger.Error(ex)
Return False
End Try
End Function
Private Function Update_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Updating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
' Only look for history entry by MessageId since the MD5 Hash might not be generated yet
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
Dim oSQL = $"UPDATE TBEMLP_HISTORY SET COMMENT = '{Message}' WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End Using
_logger.Debug("History Entry created!")
Return True
Catch ex As Exception
_logger.Warn("History Entry count not be updated for message id [{0}] and md5 [{1}]", MessageId, MD5Checksum)
_logger.Error(ex)
Return False
End Try
End Function
''' <summary> ''' <summary>
''' Generates the MD5 Checksum of a file and checks it against the histroy table TBEDM_ZUGFERD_HISTORY_IN ''' Generates the MD5 Checksum of a file and checks it against the histroy table TBEDM_ZUGFERD_HISTORY_IN

2
Messaging/Limilab.vb
View File

@@ -66,7 +66,7 @@ Public Class Limilab
End Function End Function
Private Function LOG_Limilab(Log_enabled As Boolean) As Boolean Private Function LOG_Limilab(Log_enabled As Boolean) As Boolean
Mail.Log.Enabled = Log_enabled Log.Enabled = Log_enabled
End Function End Function
''' <summary> ''' <summary>

177
Messaging/Mail/MailFetcher.vb Normal file
View File

@@ -0,0 +1,177 @@
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports Limilabs.Client.IMAP
Imports Limilabs.Client
Imports Limilabs.Mail
Namespace Mail
Public Class MailFetcher
Inherits BaseClass
Private ReadOnly MailSession As MailSession
Private ReadOnly MailBuilder As New MailBuilder
Public ReadOnly Property Connected2Server As Boolean
Get
Return MailSession.Session.Connected
End Get
End Property
Public ReadOnly Property Client As Imap
Get
Return MailSession?.Client
End Get
End Property
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
MailSession = New MailSession(pLogConfig, New Imap)
Log.Enabled = pLogConfig.Debug
End Sub
Public Function Connect(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String) As MailSession.SessionInfo
Return MailSession.ConnectToServer(pServer, pPort, pUser, pPassword, pAuthType, New MailSession.MailSessionOptions)
End Function
Public Function Connect(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSession.MailSessionOptions) As MailSession.SessionInfo
Return MailSession.ConnectToServer(pServer, pPort, pUser, pPassword, pAuthType, pOptions)
End Function
Public Function Disconnect() As Boolean
Return MailSession.DisconnectFromServer()
End Function
Public Async Function FetchAllMails() As Task(Of List(Of IMail))
Return Await FetchMailsAsync(Flag.All)
End Function
Public Async Function FetchUnreadMails() As Task(Of List(Of IMail))
Return Await FetchMailsAsync(Flag.Unseen)
End Function
Public Function ListAllMails() As List(Of Long)
Return ListMails(Flag.All)
End Function
Public Function ListUnseenMails() As List(Of Long)
Return ListMails(Flag.Unseen)
End Function
Public Async Function FetchMailsAsync(pMailFlag As Flag) As Task(Of List(Of IMail))
Dim oMailIds = ListMails(pMailFlag)
Dim oMails As New List(Of IMail)
For Each oId In oMailIds
Dim oMail As IMail = Await FetchMailAsync(oId)
oMails.Add(oMail)
Next
Return oMails
End Function
Public Function ListMails(pMailFlag As Flag) As List(Of Long)
Try
If MailSession.Session.Connected Then
Dim oClient As Imap = MailSession.Client
Dim oStatus = oClient.SelectInbox()
Dim oMailIds = oClient.Search(pMailFlag)
Logger.Debug("Fetched [{0}] mail objects.", oMailIds.Count)
Return oMailIds
Else
Logger.Error("No connection to Server. Exiting.")
Return Nothing
End If
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Async Function ListMailsAsync(pMailFlag As Flag) As Task(Of List(Of Long))
Try
If MailSession.Session.Connected Then
Dim oClient As Imap = MailSession.Client
Dim oStatus = Await oClient.SelectInboxAsync()
Dim oMailIds = Await oClient.SearchAsync(pMailFlag)
Logger.Debug("Fetched [{0}] mail objects.", oMailIds.Count)
Return oMailIds
Else
Logger.Error("No connection to Server. Exiting.")
Return Nothing
End If
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function FetchMail(pMailId As Long) As IMail
Try
If MailSession.Session.Connected Then
Dim oClient As Imap = MailSession.Client
Logger.Debug("Fetching mail with Id [{0}]", pMailId)
Dim oBuffer As Byte() = oClient.GetMessageByUID(pMailId)
Dim oMail As IMail = MailBuilder.CreateFromEml(oBuffer)
Return oMail
Else
Logger.Error("No connection to Server. Exiting.")
Return Nothing
End If
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Async Function FetchMailAsync(pMailId As Long) As Task(Of IMail)
Try
If MailSession.Session.Connected Then
Dim oClient As Imap = MailSession.Client
Logger.Debug("Fetching mail with Id [{0}]", pMailId)
Dim oBuffer As Byte() = Await oClient.GetMessageByUIDAsync(pMailId)
Dim oMail As IMail = MailBuilder.CreateFromEml(oBuffer)
Return oMail
Else
Logger.Error("No connection to Server. Exiting.")
Return Nothing
End If
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function DeleteMail(pMailId As Long) As Boolean
Try
If MailSession.Session.Connected Then
Dim oClient As Imap = MailSession.Client
Logger.Debug("Fetching mail with Id [{0}]", pMailId)
oClient.DeleteMessageByUID(pMailId)
Return True
Else
Logger.Error("No connection to Server. Exiting.")
Return False
End If
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
End Class
End Namespace

132
Messaging/Mail/MailSender.vb Normal file
View File

@@ -0,0 +1,132 @@
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports Limilabs.Client.SMTP
Namespace Mail
Public Class MailSender
Inherits BaseClass
Private Property MailSession As MailSession
Public ReadOnly Property Connected2Server As Boolean
Get
Return MailSession.Session.Connected
End Get
End Property
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
MailSession = New MailSession(pLogConfig, New Smtp)
Limilabs.Mail.Log.Enabled = pLogConfig.Debug
End Sub
Public Function Connect(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String) As MailSession.SessionInfo
Return MailSession.ConnectToServer(pServer, pPort, pUser, pPassword, pAuthType, New MailSession.MailSessionOptions)
End Function
Public Function Connect(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSession.MailSessionOptions) As MailSession.SessionInfo
Return MailSession.ConnectToServer(pServer, pPort, pUser, pPassword, pAuthType, pOptions)
End Function
Public Function Disconnect() As Boolean
Return MailSession.DisconnectFromServer()
End Function
Public Function SendMail(pSendTo As List(Of String), pSendFrom As String, pSubject As String, pBody As String, pCreationTime As Date, pAttachments As List(Of String), pTest As Boolean) As Boolean
Dim oSuccessfulSends As New List(Of String)
Dim oFailedSends As New List(Of String)
For Each oSendToAddress In pSendTo
Dim oResult = SendMailTo(oSendToAddress, pSendFrom, pSubject, pBody, pCreationTime, pAttachments, pTest)
If oResult = True Then
oSuccessfulSends.Add(oSendToAddress)
Else
oFailedSends.Add(oSendToAddress)
End If
Next
Logger.Debug("Sent [{0}] mails.", pSendTo.Count)
Logger.Debug("Successful [{0}]", oSuccessfulSends.Count)
Logger.Debug("Failed [{0}]", oFailedSends.Count)
Return True
End Function
Private Function SendMailTo(pSendTo As String, pSendFrom As String, pSubject As String, pBody As String, pCreationTime As Date, pAttachments As List(Of String), pTest As Boolean)
Try
Dim oClient As Smtp = DirectCast(MailSession.Client, Smtp)
If IsNothing(oClient) Then
Logger.Warn("Client is nothing! Exiting.")
Return False
End If
Logger.Debug("Preparing to send mail to [{0}]", pSendTo)
Dim oMailBuilder As New Limilabs.Mail.MailBuilder()
oMailBuilder.From.Add(New Limilabs.Mail.Headers.MailBox(pSendFrom))
oMailBuilder.To.Add(New Limilabs.Mail.Headers.MailBox(pSendTo))
oMailBuilder.Subject = pSubject
Logger.Debug("Setting body for mail")
oMailBuilder = SetBody(oMailBuilder, pBody, pCreationTime, pTest)
Logger.Debug("Adding [{0}] attachments to mail", pAttachments.Count)
oMailBuilder = AddAttachments(oMailBuilder, pAttachments)
Logger.Debug("Now sending mail..")
Dim oMail = oMailBuilder.Create()
oClient.SendMessage(oMail)
Logger.Info("Mail to [{0}] has been sent.", pSendTo)
Return True
Catch ex As Exception
Logger.Warn("Error while sending mail to [{0}]", pSendTo)
Logger.Error(ex)
Return False
End Try
End Function
Private Function SetBody(pMailBuilder As Limilabs.Mail.MailBuilder, pBody As String, pCreationTime As Date, pTest As Boolean) As Limilabs.Mail.MailBuilder
If pCreationTime <> Date.MinValue Then
pBody &= $"<p>Creation-time: {pCreationTime}</p>"
End If
If pTest Then
pBody = $"<p>This Is a Testmail!<br/>
The body-text will be replaced within profile!<br/>
Server/Port: {MailSession.Session.Server}/{MailSession.Session.Port}<br/>
User: {MailSession.Session.User}<br/>
Password: XXXX<br/>
Auth Type: {MailSession.Session.AuthType}</p>"
End If
Logger.Debug("Final Mailbody is: [{0}]", pBody)
pMailBuilder.Html = pBody
Return pMailBuilder
End Function
Private Function AddAttachments(pMailBuilder As Limilabs.Mail.MailBuilder, pAttachments As List(Of String)) As Limilabs.Mail.MailBuilder
For Each oAttachment In pAttachments
Try
' Read attachment from disk, add it to Attachments collection
If IO.File.Exists(oAttachment) Then
Logger.Debug("Adding attachment [{0}] to mail.", oAttachment)
pMailBuilder.AddAttachment(oAttachment)
Else
Logger.Warn("Attachment [{0}] does not exist. Skipping.", oAttachment)
End If
Catch ex As Exception
Logger.Warn("Could not read or add attachment [{0}]!", oAttachment)
Logger.Error(ex)
End Try
Next
Return pMailBuilder
End Function
End Class
End Namespace

322
Messaging/Mail/MailSession.vb Normal file
View File

@@ -0,0 +1,322 @@
Imports System.Net.Security
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports Limilabs.Client
Imports Limilabs.Client.IMAP
Imports Limilabs.Client.SMTP
Imports Microsoft.Identity.Client
Namespace Mail
Public Class MailSession
Inherits BaseClass
Public ReadOnly Client As ClientBase
Public ReadOnly OAuth2 As OAuth2
Public Const AUTH_SSL = "SSL"
Public Const AUTH_STARTTLS = "STARTTLS"
Public Const AUTH_SSLTLS = "SSL/TLS"
Public Const AUTH_NONE = "NONE"
Public Const AUTH_OAUTH2 = "OAUTH2"
Private Const SMTP_IGNORED_ERRORS As SslPolicyErrors =
SslPolicyErrors.RemoteCertificateChainErrors Or ' self-signed
SslPolicyErrors.RemoteCertificateNameMismatch ' name mismatch
Private _Session As SessionInfo
Public ReadOnly Property Session As SessionInfo
Get
Return _Session
End Get
End Property
Public Sub New(pLogConfig As LogConfig, pClient As ClientBase)
MyBase.New(pLogConfig)
Client = pClient
End Sub
Public Class SessionInfo
Public Server As String
Public Port As Integer
Public User As String
Public Password As String
Public AuthType As String
Public ClientId As String
Public TenantId As String
Public ClientSecret As String
Public [Error] As Exception
Public Connected As Boolean = False
End Class
Public Class MailSessionOptions
Public Property EnableDefault As Boolean = True
Public Property EnableTls1_1 As Boolean = False
Public Property EnableTls1_2 As Boolean = False
' Not available in .NET 4.6.2
'Public Property EnableTls1_3 As Boolean = False
End Class
''' <summary>
''' Start a connection with the specified server and return the session info.
''' </summary>
''' <param name="pServer"></param>
''' <param name="pPort"></param>
''' <param name="pUser"></param>
''' <param name="pPassword"></param>
''' <param name="pAuthType"></param>
''' <returns></returns>
Public Function ConnectToServer(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSessionOptions) As SessionInfo
Dim oSession = New SessionInfo With {
.Server = pServer,
.Port = pPort,
.User = pUser,
.Password = pPassword,
.AuthType = pAuthType
}
Logger.Debug("Connecting to Server..")
Logger.Debug("Server: [{0}]", oSession.Server)
Logger.Debug("Port: [{0}]", oSession.Port)
Logger.Debug("User: [{0}]", oSession.User)
Logger.Debug("AuthType: [{0}]", oSession.AuthType)
_Session = oSession
Logger.Debug("Initializing Connection with Auth type [{0}].", oSession.AuthType)
Return ConnectToServer(oSession, pOptions)
End Function
Private Function ConnectToServer(pSession As SessionInfo, pOptions As MailSessionOptions) As SessionInfo
AddHandler Client.ServerCertificateValidate, AddressOf Session_ServerCertificateValidate
If pOptions.EnableDefault Then
Logger.Debug("Enabling Default TLS Version")
Client.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.Default
Else
Logger.Debug("Disabling Default TLS Version")
Client.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.None
End If
' Set TLS Version manually if requested
If pOptions.EnableTls1_1 Then
Logger.Debug("Enabling TLS Version 1.1")
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls11
End If
If pOptions.EnableTls1_2 Then
Logger.Debug("Enabling TLS Version 1.2")
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls12
End If
' This is not available in .NET 4.6.2, only in .NET 4.7/4.8
'If pOptions.EnableTls1_3 Then
' Logger.Debug("Enabling TLS Version 1.3")
' oSession.SSLConfiguration.EnabledSslProtocols = oSession.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls13
'End If
Logger.Debug("Enabled Encryption Protocols: [{0}]", Client.SSLConfiguration.EnabledSslProtocols)
If pSession.AuthType = AUTH_OAUTH2 Then
Try
If TypeOf Client Is Imap Then
Dim oClient As Imap = Client
oClient.ConnectSSL(pSession.Server)
Else
Throw New ApplicationException("Only OAuth2 for IMAP is not yet supported!")
End If
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type OAuth2!")
Logger.Error(ex)
Session.Error = ex
Return Session
End Try
ElseIf pSession.AuthType = AUTH_SSL Then
Try
If pSession.Port = 465 Then
Logger.Debug("Connecting with [ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.ConnectSSL(pSession.Server, pSession.Port)
Else
Logger.Debug("Connecting with [Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.Connect(pSession.Server, pSession.Port)
End If
Logger.Info("Connection Successful!")
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type SSL!")
Logger.Error(ex)
Session.Error = ex
Return Session
End Try
ElseIf Session.AuthType = AUTH_SSLTLS Or Session.AuthType = AUTH_STARTTLS Then
Try
Logger.Debug("Connecting with [Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.Connect(pSession.Server, pSession.Port)
Logger.Info("Connection Successful!")
Dim oSupportsSTARTTLS As Boolean = SupportsSTARTTLS(Client)
Logger.Debug("Server supports STARTTLS: [{0}]", oSupportsSTARTTLS)
If oSupportsSTARTTLS Then
DoSTARTTLS(Client)
Logger.Info("STARTTLS Successful!")
Else
Logger.Debug("Server does not support STARTTLS. Enabling TLS1.2 instead.")
Client.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.Tls12
End If
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type STARTTLS!")
Logger.Error(ex)
pSession.Error = ex
Return pSession
End Try
Else
Try
Logger.Debug("Unknown Auth type. Using PLAINTEXT connection.")
Client.Connect(pSession.Server, pSession.Port, useSSL:=False)
Logger.Info("Connection Successful!")
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type PLAINTEXT!")
Logger.Error(ex)
pSession.Error = ex
Return pSession
End Try
End If
Try
If pSession.User <> String.Empty Then
Logger.Info("Logging in with user [{0}] and Auth Type [{1}]", pSession.User, pSession.AuthType)
If pSession.AuthType = AUTH_OAUTH2 Then
' SessionInfo.Password will be the access token that was obtained
' in the OAuth2 flow before
DoUseBestLogin_OAuth2(Client, pSession.User, pSession.Password)
Else
DoUseBestLogin_BasicAuth(Client, pSession.User, pSession.Password)
End If
End If
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type [{0}]!", pSession.AuthType)
Logger.Error(ex)
pSession.Error = ex
Return pSession
End Try
pSession.Connected = True
Return pSession
End Function
Public Function DisconnectFromServer() As Boolean
Try
If Client IsNot Nothing Then
Logger.Debug("Closing connection to Server [{0}].", Session.Server)
DoClose(Client)
Session.Connected = False
Logger.Info("Connection to Server [{0}] closed.", Session.Server)
Else
Logger.Debug("No connection currently open. Exiting.")
End If
Return True
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
Public Async Function TestLogin(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSessionOptions) As Task(Of Boolean)
Dim oInfo = Await ConnectToServer(pServer, pPort, pUser, pPassword, pAuthType, pOptions)
If oInfo.Connected Then
If DisconnectFromServer() Then
Return True
Else
Logger.Warn("Login Test failed while disconnecting.")
Return False
End If
Else
Logger.Warn("Login Test Failed while connecting.")
Return False
End If
End Function
Private Function SupportsSTARTTLS(pClient As ClientBase)
If TypeOf pClient Is Smtp Then
Return DirectCast(pClient, Smtp).SupportedExtensions.Contains(SmtpExtension.StartTLS)
ElseIf TypeOf pClient Is Imap Then
Return DirectCast(pClient, Imap).SupportedExtensions.Contains(ImapExtension.StartTLS)
Else
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
Return False
End If
End Function
Private Sub DoClose(pClient As ClientBase)
If TypeOf pClient Is Smtp Then
DirectCast(pClient, Smtp).Close()
ElseIf TypeOf pClient Is Imap Then
DirectCast(pClient, Imap).Close()
Else
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
End If
End Sub
Private Sub DoUseBestLogin_BasicAuth(pClient As ClientBase, pUserName As String, pPassword As String)
If TypeOf pClient Is Smtp Then
DirectCast(pClient, Smtp).UseBestLogin(pUserName, pPassword)
ElseIf TypeOf pClient Is Imap Then
DirectCast(pClient, Imap).UseBestLogin(pUserName, pPassword)
Else
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
End If
End Sub
Private Sub DoUseBestLogin_OAuth2(pClient As ClientBase, pUserName As String, pAccessToken As String)
If TypeOf pClient Is Imap Then
DirectCast(pClient, Imap).LoginOAUTH2(pUserName, pAccessToken)
Else
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
End If
End Sub
Private Sub DoSTARTTLS(pClient As ClientBase)
If TypeOf pClient Is Smtp Then
DirectCast(pClient, Smtp).StartTLS()
ElseIf TypeOf pClient Is Imap Then
DirectCast(pClient, Imap).StartTLS()
Else
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
End If
End Sub
Private Sub Session_ServerCertificateValidate(sender As Object, e As ServerCertificateValidateEventArgs)
' i dont know why it works but it does
If (e.SslPolicyErrors And Not SMTP_IGNORED_ERRORS) = SslPolicyErrors.None Then
e.IsValid = True
Else
e.IsValid = False
End If
End Sub
End Class
End Namespace

53
Messaging/Mail/OAuth2.vb Normal file
View File

@@ -0,0 +1,53 @@
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Messaging.Mail.MailSession
Imports Microsoft.Identity.Client
Public Class OAuth2
Inherits BaseClass
Private ReadOnly TenantId As String
Private ReadOnly ClientId As String
Private ReadOnly ClientSecret As String
Public Const O365_SCOPE = "https://outlook.office365.com/.default"
Public Const O365_SERVER = "outlook.office365.com"
Private _AccessToken As String
Public ReadOnly Property AccessToken
Get
Return _AccessToken
End Get
End Property
Public Sub New(pLogConfig As LogConfig, pTenantId As String, pClientId As String, pClientSecret As String)
MyBase.New(pLogConfig)
TenantId = pTenantId
ClientId = pClientId
ClientSecret = pClientSecret
End Sub
Private Async Function GetAccessToken(pSession As SessionInfo) As Task(Of String)
Try
' Create the application, which is defined in
' Microsoft.Identity.Client
Dim oApp = ConfidentialClientApplicationBuilder.
Create(pSession.ClientId).
WithTenantId(pSession.TenantId).
WithClientSecret(pSession.ClientSecret).
Build()
' Request an access token
Dim oScopes = New List(Of String) From {O365_SCOPE}
Dim oResult = Await oApp.
AcquireTokenForClient(oScopes).
ExecuteAsync()
Return oResult.AccessToken
Catch ex As Exception
Logger.Warn("Could not request access token!")
Logger.Error(ex)
Return Nothing
End Try
End Function
End Class

294
Messaging/MailSender.vb
View File

@@ -1,294 +0,0 @@
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
Imports System.Net.Security
Imports Limilabs.Client.SMTP
Imports Limilabs.Client
Public Class MailSender
Inherits BaseClass
Private Server As String
Private Port As Integer
Private User As String
Private Password As String
Private AuthType As String
Private Session As Smtp = Nothing
Public Connected2Server As Boolean = False
Const SMTP_IGNORED_ERRORS As SslPolicyErrors =
SslPolicyErrors.RemoteCertificateChainErrors Or ' self-signed
SslPolicyErrors.RemoteCertificateNameMismatch ' name mismatch
Public Class MailSenderOptions
Public Property EnableDefault As Boolean = True
Public Property EnableTls1_1 As Boolean = False
Public Property EnableTls1_2 As Boolean = False
' Not available in .NET 4.6.2
'Public Property EnableTls1_3 As Boolean = False
End Class
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
End Sub
Public Function ConnectToServer(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String) As Boolean
Return ConnectToServer(pServer, pPort, pUser, pPassword, pAuthType)
End Function
''' <summary>
''' Start a connection with the specified server and return the SMTP client. Throws if there was an error.
''' </summary>
''' <param name="pServer"></param>
''' <param name="pPort"></param>
''' <param name="pUser"></param>
''' <param name="pPassword"></param>
''' <param name="pAuthType"></param>
''' <returns></returns>
Public Function ConnectToServer(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSenderOptions) As Boolean
Server = pServer
Port = pPort
User = pUser
Password = pPassword
AuthType = pAuthType
Logger.Debug("Connecting to Server..")
Logger.Debug("SMTP Server: [{0}]", Server)
Logger.Debug("SMTP Port: [{0}]", Port)
Logger.Debug("SMTP User: [{0}]", User)
Logger.Debug("SMTP AuthType: [{0}]", AuthType)
Dim oSession As New Smtp()
AddHandler oSession.ServerCertificateValidate, AddressOf Session_ServerCertificateValidate
Logger.Debug("Initializing Connection with Auth type [{0}].", pAuthType)
If pOptions.EnableDefault Then
Logger.Debug("Enabling Default TLS Version")
oSession.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.Default
Else
Logger.Debug("Disabling Default TLS Version")
oSession.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.None
End If
' Set TLS Version manually if requested
If pOptions.EnableTls1_1 Then
Logger.Debug("Enabling TLS Version 1.1")
oSession.SSLConfiguration.EnabledSslProtocols = oSession.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls11
End If
If pOptions.EnableTls1_2 Then
Logger.Debug("Enabling TLS Version 1.2")
oSession.SSLConfiguration.EnabledSslProtocols = oSession.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls12
End If
' This is not available in .NET 4.6.2, only in .NET 4.7/4.8
'If pOptions.EnableTls1_3 Then
' Logger.Debug("Enabling TLS Version 1.3")
' oSession.SSLConfiguration.EnabledSslProtocols = oSession.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls13
'End If
Logger.Debug("Enabled Encryption Protocols: [{0}]", oSession.SSLConfiguration.EnabledSslProtocols)
If pAuthType = "SSL" Then
Try
If pPort = 465 Then
Logger.Debug("Connecting with [ConnectSSL] on [{0}/{1}]", pServer, pPort)
oSession.ConnectSSL(pServer)
Else
Logger.Debug("Connecting with [Connect] on [{0}/{1}]", pServer, pPort)
oSession.Connect(pServer, pPort)
End If
Logger.Info("Connection Successful!")
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type SSL!")
Logger.Error(ex)
Return False
End Try
ElseIf AuthType = "SSL/TLS" Or AuthType = "STARTTLS" Then
Try
Logger.Debug("Connecting with [Connect] on [{0}/{1}]", pServer, pPort)
oSession.Connect(pServer, pPort)
Logger.Info("Connection Successful!")
Dim oSupportsSTARTTLS As Boolean = oSession.SupportedExtensions.Contains(Limilabs.Client.SMTP.SmtpExtension.StartTLS)
Logger.Debug("Server supports STARTTLS: [{0}]", oSupportsSTARTTLS)
If oSupportsSTARTTLS Then
oSession.StartTLS()
Logger.Info("STARTTLS Successful!")
Else
Logger.Debug("Server does not support STARTTLS. Enabling TLS1.2 instead.")
oSession.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.Tls12
End If
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type STARTTLS!")
Logger.Error(ex)
Return False
End Try
Else
Try
Logger.Debug("Unknown Auth type. Using PLAINTEXT connection.")
oSession.Connect(pServer)
Logger.Info("Connection Successful!")
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type PLAINTEXT!")
Logger.Error(ex)
Return False
End Try
End If
Try
If pUser <> String.Empty Then
Logger.Info("Logging in with user [{0}]", pUser)
oSession.UseBestLogin(pUser, pPassword)
End If
Catch ex As Exception
Logger.Warn("Error while connecting with Auth type PLAINTEXT!")
Logger.Error(ex)
Return False
End Try
Session = oSession
Connected2Server = True
Return True
End Function
Public Function DisconnectFromServer() As Boolean
Try
If Session IsNot Nothing Then
Logger.Debug("Closing connection to Server [{0}].", Server)
Session.Close()
Session = Nothing
Logger.Info("Connection to Server [{0}] closed.", Server)
Else
Logger.Debug("No connection currently open. Exiting.")
End If
Return True
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
Private Sub Session_ServerCertificateValidate(sender As Object, e As ServerCertificateValidateEventArgs)
' i dont know why it works but it does
If (e.SslPolicyErrors And Not SMTP_IGNORED_ERRORS) = SslPolicyErrors.None Then
e.IsValid = True
Return
End If
e.IsValid = False
End Sub
Public Function SendMail(pSendTo As List(Of String), pSendFrom As String, pSubject As String, pBody As String, pCreationTime As Date, pAttachments As List(Of String), pTest As Boolean) As Boolean
Dim oSuccessfulSends As New List(Of String)
Dim oFailedSends As New List(Of String)
For Each oSendToAddress In pSendTo
Dim oResult = SendMailTo(Session, oSendToAddress, pSendFrom, pSubject, pBody, pCreationTime, pAttachments, pTest)
If oResult = True Then
oSuccessfulSends.Add(oSendToAddress)
Else
oFailedSends.Add(oSendToAddress)
End If
Next
Logger.Debug("Sent [{0}] mails.", pSendTo.Count)
Logger.Debug("Successful [{0}]", oSuccessfulSends.Count)
Logger.Debug("Failed [{0}]", oFailedSends.Count)
Return True
End Function
Private Function SendMailTo(pSession As Smtp, pSendTo As String, pSendFrom As String, pSubject As String, pBody As String, pCreationTime As Date, pAttachments As List(Of String), pTest As Boolean)
Try
If IsNothing(pSession) Then
Logger.Info("ATTENTION-ERROR: pSession is nothing!")
Return False
End If
Logger.Debug("Preparing to send mail to [{0}]", pSendTo)
Dim oMailBuilder As New Limilabs.Mail.MailBuilder()
oMailBuilder.From.Add(New Limilabs.Mail.Headers.MailBox(pSendFrom))
oMailBuilder.To.Add(New Limilabs.Mail.Headers.MailBox(pSendTo))
oMailBuilder.Subject = pSubject
Logger.Debug("Setting body for mail")
SetBody(oMailBuilder, pBody, pCreationTime, pTest)
Logger.Debug("Adding [{0}] attachments to mail", pAttachments.Count)
oMailBuilder = AddAttachments(oMailBuilder, pAttachments)
Logger.Debug("Now sending mail..")
If IsNothing(oMailBuilder) Then
Logger.Info("ATTENTION-ERROR: oMailBuilder is nothing!")
Return False
End If
Dim oMail = oMailBuilder.Create()
pSession.SendMessage(oMail)
Logger.Info("Mail to [{0}] has been sent.", pSendTo)
Return True
Catch ex As Exception
Logger.Warn("Error while sending mail to [{0}]", pSendTo)
Logger.Error(ex)
Return False
End Try
End Function
Private Function SetBody(pMailBuilder As Limilabs.Mail.MailBuilder, pBody As String, pCreationTime As Date, pTest As Boolean) As Limilabs.Mail.MailBuilder
If pCreationTime <> Date.MinValue Then
pBody &= $"<p>Creation-time: {pCreationTime}</p>"
End If
If pTest Then
pBody = $"<p>This Is a Testmail!<br/>
The body-text will be replaced within profile!<br/>
Server/Port: {Server}/{Port}<br/>
User: {User}<br/>
Password: XXXX<br/>
Auth Type: {AuthType}</p>"
End If
Logger.Debug("Final Mailbody is: [{0}]", pBody)
pMailBuilder.Html = pBody
Return pMailBuilder
End Function
Private Function AddAttachments(pMailBuilder As Limilabs.Mail.MailBuilder, pAttachments As List(Of String)) As Limilabs.Mail.MailBuilder
For Each oAttachment In pAttachments
Try
' Read attachment from disk, add it to Attachments collection
If IO.File.Exists(oAttachment) Then
Logger.Debug("Adding attachment [{0}] to mail.", oAttachment)
pMailBuilder.AddAttachment(oAttachment)
Else
Logger.Warn("Attachment [{0}] does not exist. Skipping.", oAttachment)
End If
Catch ex As Exception
Logger.Warn("Could not read or add attachment [{0}]!", oAttachment)
Logger.Error(ex)
End Try
Next
Return pMailBuilder
End Function
End Class

14
Messaging/Messaging.vbproj
View File

@@ -49,16 +49,25 @@
<EmbedInteropTypes>False</EmbedInteropTypes> <EmbedInteropTypes>False</EmbedInteropTypes>
</Reference> </Reference>
<Reference Include="Microsoft.CSharp" /> <Reference Include="Microsoft.CSharp" />
<Reference Include="Microsoft.Identity.Client, Version=4.55.0.0, Culture=neutral, PublicKeyToken=0a613f4dd989e8ae, processorArchitecture=MSIL">
<HintPath>..\packages\Microsoft.Identity.Client.4.55.0\lib\net461\Microsoft.Identity.Client.dll</HintPath>
</Reference>
<Reference Include="Microsoft.IdentityModel.Abstractions, Version=6.22.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35, processorArchitecture=MSIL">
<HintPath>..\packages\Microsoft.IdentityModel.Abstractions.6.22.0\lib\net461\Microsoft.IdentityModel.Abstractions.dll</HintPath>
</Reference>
<Reference Include="NLog, Version=5.0.0.0, Culture=neutral, PublicKeyToken=5120e14c03d0593c, processorArchitecture=MSIL"> <Reference Include="NLog, Version=5.0.0.0, Culture=neutral, PublicKeyToken=5120e14c03d0593c, processorArchitecture=MSIL">
<HintPath>..\packages\NLog.5.0.5\lib\net46\NLog.dll</HintPath> <HintPath>..\packages\NLog.5.0.5\lib\net46\NLog.dll</HintPath>
</Reference> </Reference>
<Reference Include="System" /> <Reference Include="System" />
<Reference Include="System.Configuration" /> <Reference Include="System.Configuration" />
<Reference Include="System.Data" /> <Reference Include="System.Data" />
<Reference Include="System.Drawing" />
<Reference Include="System.IdentityModel" />
<Reference Include="System.IO.Compression" /> <Reference Include="System.IO.Compression" />
<Reference Include="System.Runtime.Serialization" /> <Reference Include="System.Runtime.Serialization" />
<Reference Include="System.ServiceModel" /> <Reference Include="System.ServiceModel" />
<Reference Include="System.Transactions" /> <Reference Include="System.Transactions" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" /> <Reference Include="System.Xml" />
<Reference Include="System.Core" /> <Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" /> <Reference Include="System.Xml.Linq" />
@@ -81,6 +90,9 @@
<Compile Include="EventBus.vb" /> <Compile Include="EventBus.vb" />
<Compile Include="Email2.vb" /> <Compile Include="Email2.vb" />
<Compile Include="Limilab.vb" /> <Compile Include="Limilab.vb" />
<Compile Include="Mail\MailFetcher.vb" />
<Compile Include="Mail\MailSession.vb" />
<Compile Include="Mail\OAuth2.vb" />
<Compile Include="My Project\AssemblyInfo.vb" /> <Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb"> <Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen> <AutoGen>True</AutoGen>
@@ -97,7 +109,7 @@
<DependentUpon>Settings.settings</DependentUpon> <DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput> <DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile> </Compile>
<Compile Include="MailSender.vb" /> <Compile Include="Mail\MailSender.vb" />
<Compile Include="WCF\Binding.vb" /> <Compile Include="WCF\Binding.vb" />
<Compile Include="WCF\Channel.vb" /> <Compile Include="WCF\Channel.vb" />
<Compile Include="WCF\Constants.vb" /> <Compile Include="WCF\Constants.vb" />

2
Messaging/packages.config
View File

@@ -1,5 +1,7 @@
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<packages> <packages>
<package id="Microsoft.Identity.Client" version="4.55.0" targetFramework="net462" />
<package id="Microsoft.IdentityModel.Abstractions" version="6.22.0" targetFramework="net462" />
<package id="NLog" version="5.0.5" targetFramework="net461" /> <package id="NLog" version="5.0.5" targetFramework="net461" />
<package id="S22.Imap" version="3.6.0.0" targetFramework="net461" /> <package id="S22.Imap" version="3.6.0.0" targetFramework="net461" />
</packages> </packages>