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

Rename Projects, clean up interfaces

Browse Source
This commit is contained in:
Jonathan Jenne
2023-07-31 16:30:26 +02:00
parent 94d1aeeaa4
commit c8dbbd6381
76 changed files with 1081 additions and 1605 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
App/EmailProfiler.Common/ClassCurrent.vb Normal file
View File

@@ -0,0 +1,68 @@
Imports WINDREAMLib
Imports Limilabs.Mail
Imports Limilabs.Mail.MIME
Imports Limilabs.Mail.Headers
Imports MailBox = Limilabs.Mail.Headers.MailBox
Imports Limilabs.Client.IMAP
Public Class ClassCurrent
Public Shared Property WM_DRIVE As String
Public Shared Property CURRENT_EMAIL_GUID As Integer
Public Shared Property CURRENT_PROFILE_GUID As Integer
Public Shared Property DTCONFIG As DataTable
Public Shared Property DT_ECM_BASE_CONFIG As DataTable
Public Shared Property MAIL_FROM As String = ""
Public Shared Property MAIL_SERVER As String = ""
Public Shared Property MAIL_USER As String = ""
Public Shared Property MAIL_USER_PW As String = ""
Public Shared Property MAIL_PORT As Integer = 995
Public Shared Property MAIL_INBOX_NAME As String = "Inbox"
Public Shared Property MAIL_ARCHIVE_FOLDER As String = ""
Public Shared Property MAIL_AUTHTYPE As String
Public Shared Property DT_POLL_PROCESS As DataTable
Public Shared Property DT_STEPS As DataTable
Public Shared Property DT_INDEXING_STEPS As DataTable
Public Shared Property CURRENToWMSession As Object
Public Shared Property CURRENToWMSession_Created As Date = Now
Public Shared Property CURRENToWMConnect As Object
Public Shared Property CURRENT_ATTMT_COUNT As Integer
Public Shared Property SUBJECT_PRAFIX As String = "EmailProfiler"
Public Shared Property CURRENT_DRIVE_CHECK As String = ""
Public Shared Property CURRENT_DRIVE_ISFULL As Boolean = False
' Public Shared Property oCURRENT_WORKMAIL_LIST As New ArrayList()
Public Shared Property CURRENT_WORKMAIL_UID_LIST As New List(Of Long)
Public Shared Property CURRENT_MAIL_MESSAGE As IMail
Public Shared Property CURRENT_ImapObject As Imap
Public Shared Property CURRENT_MAIL_UID As Long
Public Shared Property DeleteMail As Boolean = False
Public Shared Property CURRENT_POLL_TYPE As String
Public Shared Property POLL_STEP_GUID As Integer
Public Shared Property POLL_STEP_PROCESS_ID As Integer
Public Shared Property POLL_KEYWORDS As String
Public Shared Property KEYWORDS_SPLIT As String()
Public Shared Property WM_REFERENCE_INDEX As String
Public Shared Property WM_VECTOR_LOG As String
Public Shared Property WM_OBJEKTTYPE As String
Public Shared Property WM_IDX_BODY_TEXT As String
Public Shared Property WM_IDX_BODY_SUBSTR_LENGTH As String
Public Shared Property CURRENT_WM_DOC As WMObject
Public Shared Property CURRENT_DOC_ID As Integer
Public Shared Property CURRENT_DOC_PATH As String
Public Shared Property MessageError As Boolean = False
Public Shared Property TEMP_FILES As List(Of String) = New List(Of String)
Public Shared Property CURRENT_DEBUG_LOCAL_EMAIL As String
End Class

89
App/EmailProfiler.Common/ClassDBConfig.vb Normal file
View File

@@ -0,0 +1,89 @@
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
Public Class ClassDBConfig
Public Class Config
Public Property PathError As String
Public Property PathAttachments As String
Public Property BodyFont As String
Public Property WindreamConnectionString As String
Public Property TimerInterval As Integer
Public Property WindreamDrive As String = "W"
End Class
Private ReadOnly Logger As Logger
Private ReadOnly Database As MSSQLServer
Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer)
Logger = pLogConfig.GetLogger()
Database = pDatabase
End Sub
Private Function GetConfigTable() As DataTable
Try
Logger.Debug("Getting Config Table..")
Dim oSQL As String = "SELECT * FROM TBEMLP_CONFIG"
Dim oTable As DataTable = Database.GetDatatable(oSQL)
Return oTable
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Private Function GetBaseConfigTable() As DataTable
Try
Logger.Debug("Getting Base Config Table..")
Dim oSQL As String = "SELECT * FROM TBDD_BASECONFIG"
Dim oTable As DataTable = Database.GetDatatable(oSQL)
Return oTable
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function GetConfig() As Config
Try
Dim oConfigTable = GetConfigTable()
Dim oBaseTable = GetBaseConfigTable()
If oBaseTable Is Nothing Then
Logger.Warn("Config from TBDD_BASECONFIG could not be loaded!")
Return Nothing
End If
If oBaseTable.Rows.Count = 0 Then
Logger.Warn("Config from TBDD_BASECONFIG could not be loaded!")
Return Nothing
End If
If oConfigTable Is Nothing Then
Logger.Warn("Config from TBEMLP_CONFIG could not be loaded!")
Return Nothing
End If
If oConfigTable.Rows.Count = 0 Then
Logger.Warn("Config from TBEMLP_CONFIG is empty!")
Return Nothing
End If
Dim oRow As DataRow = oConfigTable.Rows.Item(0)
Dim oConfig As New Config With {
.PathAttachments = oRow.ItemEx("PATH_EMAIL_TEMP", ""),
.PathError = oRow.ItemEx("PATH_EMAIL_ERRORS", ""),
.BodyFont = oRow.ItemEx("FONT_BODY", "Arial"),
.TimerInterval = oRow.ItemEx("CHECK_INTERVALL_MINUTES", 5),
.WindreamConnectionString = oRow.ItemEx("WM_CON_STRING", ""),
.WindreamDrive = oRow.ItemEx("WM_DRIVE", "W")
}
Return oConfig
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
End Class

158
App/EmailProfiler.Common/EmailProfiler.Common.vbproj Normal file
View File

@@ -0,0 +1,158 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{9F748DCD-952E-40A0-9DAD-65BF8A39B231}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>DigitalData.EMLProfiler</RootNamespace>
<AssemblyName>DigitalData.EMLProfiler</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
<TargetFrameworkProfile />
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>DigitalData.EMLProfiler.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>DigitalData.EMLProfiler.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Reference Include="AE.Net.Mail, Version=1.7.10.0, Culture=neutral, processorArchitecture=MSIL">
<HintPath>..\packages\AE.Net.Mail.1.7.10.0\lib\net45\AE.Net.Mail.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Modules.Base">
<HintPath>..\..\..\DDModules\Base\bin\Debug\DigitalData.Modules.Base.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Modules.Database">
<HintPath>..\..\..\DDModules\Database\bin\Debug\DigitalData.Modules.Database.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Modules.Language">
<HintPath>..\..\..\DDModules\Language\bin\Debug\DigitalData.Modules.Language.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Modules.Logging">
<HintPath>..\..\..\DDModules\Logging\bin\Debug\DigitalData.Modules.Logging.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Modules.Messaging">
<HintPath>..\..\..\DDModules\Messaging\bin\Debug\DigitalData.Modules.Messaging.dll</HintPath>
</Reference>
<Reference Include="Interop.WINDREAMLib">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\windream\Interop.WINDREAMLib.dll</HintPath>
<EmbedInteropTypes>False</EmbedInteropTypes>
</Reference>
<Reference Include="Interop.WMOBRWSLib">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\windream\Interop.WMOBRWSLib.dll</HintPath>
<EmbedInteropTypes>True</EmbedInteropTypes>
</Reference>
<Reference Include="Interop.WMOSRCHLib">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\windream\Interop.WMOSRCHLib.dll</HintPath>
<EmbedInteropTypes>True</EmbedInteropTypes>
</Reference>
<Reference Include="Mail">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\Limilabs\Mail.dll\Mail.dll</HintPath>
</Reference>
<Reference Include="Microsoft.CSharp" />
<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>
</Reference>
<Reference Include="System" />
<Reference Include="System.Configuration" />
<Reference Include="System.Data" />
<Reference Include="System.IO.Compression" />
<Reference Include="System.Runtime.Serialization" />
<Reference Include="System.ServiceModel" />
<Reference Include="System.Transactions" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="ClassDBConfig.vb" />
<Compile Include="ClassCurrent.vb" />
<Compile Include="clsEmail.IMAP.vb" />
<Compile Include="EmailStrings.vb" />
<Compile Include="clsEncryption.vb" />
<Compile Include="clsWindream_allgemein.vb" />
<Compile Include="clsWindream_Index.vb" />
<Compile Include="clsWorkEmail.vb" />
<Compile Include="clsWorker.vb" />
<Compile Include="MailContainer.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
<DesignTime>True</DesignTime>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include="app.config" />
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="packages.config" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

38
App/EmailProfiler.Common/EmailStrings.vb Normal file
View File

@@ -0,0 +1,38 @@
Public Class EmailStrings
Public Const EMAIL_WRAPPING_TEXT = "<html><body style=''font-family:""Arial"";font-size:10.0pt''>Sehr geehrte Damen und Herren,<br/><br/>
das Portal konnte die von Ihnen gesandte Email leider nicht verarbeiten! <br><br> Grund: {0}<p>Bitte prüfen Sie die Email und nehmen Sie bei Bedarf mit uns Kontakt auf.<p>
Vielen Dank für Ihr Verständnis.<br>Mit freundlichen Grüßen<br>Ihre IT-Abteilung</body></html>"
Public Const EMAIL_SUBJECT_TEXT = "<p>Der Betreff der Original-Email war: <em>{0}</em></p>"
Public Const EMAIL_SUBJECT_REJECTED = "Beleg abgelehnt"
Public Const EMAIL_SUBJECT_EXCEPTION = "Unbehandelte Ausnahme"
Public Const EMAIL_UNHANDLED_EXCEPTION = """
<p>Beim Verarbeiten der Datei mit der Message ID '{0}' ist ein schwerer Fehler aufgetreten.</p>
<p>Fehlerbeschreibung: {1}</p>
<pre>{2}</pre>
"""
Public Const EMAIL_MISSINGPROPERTIES_1 = "<p>Die angehängte Datei entspricht nicht dem ZUGFeRD-Format: {0}</p>"
Public Const EMAIL_MISSINGPROPERTIES_2 = "<p>Die folgenden Eigenschaften wurden als ERFORDERLICH eingestuft, wurden aber nicht gefunden:<p/>"
Public Const EMAIL_MD5_ERROR = "<p>Die von Ihnen gesendete Rechnung wurde bereits von unserem System verarbeitet.</p>"
Public Const EMAIL_TOO_MUCH_FERDS = "<p>Ihre Email enthielt mehr als ein ZUGFeRD-Dokument.</p>"
Public Const EMAIL_NO_FERDS = "<p>Ihre Email enthielt keine Dokumente.</p>"
Public Const EMAIL_FILE_SIZE_REACHED = "
<p>Die von Ihnen gesendete Rechnung oder einer der Rechnungs-Anhänge überschreitet die erlaubte Größe von <strong>{0} MB</strong>.</p>
<p>Die folgende Datei hat die erlaubte Größe überschritten:<ul>
<li>{1}</li>
</ul></p>
"
Public Const EMAIL_INVALID_DOCUMENT = "
<p>Ihre Email enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.</p>
<p>Mögliche Gründe für ein inkorrektes Format:<ul>
<li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p>
"
End Class

64
App/EmailProfiler.Common/MailContainer.vb Normal file
View File

@@ -0,0 +1,64 @@
Imports Limilabs.Mail
Imports DigitalData.Modules.Base
Public Class MailContainer
Private Const SUBJECT_MAX_LENGTH = 25
''' <summary>
''' The Mail object created by Limilabs
''' </summary>
Public ReadOnly Property Mail As IMail
''' <summary>
''' The IMAP Id coming from the IMAP folder. Used to reference the mail.
''' </summary>
Public ReadOnly Property ImapId As Integer
''' <summary>
''' The original MessageID from the eml file
''' </summary>
Public ReadOnly Property MessageIdOriginal As String
''' <summary>
''' The new MessageID, which is generated by hashing the original MessageID
''' </summary>
Public ReadOnly Property MessageId As String
''' <summary>
''' The subject, truncated to SUBJECT_MAX_LENGTH characters
''' </summary>
Public ReadOnly Property Subject As String
Public ReadOnly Property SenderDomain As String
Public ReadOnly Property SenderAddress As String
Public Sub New(pMail As IMail, pImapId As Integer)
Mail = pMail
ImapId = pImapId
MessageIdOriginal = pMail.MessageID
MessageId = StringEx.GetHash(pMail.MessageID)
Subject = ObjectEx.NotNull(pMail.Subject.Truncate(SUBJECT_MAX_LENGTH), String.Empty)
SenderAddress = GetSenderAddress(pMail)
SenderDomain = GetSenderDomain(pMail)
End Sub
Private Function GetSenderAddress(pMail As IMail)
Dim oMailBox = pMail.From.FirstOrDefault()
If oMailBox Is Nothing Then
Return "InvalidSenderAddress"
Else
Return oMailBox.Address
End If
End Function
Private Function GetSenderDomain(pMail As IMail)
Dim oMailBox = pMail.From.FirstOrDefault()
If oMailBox Is Nothing Then
Return "InvalidSenderAddress"
Else
Return oMailBox.DomainPart
End If
End Function
End Class

13
App/EmailProfiler.Common/My Project/Application.Designer.vb generated Normal file
View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

10
App/EmailProfiler.Common/My Project/Application.myapp Normal file
View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>1</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

35
App/EmailProfiler.Common/My Project/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,35 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' Allgemeine Informationen über eine Assembly werden über die folgenden
' Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern,
' die einer Assembly zugeordnet sind.
' Werte der Assemblyattribute überprüfen
<Assembly: AssemblyTitle("DigitalData.EMLProfiler")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("DigitalData.EMLProfiler")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("3.7.5.1")>
<Assembly: ComVisible(False)>
'Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird.
<Assembly: Guid("807d6759-5806-4ea9-8f8c-c7099cbd912c")>
' Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten:
'
' Hauptversion
' Nebenversion
' Buildnummer
' Revision
'
' Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden,
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("3.6.6.0")>
<Assembly: AssemblyFileVersion("3.6.6.0")>

63
App/EmailProfiler.Common/My Project/Resources.Designer.vb generated Normal file
View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'Diese Klasse wurde von der StronglyTypedResourceBuilder automatisch generiert
'-Klasse über ein Tool wie ResGen oder Visual Studio automatisch generiert.
'Um einen Member hinzuzufügen oder zu entfernen, bearbeiten Sie die .ResX-Datei und führen dann ResGen
'mit der /str-Option erneut aus, oder Sie erstellen Ihr VS-Projekt neu.
'''<summary>
''' Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "17.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("DigitalData.EMLProfiler.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
''' Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

117
App/EmailProfiler.Common/My Project/Resources.resx Normal file
View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

73
App/EmailProfiler.Common/My Project/Settings.Designer.vb generated Normal file
View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "17.3.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "Automatische My.Settings-Speicherfunktion"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.DigitalData.EMLProfiler.My.MySettings
Get
Return Global.DigitalData.EMLProfiler.My.MySettings.Default
End Get
End Property
End Module
End Namespace

5
App/EmailProfiler.Common/My Project/Settings.settings Normal file
View File

@@ -0,0 +1,5 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles />
<Settings />
</SettingsFile>

33
App/EmailProfiler.Common/app.config Normal file
View File

@@ -0,0 +1,33 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<configSections>
</configSections>
<system.diagnostics>
<sources>
<!-- Dieser Abschnitt definiert die Protokollierungskonfiguration für My.Application.Log -->
<source name="DefaultSource" switchName="DefaultSwitch">
<listeners>
<add name="FileLog"/>
<!-- Auskommentierung des nachfolgenden Abschnitts aufheben, um in das Anwendungsereignisprotokoll zu schreiben -->
<!--<add name="EventLog"/>-->
</listeners>
</source>
</sources>
<switches>
<add name="DefaultSwitch" value="Information"/>
</switches>
<sharedListeners>
<add name="FileLog" type="Microsoft.VisualBasic.Logging.FileLogTraceListener, Microsoft.VisualBasic, Version=8.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL" initializeData="FileLogWriter"/>
<!-- Auskommentierung des nachfolgenden Abschnitts aufheben und APPLICATION_NAME durch den Namen der Anwendung ersetzen, um in das Anwendungsereignisprotokoll zu schreiben -->
<!--<add name="EventLog" type="System.Diagnostics.EventLogTraceListener" initializeData="APPLICATION_NAME"/> -->
</sharedListeners>
</system.diagnostics>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="NLog" publicKeyToken="5120e14c03d0593c" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-5.0.0.0" newVersion="5.0.0.0"/>
</dependentAssembly>
</assemblyBinding>
</runtime>
<startup><supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/></startup></configuration>

70
App/EmailProfiler.Common/clsEmail.IMAP.vb Normal file
View File

@@ -0,0 +1,70 @@
Imports DigitalData.EMLProfiler.ClassCurrent
Imports DigitalData.Modules.Logging
Imports AE
Imports System.Net
Imports System.Reflection
Imports System.IO
Imports DigitalData.Modules.Messaging
Public Class clsEmailIMAP
Private Shared Logger As Logger
Private Shared LogConfig As LogConfig
Private _limilab As Limilab
Sub New(LogConf As LogConfig)
LogConfig = LogConf
Logger = LogConf.GetLogger
_limilab = New Limilab(LogConf)
End Sub
Public Function FetchIMAPMessagesLimilab(Server As String, Port As Integer, Username As String, Password As String, AuthType As String) As Boolean
Try
Logger.Debug("FetchIMAPMessagesLimilab - Fetching messages...")
_limilab.InitIMAP(True, Server, Port, Username, Password, AuthType)
Dim oListuids As New List(Of Long)
oListuids = _limilab.IMAPGetMessageIDs_AllMails()
If IsNothing(oListuids) Then
Logger.Warn("List of UIDs was Nothing. Returning False.")
Return False
Else
If oListuids.Count > 0 Then
CURRENT_WORKMAIL_UID_LIST = oListuids
Logger.Info("FetchIMAPMessagesLimilab - Found [{0}] messages", oListuids.Count)
CURRENT_ImapObject = _limilab.CurrentImapObject
Else
Logger.Debug("FetchIMAPMessagesLimilab - No Emails found!")
End If
Return True
End If
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
''' <summary>
''' Uses a private API from MailWriter to write a MailMessage to disk.
''' May break in future versions of .NET
''' </summary>
Public Function WriteMessageToFile(Message As Mail.MailMessage, Filename As String) As Boolean
Dim oAssembly As Assembly = GetType(Mail.SmtpClient).Assembly
Dim oMailWriterType As Type = oAssembly.[GetType]("System.Net.Mail.MailWriter")
Try
Using oStream As New FileStream(Filename, FileMode.Create)
Dim oMailWriterConstructor As ConstructorInfo = oMailWriterType.GetConstructor(
BindingFlags.Instance Or BindingFlags.NonPublic, Nothing, New Type() {GetType(Stream)}, Nothing
)
Dim oMailWriter As Object = oMailWriterConstructor.Invoke(New Object() {oStream})
Dim sendMethod As MethodInfo = GetType(Mail.MailMessage).GetMethod("Send", BindingFlags.Instance Or BindingFlags.NonPublic)
sendMethod.Invoke(Message, BindingFlags.Instance Or BindingFlags.NonPublic, Nothing, {oMailWriter, True, True}, Nothing)
End Using
Return True
Catch ex As Exception
Return Nothing
End Try
End Function
End Class

77
App/EmailProfiler.Common/clsEncryption.vb Normal file
View File

@@ -0,0 +1,77 @@
Imports System.Security.Cryptography
Imports NLog
Imports DigitalData.Modules.Logging
Public Class clsEncryption
Private TripleDes As New TripleDESCryptoServiceProvider
Private Logger As Modules.Logging.Logger
Sub New(ByVal key As String, LogConf As LogConfig)
Logger = LogConf.GetLogger
' Initialize the crypto provider.
TripleDes.Key = TruncateHash(key, TripleDes.KeySize \ 8)
TripleDes.IV = TruncateHash("", TripleDes.BlockSize \ 8)
End Sub
Private Function TruncateHash(
ByVal key As String,
ByVal length As Integer) As Byte()
Dim sha1 As New SHA1CryptoServiceProvider
' Hash the key.
Dim keyBytes() As Byte =
System.Text.Encoding.Unicode.GetBytes(key)
Dim hash() As Byte = sha1.ComputeHash(keyBytes)
' Truncate or pad the hash.
ReDim Preserve hash(length - 1)
Return hash
End Function
Public Function EncryptData(
ByVal plaintext As String) As String
' Convert the plaintext string to a byte array.
Dim plaintextBytes() As Byte =
System.Text.Encoding.Unicode.GetBytes("!Didalog35452Heuchelheim=" & plaintext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the encoder to write to the stream.
Dim encStream As New CryptoStream(ms,
TripleDes.CreateEncryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
encStream.Write(plaintextBytes, 0, plaintextBytes.Length)
encStream.FlushFinalBlock()
' Convert the encrypted stream to a printable string.
Return Convert.ToBase64String(ms.ToArray)
End Function
'Entschlüsselt die Zeichenfolge
Public Function DecryptData(
ByVal encryptedtext As String) As String
Try
' Convert the encrypted text string to a byte array.
Dim encryptedBytes() As Byte = Convert.FromBase64String(encryptedtext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the decoder to write to the stream.
Dim decStream As New CryptoStream(ms,
TripleDes.CreateDecryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
decStream.FlushFinalBlock()
Dim result = System.Text.Encoding.Unicode.GetString(ms.ToArray)
result = result.Replace("!Didalog35452Heuchelheim=", "")
' Convert the plaintext stream to a string.
Return result
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
End Class

847
App/EmailProfiler.Common/clsWindream_Index.vb Normal file
View File

@@ -0,0 +1,847 @@
Imports WINDREAMLib
Imports WMOSRCHLib
Imports DigitalData.Modules.Logging
Public Class clsWindream_Index
Inherits clsWindream_allgemein
#Region "+++++ Konstanten +++++"
Protected Const WMObjectEditModeObject = &H1F
Protected Const WMObjectStreamOpenModeReadWrite = 2
Protected Const WMEntityObjectType = 10
Protected Const WMEntityDocument = 1
Const WMObjectVariableValueTypeUndefined = 0
Const WMObjectVariableValueTypeString = 1
Const WMObjectVariableValueTypeInteger = 2
Const WMObjectVariableValueTypeFloat = 3
Const WMObjectVariableValueTypeBoolean = 4
Const WMObjectVariableValueTypeDate = 5
Const WMObjectVariableValueTypeFixedPoint = 6
Const WMObjectVariableValueTypeTimeStamp = 7
Const WMObjectVariableValueTypeCurrency = 8
Const WMObjectVariableValueTypeTime = 9
Const WMObjectVariableValueTypeVariant = 10
Const WMObjectVariableValueTypeMask = &HFFF
Const WMObjectVariableValueFlagMask = &HFFFFF000
Const WMObjectVariableValueTypeVector = &H1000
Const WMObjectVariableValueTypeFulltext = &H2000
Const WMObjectVariableValueTypeDefaultValue = &H4000
#End Region
#Region "+++++ Variablen +++++"
'Private oController = CreateObject("WMOSrch.WMQuickSearch") 'As New WMOSearchController
'Private oController As New WMOSearchController
Private oController As New WMOSearchController
Private Shared Logger As Logger
'Dim srchQuick = CreateObject("WMOSrch.WMQuickSearch") 'As WMOSRCHLib.WMQuickSearch
#End Region
#Region "+++++ Allgemeine Methoden und Funktionen +++++"
Sub New(LogConf As LogConfig)
MyBase.New(LogConf)
Logger = LogConf.GetLogger
LogConf.Debug = True
End Sub
Private Function IsNotEmpty(ByVal aValue As Object)
If aValue IsNot Nothing Then
Dim itsType As Type = aValue.GetType
If itsType Is GetType(String) Then
If Not aValue = "" Then
Return True
End If
Return False
Else
Return True
End If
Else
Return False
End If
End Function
Private Function return_type(ByVal _wert As Object)
Return _wert.GetType
End Function
Public Function GetIndex_Type(idxName) As String
Try
Dim oAttribute = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, idxName)
'den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
Dim Type As String
Select Case (vType)
'Case WMObjectVariableValueTypeUndefined
Case WMObjectVariableValueTypeString
Type = "String"
Case WMObjectVariableValueTypeInteger
Type = "Integer"
Case WMObjectVariableValueTypeFloat
Type = "Float"
Case WMObjectVariableValueTypeFixedPoint
Type = "Point"
Case WMObjectVariableValueTypeBoolean
Type = "Boolean"
Case WMObjectVariableValueTypeDate
Type = "Date"
Case WMObjectVariableValueTypeTimeStamp
Type = "Timestamp"
Case WMObjectVariableValueTypeCurrency
Type = "Currency"
Case WMObjectVariableValueTypeTime
Type = "Time"
Case WMObjectVariableValueTypeFloat
Type = "Float"
Case WMObjectVariableValueTypeVariant
Type = "Varia´nt"
Case WMObjectVariableValueTypeFulltext
Type = "Fulltext"
Case 4097
Type = "Vektor String"
Case 4098
Type = "Vektor Numerisch"
Case 4099
Type = "Vektor Float"
Case 4101
Type = "Vektor Date"
Case 4103
Type = "Vektor DateTime"
Case 36865
Type = "Vektor Alpha"
Case Else
Type = "String Else"
End Select
Return Type
Catch ex As Exception
End Try
End Function
Public Function RunIndexing_Vektor(ByVal oDocument As WMObject, ByVal Indizes As String(), ByVal aValues As String())
Try
If Indizes IsNot Nothing And aValues IsNot Nothing Then
If Not oDocument.aLocked Then
oDocument.lock()
If aValues.Length = 1 And aValues(0) = "" Then
Logger.Warn("RunIndexing_Vektor: Indexwert ist leer/Nothing - Keine Nachindexierung")
Else
'Jetzt jeden Indexwert durchlaufen
Dim indexname As String
indexname = Indizes(0)
Logger.Debug("RunIndexing_Vektor: Indexname: " & indexname)
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
Logger.Debug("RunIndexing_Vektor: VEKTORFELD-Indexierung: Vorbereiten des Arrays")
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname)
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
Select Case (vType)
Case 4097
Logger.Debug("Typ des windream-Indexes: 4097 Vektor alphanumerisch")
Case 4098
Logger.Debug("Typ des windream-Indexes: 4098 Vektor Numerisch")
Case 4099
Logger.Debug("Typ des windream-Indexes: 4099 Vektor Kommazahl")
Case 4100
Logger.Debug("Typ des windream-Indexes: 4100 Vektor Boolean")
Case 4101
Logger.Debug("Typ des windream-Indexes: 4101 Vektor Date")
Case 4103
Logger.Debug("Typ des windream-Indexes: 4103 Vektor DateTime")
Case 4107
Logger.Debug("Typ des windream-Indexes: 4107 Vektor Integer(64bit)")
Case 36865
Logger.Debug("Typ des windream-Indexes: 36865 Vektor alphanumerisch")
End Select
Dim myArray
Dim Anzahl As Integer = aValues.Length - 1
'Vektorfeld wird mit EINEM Wert gefüllt
If Anzahl = 0 Then
Logger.Debug("RunIndexing_Vektor: Vektorfeld wird mit EINEM Wert gefüllt ")
ReDim myArray(0)
Select Case (vType)
Case 4097
myArray(0) = CStr(aValues(0))
Case 4098
myArray(0) = CInt(aValues(0).Replace(" ", ""))
Case 4099
Dim str As String = aValues(0)
str = str.ToString.Replace(" ", "")
myArray(0) = CDbl(str.Replace(".", ","))
Case 4100
myArray(0) = CBool(aValues(0))
Case 4101
myArray(0) = CDate(aValues(0))
Case 4103
myArray(0) = aValues(0)
Case 4107
myArray(0) = Convert.ToInt64(aValues(0))
Case 36865
myArray(0) = CStr(aValues(0))
End Select
Logger.Debug("RunIndexing_Vektor: Konvertierter Wert: " & myArray(0).ToString)
Else
Logger.Debug("RunIndexing_Vektor: Vektorfeld wird mit MEHREREN Werten gefüllt ")
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl)
Dim i1 As Integer = 0
For Each aValue As String In aValues
Select Case (vType)
Case 4107
Dim wert = aValue.Replace(" ", "")
wert = Convert.ToInt64(wert) 'ToInt64
myArray(i1) = wert
Case 4097
myArray(i1) = CStr(aValue)
Case 4098
Dim wert = aValue.Replace(" ", "")
Dim OConvertValue
If IsNumeric(wert) Then
Try
OConvertValue = CInt(wert)
Catch ex As Exception
Logger.Debug("Wert muss in Int64 konvertiert werden")
OConvertValue = Convert.ToInt64(wert) 'ToInt64
End Try
Else
' clsLoggerNI.Add("Indexierungswert '" & wert.ToString & "' kann nicht in Integer konvertiert werden")
Return False
End If
myArray(i1) = OConvertValue
Case 4099
myArray(i1) = CDbl(aValue.Replace(".", ",").Replace(" ", ""))
Case 4100
myArray(i1) = CBool(aValue)
Case 4101
myArray(i1) = CDate(aValue)
Case 4103
myArray(i1) = aValue
Case 36865
myArray(i1) = CStr(aValue)
Case Else
myArray(i1) = CStr(aValue)
End Select
i1 += 1
Next
End If
'Jetzt die Nachindexierung für Vektor-Felder
oDocument.SetVariableValue(indexname, myArray)
Logger.Debug("RunIndexing_Vektor: 'SetVariableValue' für VEKTOR erfolgreich")
oDocument.Save()
oDocument.unlock()
Logger.Debug("RunIndexing_Vektor: Indexierung erfolgreich beendet (Save und Unlock durchgeführt)")
Return True
End If
Else
Logger.Warn("RunIndexing_Vektor: Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
Return False
End If
End If
Catch ex As Exception
Logger.Error(ex)
'clsLogger.AddError("## Fehler in RunIndexing_Vektor - Fehler: " & ex.Message, "RunIndexingVektor")
oDocument.Save()
oDocument.unlock()
Return False
End Try
End Function
Public Function RunIndexing(ByVal oDocument As WMObject, ByVal Indizes() As String, ByVal aValues() As Object, Objekttyp As String)
Try
If Indizes IsNot Nothing And aValues IsNot Nothing Then
If Not oDocument.aLocked Then
oDocument.lock()
Dim i As Integer = 0
Dim indexname As String
If aValues.Length = 1 And aValues(0) = "" Then
Logger.Debug("Indexwert ist leer/Nothing - Keine Indexierung")
End If
' wenn der Datei noch kein Dokumenttyp zugewiesen wurde
If oDocument.aObjectType.aName <> Objekttyp Then
' ihr den entsprechenden Dokumenttyp zuweisen
oDocument.aObjectType = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, Objekttyp)
' WMObject.aObjectType = selectedProfile.Dokumenttyp
Logger.Debug("Objekttyp war Standard und wurde in '" & Objekttyp & "' geändert.")
Else
Logger.Debug("Objekttyp war bereits gesetzt")
End If
Try
oDocument.Save()
Catch ex As Exception
' wenn es einen Fehler beim speichern gab, dann konnte auch kein Dokumenttyp gesetzt werden -> es kann also auch keine
' Indexierung stattfinden und die Indexierung muss nicht fortgesetzt werden
Return False
End Try
'Jetzt jeden Indexwert durchlaufen
For Each aName As String In Indizes
indexname = aName
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, Indizes(i))
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
' wenn in aValues an Position i ein Wert steht
If IsNotEmpty(aValues(i)) Then
Dim _int As Boolean = False
Dim _date As Boolean = False
Dim _dbl As Boolean = False
Dim _bool As Boolean = False
'If indexname = "Tournr" Then
' MsgBox("Index: " & indexname & vbNewLine & "wert: " & aValues(i), MsgBoxStyle.Information, "Index: " & aName.ToString)
'End If
Logger.Debug("Indexierung von Index '" & indexname & "'")
'MsgBox(oDocument.aName & vbNewLine & aValues(i) & vbNewLine & vType, MsgBoxStyle.Exclamation, "Zeile 87")
Dim value = aValues(i)
Dim OConvertValue
Dim oIsVector As Boolean = False
'Den Typ des Index-Feldes auslesen
'MsgBox(value.GetType.ToString)
Select Case (vType)
'Case WMObjectVariableValueTypeUndefined
Case WMObjectVariableValueTypeString
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeString")
OConvertValue = CStr(value)
Logger.Debug($"OConvertValue.Length [{OConvertValue.ToString.Length}] - Content/Value: [{OConvertValue}]")
Case WMObjectVariableValueTypeInteger
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeInteger")
value = value.ToString.Replace(" ", "")
If IsNumeric(value) = False Then
Logger.Debug("Achtung: Value '" & value & "' kann nicht in Zahl konvertiert werden!")
End If
value = value.ToString.Replace(" ", "")
OConvertValue = CInt(value)
_int = True
Case WMObjectVariableValueTypeFloat
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
value = value.ToString.Replace(" ", "")
OConvertValue = CDbl(value)
Case WMObjectVariableValueTypeFixedPoint
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint")
value = value.ToString.Replace(" ", "")
OConvertValue = CDbl(value)
_dbl = True
Case WMObjectVariableValueTypeBoolean
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeBoolean")
OConvertValue = CBool(value)
_bool = True
Case WMObjectVariableValueTypeDate
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeDate")
_date = True
'Dim _date As Date = value
OConvertValue = value
Case WMObjectVariableValueTypeTimeStamp
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp")
OConvertValue = CDbl(value)
Case WMObjectVariableValueTypeCurrency
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeCurrency")
'Wegen currency muß ein eigenes Objekt vom typ Variant erzeugt werden
Dim aValueWrapper As System.Runtime.InteropServices.CurrencyWrapper = New System.Runtime.InteropServices.CurrencyWrapper(CDec(value))
OConvertValue = aValueWrapper
Case WMObjectVariableValueTypeTime
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeTime")
'If ((value)) Then
' OConvertValue = CDate(value)
'Else
' OConvertValue = ""
'End If
'Dim _date As Date = value
OConvertValue = OConvertValue '*_date.ToShortTimeString
Case WMObjectVariableValueTypeFloat
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
OConvertValue = CStr(value)
Case WMObjectVariableValueTypeVariant
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeVariant")
OConvertValue = CStr(value)
Case WMObjectVariableValueTypeFulltext
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFulltext")
OConvertValue = CStr(value)
Case 4097
Logger.Debug("Typ des windream-Indexes: 4097 Vektor alphanumerisch")
'Vektor alphanumerisch
oIsVector = True
Case 4098
Logger.Debug("Typ des windream-Indexes: 4098 oIsVector Numerisch")
'Vektor Numerisch
oIsVector = True
Case 4099
Logger.Debug("Typ des windream-Indexes: 4099 Vektor Kommazahl")
'Vektor Kommazahl
oIsVector = True
Case 4100
Logger.Debug("Typ des windream-Indexes: 4100 Vektor Boolean")
oIsVector = True
Case 4101
Logger.Debug("Typ des windream-Indexes: 4101 Vektor Date")
'Vektor Kommazahl
oIsVector = True
Case 4103
Logger.Debug("Typ des windream-Indexes: 4103 Vektor DateTime")
'Vektor DateTime
oIsVector = True
Case 4107
Logger.Debug("Typ des windream-Indexes: 4107 Integer 64bit")
oIsVector = True
Case 36865
Logger.Debug("Typ des windream-Indexes: 36865 Vektor alphanumerisch")
'Vektor Kommazahl
oIsVector = True
Case Else
Logger.Debug($"Typ des windream-Indexes [{indexname} - Typ: {vType.ToString} ] konnte nicht bestimmt werden!")
Logger.Debug("Versuch des Auslesens (vType): " & vType)
'MsgBox(vType & vbNewLine & CStr(value), MsgBoxStyle.Exclamation, "Marlon-Case Else")
OConvertValue = ""
End Select
If oIsVector = False Then
If OConvertValue.ToString Is Nothing = False Then
Logger.Debug("Konvertierter Wert: '" & OConvertValue.ToString & "'")
End If
End If
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
'############################################################################################
If oIsVector = False Then
If OConvertValue.ToString Is Nothing = False Then
Logger.Debug("Versuch dem Dok einen Index zuzuweisen: oDocument.SetVariableValue(" & aName & ", " & OConvertValue & ")")
If _int = True Then
OConvertValue = OConvertValue.ToString.Replace(" ", "")
oDocument.SetVariableValue(aName, CInt(OConvertValue))
ElseIf _date = True Then
oDocument.SetVariableValue(aName, CDate(OConvertValue))
ElseIf _bool Then
oDocument.SetVariableValue(aName, CBool(OConvertValue))
ElseIf _dbl Then
OConvertValue = OConvertValue.ToString.Replace(" ", "")
oDocument.SetVariableValue(aName, CDbl(OConvertValue))
Else
If OConvertValue.ToString.Length <= 512 Then
oDocument.SetVariableValue(aName, OConvertValue)
Else
Logger.Info($"Will not set indexvalue of index [{aName}] with the full length as Length > 512 [{OConvertValue.ToString.Length}]")
oDocument.SetVariableValue(aName, OConvertValue.ToString.Substring(0, 511))
End If
End If
Logger.Info(String.Format("Index '{0}' was written with value '{1}'", aName, OConvertValue))
Logger.Info("")
Else
Logger.Warn("Kein Indexwert vorhanden")
End If
Else
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
Logger.Debug("VEKTORFELD: Vorbereiten des Arrays")
Dim myArray()
'Dim DS As DataSet
'Dim DT As DataTable
'Dim DR As DataRow
'' --- DataSet zuweisen
'DS = New MyDataset
'' --- Zugriff auf Tabelle
'DT = DS.Tables("TBVEKTOR_INDEX")
'DT.Clear()
'For Each NewValue As Object In aValues
'Next
'' --- den Filter auf den Indexnamen setzen
'Dim expression As String
'expression = "Indexname = '" & aName.ToString & "'"
'Dim foundRows() As DataRow
' Use the Select method to find all rows matching the filter.
'foundRows = DT.Select(expression)
'For Each row As DataRow In DT.Rows
'MsgBox(aName & vbNewLine & row.Item("Indexname") & vbNewLine & CStr(row.Item("Wert")))
'Next
Dim Anzahl As Integer = aValues.Length
'Vektorfeld wird mit EINEM Wert gefüllt
If Anzahl = 1 And vType = 4100 Then
Logger.Debug("Vektorfeld wird mit EINEM Wert gefüllt ")
ReDim myArray(0)
Select Case vType
Case 36865
'Umwandeln in String
myArray(0) = CStr(value)
Case 4097
'Umwandeln in String
myArray(0) = CStr(value)
Case 4098
'Umwandeln in Integer
value = value.ToString.Replace(" ", "")
myArray(0) = CInt(value)
Case 4099
Dim Str As String = value
Str = Str.ToString.Replace(" ", "")
'Umwandeln in Double
myArray(0) = CDbl(Str.Replace(".", ","))
Case 4100
myArray(0) = CBool(value)
Case 4101
'Umwandeln in Date
myArray(0) = CDate(value)
Case 4107
myArray(0) = Convert.ToInt64(value)
Case 4103
'Umwandeln in Datum Uhrzeit
myArray(0) = value
Case Else
'Umwandeln in String
myArray(0) = CStr(value)
End Select
Logger.Debug("Konvertierter Wert: " & myArray(0).ToString)
Else
Logger.Debug("Vektorfeld wird mit MEHREREN Werten gefüllt ")
Select Case vType
Case 36865
'Vektortyp ALPHANUMERISCH
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
myArray(i1) = CStr(NewValue)
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
For Each NewValue As Object In aValues
myArray(i1) = CStr(NewValue)
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
Case 4097
'Vektortyp ALPHANUMERISCH
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
myArray(i1) = CStr(NewValue)
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
Case 4107
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
myArray(i1) = Convert.ToInt64((NewValue))
i1 = i1 + 1
Next
Case 4098
'Vektortyp NUMERISCH
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
Dim v As String = NewValue.ToString.Replace(" ", "")
myArray(i1) = CInt(v)
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
Case 4099
'Vektortyp FLOAT
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
Dim Str As String = NewValue
Str = Str.ToString.Replace(" ", "")
myArray(i1) = CDbl(Str.Replace(".", ","))
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
Case 4100
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
Dim Str As String = NewValue.ToString
myArray(i1) = CBool(Str)
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
Case 4101
'Vektortyp DATE
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
Dim Str As String = NewValue.ToString
myArray(i1) = CDate(Str.Replace(".", ","))
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
Case Else
'Vektortyp ALPHANUMERISCH
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each NewValue As Object In aValues
myArray(i1) = CStr(NewValue)
Logger.Debug("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
End Select
End If
'Jetzt die Nachindexierung für Vektor-Felder
oDocument.SetVariableValue(aName, myArray)
Logger.Info(String.Format("Vektor-Index '{0}' was written!", aName))
Logger.Info("")
Dim sm = oDocument.aName
End If
Else
Logger.Debug("Array der Indexwerte ist leer/Nothing - Keine Nachindexierung")
End If
i += 1
Next
' oDocument.LockRights()
'SetRights(WMObject, User)
oDocument.Save()
oDocument.unlock()
Logger.Debug("Indexierung erfolgreich beendet (Save und Unlock durchgeführt)")
Logger.Debug("")
Return True
Else
Logger.Warn("Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
'oDocument.unlock()
Return False
End If
End If
Catch ex As Exception
Logger.Error(ex)
'clsLogger.AddError(ex.Message, "ClassSearchResult.RunIndexing")
oDocument.Save()
oDocument.unlock()
Return False
End Try
End Function
#End Region
Public Function GetVektorArray(ByVal oDocument As WMObject, oIndexName As String, NIIndexe As Object, CheckDuplikat As Boolean)
Try
If GetCheckIsVector(oIndexName) = False Then
Return Nothing
End If
Dim missing As Boolean = False
Dim Anzahl As Integer = 0
Dim ValueArray()
'Jeden Wert des Vektorfeldes durchlaufen
Dim wertWD = oDocument.GetVariableValue(oIndexName)
If wertWD Is Nothing = False Then
'Nochmals prüfen ob wirklich Array
If wertWD.GetType.ToString.Contains("System.Object") Then
'Keine Duplikatprüfung also einfach neues Array füllen
If CheckDuplikat = False Then
For Each value As Object In wertWD
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = value.ToString
Anzahl += 1
Next
'Und jetzt den/die Neuen Wert(e) anfügen
For Each NewValue As Object In NIIndexe
If NewValue Is Nothing = False Then
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = NewValue.ToString
Anzahl += 1
End If
Next
Else
Logger.Debug("Duplikatprüfung soll durchgeführt werden.")
'Duplikat Prüfung an, also nur anhängen wenn Wert <>
For Each WDValue As Object In wertWD
If WDValue Is Nothing = False Then
'Erst einmal die ALten Werte schreiben
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = WDValue.ToString
Logger.Debug("Value (" & Anzahl & ") " & WDValue.ToString)
Anzahl += 1
End If
Next
'Jetzt die Neuen Werte auf Duplikate überprüfen
For Each NewValue As Object In NIIndexe
If NewValue Is Nothing = False Then
If ValueArray.Contains(NewValue) = False Then
Logger.Debug("New Value (" & Anzahl & ") " & NewValue.ToString)
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = NewValue.ToString
Anzahl += 1
Else
Logger.Debug("Value '" & NewValue.ToString & "' bereits in Vektorfeld enthalten")
End If
End If
Next
End If
End If
Else
Logger.Debug("Vektorfeld ist noch leer....")
'Den/die Neuen Wert(e) anfügen
For Each NewValue As Object In NIIndexe
If NewValue Is Nothing = False Then
If CheckDuplikat = True Then
If ValueArray Is Nothing = False Then
If ValueArray.Contains(NewValue) = False Then
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = NewValue.ToString
Anzahl += 1
Else
Logger.Debug("Value '" & NewValue.ToString & "' bereits in Array enthalten")
End If
Else 'Dererste Wert, also hinzufügen
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = NewValue.ToString
Anzahl += 1
End If
Else
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = NewValue.ToString
Anzahl += 1
End If
End If
Next
End If
Logger.Debug("Return ValueArray: length " & ValueArray.Length)
Return ValueArray
Catch ex As Exception
Logger.Error(ex)
ClassCurrent.MessageError = True
'clsLogger.AddError(ex.Message, "Return_VektorArray")
Return Nothing
End Try
End Function
#Region "+++++ Allgemeine Funktionen die Informationen zurückliefern +++++"
Public Function GetCheckIsVector(oIndexname As String)
Dim oAttribute = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, oIndexname)
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
Select Case (vType)
'Case WMObjectVariableValueTypeUndefined
Case WMObjectVariableValueTypeString
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeString")
Case WMObjectVariableValueTypeInteger
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeInteger")
Case WMObjectVariableValueTypeFloat
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
Case WMObjectVariableValueTypeFixedPoint
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint")
Case WMObjectVariableValueTypeBoolean
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeBoolean")
Case WMObjectVariableValueTypeDate
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeDate")
Case WMObjectVariableValueTypeTimeStamp
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp")
Case WMObjectVariableValueTypeCurrency
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeCurrency")
Case WMObjectVariableValueTypeTime
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeTime")
Case WMObjectVariableValueTypeFloat
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
Case WMObjectVariableValueTypeVariant
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeVariant")
Case WMObjectVariableValueTypeFulltext
Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFulltext")
Case 4097
Logger.Debug("Typ des windream-Indexes: 4097 Vektor alphanumerisch")
'Vektor alphanumerisch
Return True
Case 4098
Logger.Debug("Typ des windream-Indexes: 4098 oIsVector Numerisch")
Return True
Case 4099
Logger.Debug("Typ des windream-Indexes: 4099 Vektor Kommazahl")
Return True
Case 4100
Logger.Debug("Typ des windream-Indexes: 4100 Vektor Boolean")
Return True
Case 4101
Logger.Debug("Typ des windream-Indexes: 4101 Vektor Date")
Return True
Case 4103
Logger.Debug("Typ des windream-Indexes: 4103 Vektor DateTime")
Return True
Case 4107
Logger.Debug("Typ des windream-Indexes: 4107 Integer 64bit")
Return True
Case 36865
Logger.Debug("Typ des windream-Indexes: 36865 Vektor alphanumerisch")
Return True
Case Else
Logger.Debug($"GetCheckISVektor Typ des windream-Indexes [{oIndexname} - Typ: {vType.ToString} ] konnte nicht bestimmt werden!")
End Select
Return False
End Function
''' Liefert den Wert eines Indexes als String
''' _indexname = Name des zu überprüfenden Indexfeldes
Public Function GetValueforIndex(ByVal _fullfilepath As String, _indexname As String)
Try
Const WMEntityDocument = 1
Dim IndexwertAusWindream As Object = Nothing
Dim _dok As WINDREAMLib.WMObject
_dok = Nothing
_dok = oWMSession.GetWMObjectByPath(WMEntityDocument, _fullfilepath) 'WINDREAMLib.WMEntity.WMEntityDocument
IndexwertAusWindream = _dok.GetVariableValue(_indexname)
Return IndexwertAusWindream.ToString
Catch ex As Exception
'MsgBox(ex.Message)
Return Nothing
End Try
End Function
''' Liefert den Wert eines Indexes als String
''' _indexname = Name des zu überprüfenden Indexfeldes
Public Function GetValueforIndex_WMFile(ByVal _dok As WMObject, _indexname As String)
Try
Const WMEntityDocument = 1
Dim IndexwertAusWindream As Object = Nothing
IndexwertAusWindream = _dok.GetVariableValue(_indexname)
Return IndexwertAusWindream.ToString
Catch ex As Exception
'MsgBox(ex.Message)
Return Nothing
End Try
End Function
#End Region
End Class

498
App/EmailProfiler.Common/clsWindream_allgemein.vb Normal file
View File

@@ -0,0 +1,498 @@
Imports WINDREAMLib
Imports WINDREAMLib.WMCOMEvent
Imports WINDREAMLib.WMEntity
Imports WINDREAMLib.WMObjectEditMode
Imports WINDREAMLib.WMSearchOperator
Imports WINDREAMLib.WMSearchRelation
Imports WMOBRWSLib
Imports WMOSRCHLib
Imports System.IO
Imports DigitalData.Modules.Logging
Imports DigitalData.EMLProfiler.ClassCurrent
Public Class clsWindream_allgemein
#Region "+++++ Konstanten +++++"
Const DEBUG = AUS
Const AUS = 0
Const WINDREAM = 1
Const VARIABLEN = 2
#End Region
#Region "+++++ Variablen +++++"
Public Shared oConnect ' der Typ darf nicht festgelegt werden (warum auch immer... geht sonst nicht)
Public Shared oWMSession 'As WINDREAMLib.WMSession ' der Typ darf nicht festgelegt werden (warum auch immer... geht sonst nicht)
Public Shared oBrowser As New WMOBRWSLib.ServerBrowser
Public Shared oDokumentTypen As WINDREAMLib.WMObjects
Private Shared oController As New WMOSearchController
Private Shared Logger As Logger
#End Region
#Region "+++++ Allgemeine Methoden und Funktionen +++++"
''' <summary>
''' Konstruktor für die windream-Klasse
''' </summary>
''' <remarks></remarks>
Sub New(LogConf As LogConfig)
Logger = LogConf.GetLogger
' wenn ein Fehler bei der Initialisierung auftrat
If Not Init() Then
' Nachricht ausgeben
Logger.Warn("Es trat ein Fehler bei der Initialisierung der Klasse windream auf. Bitte prüfen Sie ob der windream-Server aktiv ist und alle Dienste gestartet sind")
' das Programm "abschießen"
Process.GetCurrentProcess.Kill()
End If
End Sub
''' <summary>
''' Initialisiert die statische Klasse (Login, Session starten, usw.)
''' </summary>
''' <returns>Liefert True wenn das Anmelden erfolgreich war, sonst False</returns>
''' <remarks></remarks>
Public Function Init() As Boolean
Try
Try
Dim oHourDifference As Integer
oHourDifference = CInt(DateDiff(DateInterval.Hour, CURRENToWMSession_Created, Now))
If IsNothing(CURRENToWMSession) Or oHourDifference >= 2 Then
' Session-Objekt instanziieren und mit dem im Client ausgewählten Server belegen
oWMSession = CreateObject("Windream.WMSession", GetCurrentServer)
' Connection-Objekt instanziieren
oConnect = CreateObject("Windream.WMConnect")
CURRENToWMConnect = oConnect
Else
Logger.Debug("WMSession already created!")
oWMSession = CURRENToWMSession
Return True
End If
Catch ex As Exception
Return False
End Try
' wenn windream nicht angemeldet ist
If Not IsLoggedIn() Then
' Art der Anmeldung an windream festlegen
' 0x0L (also 0) = Standard windream Benutzer
' WM_MODULE_ID_DOCTYPEEDITOR_LIC = ermöglicht Zugriff auf die windream Management Funktionen (Z.B. zur Verwaltung der windream Dokumententypen, Auswahllisten, etc.)
' WM_MODULE_ID_INDEXSERVICE = ermöglicht der Session die Indexierungs-Events vom windream DMS-Service zu empfangen
oConnect.ModuleID = 0
' setzt die minimal erwartete windream-Version
oConnect.MinReqVersion = "3"
' Logger.Debug("Personifizierung'")
' -- Impersonifizierung nur möglich mit registry-eintrag --
'oConnect.UserName = "\digitaldata\SchreiberM"
'oConnect.Password = "pw"
' Verbindung mit Session-Objekt (und dem ausgewählten Server) aufbauen
oConnect.LoginSession(oWMSession)
Logger.Debug("windream-Server: '" & GetCurrentServer() & "'")
Logger.Debug("windream-UserName: '" & oConnect.UserName & "'")
If oWMSession.aLoggedin = False Then
Logger.Warn("Es konnte keine Verbindung mit dem windream-Server hergestellt werden")
Return False
End If
' AUSGABE VON SYSTEMINFORMATIONEN
' Gibt die Versionsart (Lizenztyp) also Small-Business-Edition (SBE), Small-Business-Extension (SBX)
' oder Business-Edition (BE) aus
'MsgBox("WindreamVersion: " & oSession.GetSystemInfo("WindreamVersion") & vbNewLine & "LicenceKey: " & oSession.GetSystemInfo("LicenceKey") & vbNewLine & _
' vbNewLine & "LicenceName: " & oSession.GetSystemInfo("LicenceName"))
'Dim WMCtrl As AISCONTROLDATACOMLib.AISControlData
'WMCtrl = New AISCONTROLDATACOMLib.AISControlData
'' liefert die Versionsnummer des Clients
'MsgBox(WMCtrl.WMWorkstationBuildNo)
'MsgBox(WMCtrl.W
'' liefert den Servernamen des angemeldeten windreams
'MsgBox(WMCtrl.WMServerName)
Try
oWMSession.SwitchEvents(WMCOMEventWMSessionNeedIndex, False)
' der Parameter WMEntityDocument definiert, dass nur Dokumenttypen und keine
' Ordnertypen ausgelesen werden
oDokumentTypen = oWMSession.GetWMObjectTypes(WINDREAMLib.WMEntity.WMEntityDocument)
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End If
CURRENToWMSession = oWMSession
CURRENToWMSession_Created = Now
Logger.Debug("Alles OK - Erfolgreich angemeldet und Session aufgebaut")
Return True
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
#End Region
#Region "+++++ Funktionen die für den Objekttyp relevate Informationen zurückliefern +++++"
''' <summary>
''' Liefert alle Objekttypen des aktuellen Servers als windream-Objekte.
''' </summary>
''' <returns>Alle Objekttypen als WMObjects-Objekt</returns>
''' <remarks></remarks>
Public Function GetObjecttypesAsObjects() As WMObjects
Try
Return oDokumentTypen
Catch ex As Exception
Logger.Error(ex)
'clsLogger.AddError("Fehler beim Auslesen der Objekttypen: " & ex.Message, "clswindream.GetObjecttypesAsObjects")
Return Nothing
End Try
End Function
''' <summary>
''' Liefert alle Objekttypen des aktuellen Servers als Array aus Strings.
''' </summary>
''' <returns>Array mit allen Objekttypen als Strings</returns>
''' <remarks></remarks>
Public Function GetObjecttypesAsStrings() As String()
Dim objektTypenStr() As String
Try
Dim ocount As Integer = 0
For i As Integer = 0 To oDokumentTypen.Count
Dim obj = oDokumentTypen.Item(i).aName
If obj.ToString <> "Annotation" Then
ReDim Preserve objektTypenStr(ocount)
objektTypenStr(ocount) = obj.ToString
ocount += 1
End If
Next
Return objektTypenStr
Catch ex As Exception
Return objektTypenStr
End Try
End Function
''' <summary>
''' Liefert alle Indexe eines Objekttypen.
''' </summary>
''' <param name="name">Name des Objekttyps</param>
''' <returns>Array mit allen Objekttyp zugeordneten Indexen als String</returns>
''' <remarks></remarks>
Public Function GetIndicesByObjecttype(ByVal name As String) As String()
Try
Dim oObjectType As WMObject
Dim oIndexAttributes As WMObjectRelation
Dim oIndexAttribute As WMObject
Dim oIndex As WMObject
Dim oRelProperties As WMObjectRelationClass
' den Objekttyp laden
oObjectType = oWMSession.GetWMObjectByName(WMEntityObjectType, name)
' Beziehung zu Indizes des Objekttyp auslesen
oIndexAttributes = oObjectType.GetWMObjectRelationByName("TypeAttributes")
' Array für Indizes vorbereiten
Dim aIndexNames(oIndexAttributes.Count - 1) As String
' alle Indizes durchlaufen
For j As Integer = 0 To oIndexAttributes.Count - 1
' aktuellen Index auslesen
oIndexAttribute = oIndexAttributes.Item(j)
' Eigenschaften des Index auslesen
oRelProperties = oIndexAttribute.GetWMObjectRelationByName("Attribute")
' Index aus den Eigenschaften auslesen
oIndex = oRelProperties.Item(0)
' Indexname speichern
aIndexNames(j) = oIndex.aName
Next
' Indexarray zurückgeben
Return aIndexNames
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
''' <summary>
''' Liefert einen Objekttyp als WMObject an Hand dessen Name.
''' </summary>
''' <param name="objekttypName">Name des Objekttyps</param>
''' <returns>Objekttyp als WMObject</returns>
''' <remarks></remarks>
Public Function GetObjecttypeByName(ByVal objekttypName As String) As WMObject
Try
' alle Objekttypen auslesen
Dim oObjectTypes As WMObjects = oWMSession.GetWMObjectTypes(WINDREAMLib.WMEntity.WMEntityDocument)
' alle Objekttypen durchlaufen und nach dem mit dem angegebenen Namen suchen
For Each oObjectType As WMObject In oObjectTypes
If oObjectType.aName = objekttypName Then
Return oObjectType
End If
Next
Return Nothing
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
''' <summary>
''' Überprüft ob der angegebene Index im Objekttyp existiert
''' </summary>
''' <param name="objekttyp">Name des zu durchsuchenden Objekttyps</param>
''' <param name="indexname">Name des zu suchenden Indexes</param>
''' <returns>Liefert True wenn der Index im Objekttyp existiert, sonst False</returns>
''' <remarks></remarks>
Public Function ExistIndexInObjekttyp(ByVal objekttyp As String, ByVal indexname As String) As Boolean
Try
Dim indexnamen() As String = GetIndicesByObjecttype(objekttyp)
If indexnamen Is Nothing Then Return False
For Each index As String In indexnamen
If index = indexname Then Return True
Next
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
#End Region
#Region "+++++ Allgemeine Funktionen die Informationen zurückliefern +++++"
''' <summary>
''' Liefert True wenn die windream-Session angemeldet ist und False für den Fall, dass die Session nicht eingeloggt ist.
''' </summary>
''' <returns>Anmeldestatus als Boolean</returns>
''' <remarks></remarks>
Public Function IsLoggedIn() As Boolean
Try
Return oWMSession.aLoggedin
Catch ex As Exception
Logger.Error(ex)
End Try
Return False
End Function
''' <summary>
''' Liefert den Servernamen an dem windream aktuell angemeldet ist.
''' </summary>
''' <returns>Servername als String</returns>
''' <remarks></remarks>
Public Function GetCurrentServer() As String
Try
Logger.Debug(oBrowser.GetCurrentServer.ToString)
Return oBrowser.GetCurrentServer 'ClassWindream.oBrowser.GetCurrentServer
Catch ex As Exception
Logger.Error(ex)
End Try
Return ""
End Function
'Public Function GetSharedCurrentServer() As String
' Try
' Return ClassWindream.oBrowser.GetCurrentServer
' Catch ex As Exception
' MsgBox("Der aktuell gewählte windream-Server konnte nicht ausgelesen werden." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Auslesen des windream-Servers")
' End Try
' Return ""
'End Function
'Liefert das Windream-Laufwerk des windream-Servers, in Form '[Laufwerksbuchstabe]:'. (z.B. 'W:')
'Laufwerksbuchstabe mit Doppelpunkt als String</returns>
'
'Public Function GetWindreamDriveLetter() As String
' Try
' Dim oControl As AISCONTROLDATACOMLib.AISControlData
' Dim sDrive As String = ""
' ' oControl = New AISCONTROLDATACOMLib.AISControlData
' ' sDrive = oControl.GetStringValue(&H10040003)
' ' Return sDrive & ":"
' Catch ex As Exception
' MsgBox("Fehlernachricht: " & ex.Message, MsgBoxStyle.Critical, "Fehler beim Auslesen des windream-Laufwerks")
' End Try
' Return ""
'End Function
''' <summary>
''' Liefert den Typen eines Indexes als Integer.
''' </summary>
''' <param name="indexname">Name des zu überprüfenden Indexfeldes</param>
''' <returns>Liefert eine Zahl, die einen Typen beschreibt</returns>
''' <remarks></remarks>
Public Function GetTypeOfIndexAsIntByName(ByVal indexname As String) As Integer
Try
Dim oAttribute = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname)
Dim vType = oAttribute.getVariableValue("dwAttrType")
Return vType
Catch ex As Exception
Return Nothing
End Try
End Function
Public Function GetValuesfromAuswahlliste(ByVal indexname As String) As Object
Try
'Dim oAttribute = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname)
'Dim vType = oAttribute.getVariableValue("vItems")
'Return vType
Dim oChoiceList = oWMSession.GetWMObjectByName(WMEntityChoiceList, indexname)
If Err.Number = 0 And TypeName(oChoiceList) <> "Nothing" Then
Dim Values = oChoiceList
Values = oChoiceList.GetVariableValue("vItems")
Dim anz As Integer = 0
For Each CLItem In Values
If oChoiceList.aName IsNot Nothing Then
anz += 1
End If
Next
Dim strListe(anz - 1)
Dim zahl As Integer = 0
For Each CLItem In Values
If oChoiceList.aName IsNot Nothing Then
strListe(zahl) = CLItem
zahl += 1
End If
Next
Return strListe
Else
Logger.Warn("Auswahlliste: " & indexname & " nicht gefunden.")
Return Nothing
End If
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function WDObject_exists(wdobj_location As String)
Dim WDObject As WMObject
Try
WDObject = oWMSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, wdobj_location.Substring(2))
If WDObject Is Nothing Then
Return False
Else
Logger.Debug("WDObject exists")
Return True
End If
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei machen
Logger.Error(ex)
Return False
End Try
End Function
Public Function GetSearchDocuments(ByVal wdfLocation As String)
Try
Dim SearchName = wdfLocation.Substring(wdfLocation.LastIndexOf("\") + 1)
Dim SearchPath = wdfLocation.Substring(0, wdfLocation.Length - SearchName.Length)
Logger.Info("WMSearch: " & wdfLocation.ToLower)
If System.IO.File.Exists(wdfLocation.ToLower) Then
Logger.Debug("Search exists")
End If
oController.CheckSearchProfile(wdfLocation.ToLower) 'wdfLocation.ToLower)
Logger.Debug("oController erzeugt")
Dim suchTyp = oController.SearchProfileTargetProgID
Dim ExSettings As Object
Dim oSearch As Object
ExSettings = oController.SearchProfileExSettings
If ExSettings = 0 Then ExSettings = 7
Dim srchQuick As WMOSRCHLib.WMQuickSearch = CreateObject("WMOSrch.WMQuickSearch")
Dim srchIndex As WMOSRCHLib.WMIndexSearch = CreateObject("WMOSrch.WMIndexSearch")
Dim srchObjectType As WMOSRCHLib.WMObjectTypeSearch = CreateObject("WMOSrch.WMObjectTypeSearch")
Logger.Debug("WD Objekte in GetSearchDocuments erzeugt")
Logger.Debug(suchTyp.ToString.ToUpper)
'' Der öffentliche Member CheckSearchProfile für den Typ IWMQuickSearch7 wurde nicht gefunden. [Microsoft.VisualBasic] => GetSearchDocuments()
Select Case suchTyp.ToString.ToUpper
Case "WMOSRCH.WMQUICKSEARCH"
srchQuick.WMSession = CreateObject("Windream.WMSession", GetCurrentServer)
oConnect.LoginSession(srchQuick.WMSession)
srchQuick.ClearSearch()
srchQuick.SearchProfilePath = SearchPath
srchQuick.LoadSearchProfile(SearchName)
oSearch = srchQuick.GetSearch()
Case "WMOSRCH.WMINDEXSEARCH"
srchIndex.WMSession = CreateObject("Windream.WMSession", GetCurrentServer)
Logger.Debug("Session created...")
oConnect.LoginSession(srchIndex.WMSession)
Logger.Debug("LoginSession...")
srchIndex.SearchProfilePath = SearchPath
Logger.Debug("SearchPath...")
srchIndex.LoadSearchProfile(SearchName)
Logger.Debug("LoadSearchProfile...")
oSearch = srchIndex.GetSearch()
Logger.Debug("GetSearch...")
Case "WMOSRCH.WMOBJECTTYPESEARCH"
srchObjectType.WMSession = CreateObject("Windream.WMSession", GetCurrentServer)
oConnect.LoginSession(srchObjectType.WMSession)
srchObjectType.ClearSearch()
srchObjectType.SearchProfilePath = SearchPath
srchObjectType.LoadSearchProfile(SearchName)
oSearch = srchObjectType.GetSearch()
Case Else
Logger.Warn("KEIN GÜLTIGER WINDREAM-SUCHTYP")
Return Nothing
End Select
Dim WMObjects As Object
WMObjects = oSearch.Execute
Logger.Debug("WD Objekte werden zurückgegeben")
Return oSearch.execute
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei machen
Logger.Error(ex)
Return Nothing
End Try
End Function
#End Region
End Class

1000
App/EmailProfiler.Common/clsWorkEmail.vb Normal file
View File

File diff suppressed because it is too large Load Diff

268
App/EmailProfiler.Common/clsWorker.vb Normal file
View File

@@ -0,0 +1,268 @@
Imports DigitalData.EMLProfiler.ClassCurrent
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Messaging
Imports Limilabs.Mail
Imports Limilabs.Mail.MIME
Imports Limilabs.Mail.Headers
Imports DigitalData.Modules.Database
Public Class clsWorker
Private Shared Logger As Logger
'Private _email As clsEmail
Private ReadOnly _emailIMAP As clsEmailIMAP
'Private _Database As clsDatabase
Private ReadOnly _Database As MSSQLServer
Private ReadOnly _USE_WM As Boolean = False
Private ReadOnly _windream As clsWindream_allgemein
Private ReadOnly _windream_index As clsWindream_Index
Private ReadOnly _workmail As clsWorkEmail
Private ReadOnly _wrapper As clsEncryption
Private ReadOnly _POLL_PROFILEID As Integer = 0
Private ReadOnly Eml_Limitation_Sender As String = ""
Sub New(pLogConfig As LogConfig, ConStr As String, WMConStr As String, POLL_PROFILEID As Integer, USE_WM As Boolean, EmailAccountID As Integer, EmlProfPraefix As String, EML_LIMITATION As String, Optional plocaleml As String = "")
Logger = pLogConfig.GetLogger
_emailIMAP = New clsEmailIMAP(pLogConfig)
_Database = New MSSQLServer(pLogConfig, ConStr)
_USE_WM = USE_WM
Eml_Limitation_Sender = EML_LIMITATION
If _USE_WM Then
_windream = New clsWindream_allgemein(pLogConfig)
_windream_index = New clsWindream_Index(pLogConfig)
End If
_workmail = New clsWorkEmail(pLogConfig, ConStr, WMConStr, USE_WM, EmailAccountID, EmlProfPraefix)
_wrapper = New clsEncryption("!35452didalog=", pLogConfig)
_POLL_PROFILEID = POLL_PROFILEID
CURRENT_DEBUG_LOCAL_EMAIL = plocaleml
End Sub
Public Sub Start_WorkingProfiles(Optional LocalEmail As Boolean = False)
Try
For Each _file In TEMP_FILES
Logger.Debug("Trying to delete temp file: [{0}]", _file)
If IO.File.Exists(_file) Then
Try
IO.File.Delete(_file)
Catch ex As Exception
Logger.Error(ex)
Logger.Warn($"TempFileDelete - Could not delete the tempfile from TEMP_FILES: {ex.Message}")
End Try
End If
Next
TEMP_FILES.Clear()
If _Database.DBInitialized = True Then
Logger.Debug("now windream_init... ")
If _USE_WM Then
If _windream.Init = False Then
Logger.Info("windream could not be initialized!!")
Exit Sub
Else
Logger.Debug("windream_initialized!")
End If
End If
Dim osql As String = "SELECT * FROM TBEMLP_POLL_PROFILES"
If _POLL_PROFILEID = 0 Then
osql &= " WHERE ACTIVE = 1 order by SEQUENCE"
Else
osql &= " WHERE GUID = " & _POLL_PROFILEID
End If
Dim DT_TBDD_EMAIL As DataTable = _Database.GetDatatable("SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1")
Dim DT_PROFILES = _Database.GetDatatable(osql)
If Not IsNothing(DT_PROFILES) Then
If DT_PROFILES.Rows.Count > 0 Then
Logger.Debug("count of active profiles: " & DT_PROFILES.Rows.Count.ToString)
For Each oDR_Profile As DataRow In DT_PROFILES.Rows
CURRENT_PROFILE_GUID = oDR_Profile.Item("GUID")
DT_POLL_PROCESS = Nothing
Dim sql = String.Format("SELECT * FROM TBEMLP_POLL_PROCESS WHERE PROFILE_ID = {0} AND ACTIVE = 1", CURRENT_PROFILE_GUID)
DT_POLL_PROCESS = _Database.GetDatatable(sql)
If Not IsNothing(DT_POLL_PROCESS) Then
If DT_POLL_PROCESS.Rows.Count = 0 Then
Logger.Info("No processes configured for this Email-Profile - " & sql)
Continue For
Else
DT_STEPS = Nothing
DT_STEPS = _Database.GetDatatable(String.Format("SELECT T.* FROM TBEMLP_POLL_STEPS T,TBEMLP_POLL_PROCESS T1 WHERE T.PROCESS_ID = T1.GUID AND T1.PROFILE_ID = {0} AND T1.ACTIVE = 1", CURRENT_PROFILE_GUID))
End If
Else
Logger.Warn("DT_POLL_PROCESS is nothing")
Continue For
End If
CURRENT_EMAIL_GUID = 0
MAIL_FROM = ""
MAIL_SERVER = ""
MAIL_USER = ""
MAIL_USER_PW = ""
CURRENT_POLL_TYPE = oDR_Profile.Item("POLL_TYPE")
Logger.Debug(String.Format("Working on profile: ({0}-{1}-{2}) ", oDR_Profile.Item("GUID"), oDR_Profile.Item("PROFILE_NAME"), CURRENT_POLL_TYPE))
CURRENT_EMAIL_GUID = oDR_Profile.Item("EMAIL_CONF_ID")
Dim EMAIL_PROF_TABLE As DataTable = DT_TBDD_EMAIL
'Presuming the DataTable has a column named Date.
Dim expression As String
expression = "GUID = " & CURRENT_EMAIL_GUID
Logger.Debug("Expression Filter email: " & expression)
Logger.Debug("DT_TBDD_EMAIL.rowCount: " & DT_TBDD_EMAIL.Rows.Count)
'Filter the rows using Select() method of DataTable
Dim FilteredRows As DataRow() = EMAIL_PROF_TABLE.Select(expression)
If FilteredRows.Length = 1 Then
For Each row As DataRow In FilteredRows
MAIL_FROM = row("EMAIL_FROM")
MAIL_SERVER = row("EMAIL_SMTP")
MAIL_USER = row("EMAIL_USER")
MAIL_USER_PW = row("EMAIL_PW")
MAIL_PORT = row("PORT_IN")
MAIL_INBOX_NAME = "Inbox"
MAIL_ARCHIVE_FOLDER = row("ARCHIVE_FOLDER")
MAIL_AUTHTYPE = row("AUTH_TYPE")
Logger.Debug(String.Format("{0}-{1}", MAIL_FROM, MAIL_SERVER))
Dim PWPlain = _wrapper.DecryptData(MAIL_USER_PW)
If Not IsNothing(PWPlain) Then
If PWPlain <> "" Then
MAIL_USER_PW = PWPlain
Else
Logger.Warn("PWPlain is string.empty - Could not decrypt passwort")
End If
Else
Logger.Warn("PWPlain is nothing - Could not decrypt passwort")
End If
Next
CURRENT_WORKMAIL_UID_LIST.Clear()
If MAIL_SERVER <> "" Then
Dim pollresult As Boolean = False
If LocalEmail = True Then
pollresult = True
Else
Select Case CURRENT_POLL_TYPE
Case "POP"
'pollresult = _email.POP3_COLLECT()
Case "IMAP"
pollresult = _emailIMAP.FetchIMAPMessagesLimilab(MAIL_SERVER, MAIL_PORT, MAIL_USER, MAIL_USER_PW, MAIL_AUTHTYPE)
End Select
End If
If CURRENT_WORKMAIL_UID_LIST.Count() > 0 Or LocalEmail = True Then
If LocalEmail Then
Logger.Info("Working with local Mail")
Dim oEmail As IMail = New MailBuilder().CreateFromEmlFile(CURRENT_DEBUG_LOCAL_EMAIL)
_workmail.WorkEmailMessage(oEmail, 123456789)
CURRENT_MAIL_MESSAGE = Nothing
Else
Try
Logger.Info(String.Format("Pulled: [{0}] E-Mails", CURRENT_WORKMAIL_UID_LIST.Count()))
Dim LIMIT_EMAIL_FROM As Boolean = False
If Eml_Limitation_Sender.Contains("@") Then
LIMIT_EMAIL_FROM = True
Logger.Info("####################################")
Logger.Info($"LIMIT_EMAIL_FROM is ACTIVE - EMAIL_FROM = [{Eml_Limitation_Sender}]")
Logger.Info("####################################")
Logger.Debug("####################################")
Logger.Debug($"LIMIT_EMAIL_FROM is ACTIVE - EMAIL_FROM = [{Eml_Limitation_Sender}]")
Logger.Debug("####################################")
End If
For Each oUID In CURRENT_WORKMAIL_UID_LIST
Dim oEml = CURRENT_ImapObject.GetMessageByUID(oUID)
Dim oEmail As IMail = New MailBuilder().CreateFromEml(oEml)
If Not IsNothing(oEmail) Then
If LIMIT_EMAIL_FROM Then
Dim oEmailFrom As String = ""
For Each m As MailBox In oEmail.From
oEmailFrom = m.Address
Next
If oEmailFrom <> Eml_Limitation_Sender Then
Logger.Debug($"Skipping email {oEmailFrom} ...Subject [{oEmail.Subject}]")
Continue For
End If
End If
If _workmail.WorkEmailMessage(oEmail, oUID) = True Then
If CURRENT_DEBUG_LOCAL_EMAIL = "" Then
EMAIL_DELETE()
End If
End If
Else
Logger.Info("### oEmail was nothing ###")
End If
CURRENT_MAIL_MESSAGE = Nothing
Next
If CURRENT_POLL_TYPE = "IMAP" And CURRENT_WORKMAIL_UID_LIST.Count > 0 Then
If Not IsNothing(CURRENT_ImapObject) Then
CURRENT_ImapObject.Close()
End If
End If
Catch ex As Exception
Logger.Error(ex)
Logger.Warn($"Unexpected Error working CURRENT_WORKMAIL_UID_LIST: {ex.Message} ")
End Try
End If
Else
Logger.Debug(String.Format("No emails for profile!"))
End If
Else
Logger.Warn("For the Email-Profile ID " & CURRENT_EMAIL_GUID & " no record could be found!")
End If
_Database.ExecuteNonQuery("UPDATE TBEMLP_POLL_PROFILES SET LAST_TICK = GETDATE() WHERE GUID = " & oDR_Profile.Item("GUID").ToString)
Else
Logger.Warn("For the Email-Profile ID " & CURRENT_EMAIL_GUID & " no record could be found! Check wether Email-Profile is active!")
End If
Next
Try
'Delete all Tempfiles
For Each _file In TEMP_FILES
Logger.Debug("Trying to delete temp file: [{0}]", _file)
If System.IO.File.Exists(_file) Then
Try
System.IO.File.Delete(_file)
Catch ex As Exception
Logger.Error(ex)
Logger.Warn($"TempFileDelete - Could not delete the tempfile from TEMP_FILES: {ex.Message}")
End Try
End If
Next
Catch ex As Exception
Logger.Warn($"TempFileDelete(X) - Could not delete the tempfile from TEMP_FILES: {ex.Message}")
End Try
Else
Logger.Info("No active profiles")
End If
End If
_Database.ExecuteNonQuery("UPDATE TBEMLP_CONFIG SET LAST_TICK = GETDATE() WHERE GUID = 1")
End If
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
Private Function EMAIL_DELETE()
If DeleteMail = True And MessageError = False Then
If Not IsNothing(CURRENT_ImapObject) Then
CURRENT_ImapObject.DeleteMessageByUID(CURRENT_MAIL_UID)
Else
Logger.Warn("EMAIL_DELETE - CURRENT_ImapObject is nothing")
End If
Else
If MessageError = True Then
Logger.Warn($"Did not delete Message with UID [{CURRENT_MAIL_UID}] as there was an MessageError!")
End If
End If
End Function
End Class

5
App/EmailProfiler.Common/packages.config Normal file
View File

@@ -0,0 +1,5 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="AE.Net.Mail" version="1.7.10.0" targetFramework="net461" />
<package id="NLog" version="5.0.5" targetFramework="net461" />
</packages>