MS ClassWM Resulthandler

This commit is contained in:
Digital Data - Marlon Schreiber
2018-08-10 11:34:38 +02:00
parent fadc882ba9
commit 5ff1bec8cc
96 changed files with 183537 additions and 3996 deletions

View File

@@ -0,0 +1,25 @@
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 15
VisualStudioVersion = 15.0.27703.2018
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "ClassWMResulthandler", "ClassWMResulthandler.vbproj", "{B3190AEC-8DC4-4822-9609-54DF5B976262}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{B3190AEC-8DC4-4822-9609-54DF5B976262}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{B3190AEC-8DC4-4822-9609-54DF5B976262}.Debug|Any CPU.Build.0 = Debug|Any CPU
{B3190AEC-8DC4-4822-9609-54DF5B976262}.Release|Any CPU.ActiveCfg = Release|Any CPU
{B3190AEC-8DC4-4822-9609-54DF5B976262}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {9F81EACD-22B7-4784-988F-84ACC0F92626}
EndGlobalSection
EndGlobal

View File

@@ -0,0 +1,134 @@
<?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>{B3190AEC-8DC4-4822-9609-54DF5B976262}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>ClassWMResulthandler</RootNamespace>
<AssemblyName>ClassWMResulthandler</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>ClassWMResulthandler.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>ClassWMResulthandler.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="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="Interop.WMOTOOLLib">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\windream\Interop.WMOTOOLLib.dll</HintPath>
<EmbedInteropTypes>True</EmbedInteropTypes>
</Reference>
<Reference Include="Newtonsoft.Json, Version=11.0.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL">
<HintPath>..\packages\Newtonsoft.Json.11.0.2\lib\net45\Newtonsoft.Json.dll</HintPath>
</Reference>
<Reference Include="Oracle.ManagedDataAccess">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\Oracle.ManagedDataAccess.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.Data" />
<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="clsCURRENT.vb" />
<Compile Include="clsDatabase.vb" />
<Compile Include="clsDateiverarbeitung.vb" />
<Compile Include="clsEmail.vb" />
<Compile Include="clsEncryption.vb" />
<Compile Include="clsLogger.vb" />
<Compile Include="clsProfil.vb" />
<Compile Include="clsWindream_Allgemein.vb" />
<Compile Include="clsWindream_Index.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</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="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>

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

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>

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("ClassWMResulthandler")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("ClassWMResulthandler")>
<Assembly: AssemblyCopyright("Copyright © 2018")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
'Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird.
<Assembly: Guid("53df625c-d953-406f-8d5f-1c284b9d01f7")>
' 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("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

View File

@@ -0,0 +1,62 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My.Resources
'This class was auto-generated by the StronglyTypedResourceBuilder
'class via a tool like ResGen or Visual Studio.
'To add or remove a member, edit your .ResX file then rerun ResGen
'with the /str option, or rebuild your VS project.
'''<summary>
''' A strongly-typed resource class, for looking up localized strings, etc.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "4.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>
''' Returns the cached ResourceManager instance used by this class.
'''</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("ClassWMResulthandler.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Overrides the current thread's CurrentUICulture property for all
''' resource lookups using this strongly typed resource class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set(ByVal value As Global.System.Globalization.CultureInfo)
resourceCulture = value
End Set
End Property
End Module
End Namespace

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>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </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", "11.0.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 "My.Settings Auto-Save Functionality"
#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(ByVal sender As Global.System.Object, ByVal 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.ClassWMResulthandler.My.MySettings
Get
Return Global.ClassWMResulthandler.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

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

View File

@@ -0,0 +1,13 @@
Public Class clsCURRENT
Public Shared EXPORTED_FILENAME As String
Public Shared WDLAUFWERK, _profObjekttyp, _profwdSuche, _profDay, _profRunType, _Profilname As String
Public Shared SQLSERVER_CS As String = ""
Public Shared LOG_ERRORS_ONLY As Boolean = True
Public Shared ARR_Exported_Files() = Nothing
Public Shared DT_TBWMRH_KONFIGURATION As DataTable = Nothing
Public Shared DT_TBDD_EMAIL As DataTable = Nothing
Public Shared CONCATTED_FILE As String = ""
Public Shared _PROFIL_ID, _profGUID As Integer
Public Shared _proflastRun As Date
End Class

View File

@@ -0,0 +1,354 @@
Imports System.Data.SqlClient
Imports Oracle.ManagedDataAccess.Client
Public Class clsDatatabase
Private Shared MSSQL_inited As Boolean = False
Public Shared Function Init(CONSTRING As String)
Try
Dim SQLconnect As New SqlClient.SqlConnection
SQLconnect.ConnectionString = CONSTRING
SQLconnect.Open()
SQLconnect.Close()
clsCURRENT.SQLSERVER_CS = CONSTRING
MSSQL_inited = True
clsCURRENT.DT_TBWMRH_KONFIGURATION = clsDatatabase.Return_Datatable("SELECT * FROM TBWMRH_KONFIGURATION WHERE GUID = 1")
If clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows.Count = 1 Then
clsCURRENT.LOG_ERRORS_ONLY = CBool(clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows(0).Item("LOG_ERRORS_ONLY"))
clsCURRENT.WDLAUFWERK = clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows(0).Item("WD_LAUFWERK")
End If
Return True
Catch ex As Exception
clsLogger.Add("Error in DatabaseInit: " & ex.Message, True)
Return False
End Try
End Function
Public Shared Function ExecuteonOracleDb(CONSTRING As String, ByVal plsqlcommand As String)
Try
' die nötigen Variablen definieren
Dim result As Object = Nothing
Dim conn As New OracleConnectionStringBuilder
Dim Oracle_Conn As OracleConnection = New OracleConnection(CONSTRING)
Dim Oracle_Command As OracleCommand = Nothing
Dim DataAdapter As OracleDataAdapter = Nothing
' Verbindung zur Datenbank aufbauen
Try
Oracle_Conn.Open()
Catch ex As Exception
clsLogger.Add(ex.Message, True, "clsDatatabase.ExecuteonOracleDb(OpenConnection)")
Return False
End Try
' SQL-Abfrage definieren
Try
Oracle_Command = New OracleCommand(plsqlcommand, Oracle_Conn)
Oracle_Command.AddToStatementCache = True
Catch ex As Exception
clsLogger.Add(ex.Message, True, "clsDatatabase.plsqlcommandDefine")
Oracle_Conn.Close()
Return False
End Try
' *** Ausführen des Command ***
If Command() IsNot Nothing Then
Try
clsLogger.AddDetailLog("Now executing: " & plsqlcommand)
Oracle_Command.ExecuteNonQuery()
' DB-Connection schliessen
Oracle_Conn.Close()
Return True
Catch ex As Exception
clsLogger.Add(ex.Message & vbNewLine & "Execute Command => (" & plsqlcommand & ")", True, "clsDatatabase.ExecuteonOracleDb")
Oracle_Conn.Close()
Return False
End Try
Else
' kann eintreten, wenn entweder die SQL-Anweisung falsch ist oder wenn die DataConnection nicht richtig aufgebaut werden konnte
' Eintrag in Logdatei machen
clsLogger.Add("SQL-Command ist ungültig bzw konnte nicht erstellt werden (SQL: " & plsqlcommand & ")", True, "clsDatatabase.ExecuteonOracleDb")
Return False
End If
Catch ex As Exception
clsLogger.Add("Unexpected Error in ExecuteonOracleDb: " & ex.Message & vbNewLine & "SQL: " & plsqlcommand, True, "clsDatatabase.ExecuteonOracleDb")
' an dieser Stelle sollte jeder unvorhergesehene Fehler der Funktion abgefangen werden
Return False
End Try
End Function
Public Shared Function Oracle_CS_Test(CONSTRING As String)
Try
Dim conn As New OracleConnectionStringBuilder
Dim Oracle_Conn As OracleConnection = New OracleConnection(CONSTRING)
' Verbindung zur Datenbank aufbauen
Try
Oracle_Conn.Open()
Catch ex As Exception
clsLogger.Add(ex.Message, True, "clsDatatabase.Oracle_CS_Test(OpenConnection)")
Return False
End Try
Oracle_Conn.Close()
Return True
Catch ex As Exception
clsLogger.Add("Unexpected Error in Oracle_CS_Test: " & ex.Message, True, "clsDatatabase.Oracle_CS_Test")
' an dieser Stelle sollte jeder unvorhergesehene Fehler der Funktion abgefangen werden
Return False
End Try
End Function
Public Shared Function MSSQL_CS_Test(CONSTRING As String)
Try
' die nötigen Variablen definieren
Dim Connection As SqlConnection = Nothing
' Verbindung zur Datenbank aufbauen
Try
Connection = New SqlConnection(CONSTRING)
Connection.Open()
Catch ex As Exception
clsLogger.Add(ex.Message, True, "clsDatatabase.MSSQL_CS_Test(OpenConnection)")
Return False
End Try
Connection.Close()
Return True
Catch ex As Exception
' an dieser Stelle sollte jeder unvorhergesehene Fehler der Funktion abgefangen werden
clsLogger.Add("UNEXPECTED ERROR: " & ex.Message, True, "clsDatatabase.MSSQL_CS_Test")
Return False
End Try
End Function
Public Shared Function ExecuteonMSSQL(ConString As String, ByVal sqlcommand As String)
Try
If MSSQL_inited = False Then Return False
' die nötigen Variablen definieren
Dim Connection As SqlConnection = Nothing
' Dim ConnectionString As SqlConnectionStringBuilder = Nothing
Dim Command As SqlCommand = Nothing
Dim DataAdapter As SqlDataAdapter = Nothing
'' ConnectionString aufbauen (aus Settings auslesen)
'ConnectionString = New SqlConnectionStringBuilder()
'ConnectionString.DataSource = datasource
'ConnectionString.UserID = User
'ConnectionString.Password = pw
'ConnectionString.InitialCatalog = init_Cata
' Verbindung zur Datenbank aufbauen
Try
Connection = New SqlConnection(ConString)
Connection.Open()
Catch ex As Exception
clsLogger.Add(ex.Message, True, "clsDatatabase.ExecuteonMSSQL(OpenConnection)")
Return False
End Try
' SQL-Abfrage definieren
Try
Command = New SqlCommand(sqlcommand, Connection)
Catch ex As Exception
clsLogger.Add(ex.Message, True, "clsDatatabase.ExecuteonMSSQL(DefineCommand)")
Return False
Connection.Close()
End Try
' *** Ausführen des Command ***
If Command IsNot Nothing Then
Try
Command.ExecuteNonQuery()
' DB-Connection schliessen
Connection.Close()
Return True
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei erzeugen
clsLogger.Add(ex.Message, True, "clsDatatabase.ExecuteonMSSQL(ExecuteCommand)")
Return False
Connection.Close()
End Try
Else
' kann eintreten, wenn entweder die SQL-Anweisung falsch ist oder wenn die DataConnection nicht richtig aufgebaut werden konnte
' Eintrag in Logdatei machen
clsLogger.Add("Could not create COMMAND", True, "clsDatatabase.ExecuteonMSSQL")
Return False
Connection.Close()
End If
Catch ex As Exception
' an dieser Stelle sollte jeder unvorhergesehene Fehler der Funktion abgefangen werden
clsLogger.Add("UNEXPECTED ERROR: " & ex.Message, True, "clsDatatabase.ExecuteonMSSQL")
Return False
End Try
End Function
Public Shared Function Return_Datatable(Select_anweisung As String)
Try
If MSSQL_inited = False Then Return Nothing
Dim SQLconnect As New SqlClient.SqlConnection
Dim SQLcommand As SqlClient.SqlCommand
SQLconnect.ConnectionString = clsCURRENT.SQLSERVER_CS
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
SQLcommand.CommandText = Select_anweisung
SQLcommand.CommandTimeout = 180
Dim adapter1 As SqlClient.SqlDataAdapter = New SqlClient.SqlDataAdapter(SQLcommand)
Dim dt As DataTable = New DataTable()
adapter1.Fill(dt)
SQLconnect.Close()
Return dt
Catch ex As Exception
clsLogger.Add("Error in Return_Datatable: " & ex.Message, True)
clsLogger.Add(">> SQL: " & Select_anweisung, False)
Return Nothing
End Try
End Function
Public Shared Function Execute_non_Query(ExecuteCMD As String)
If MSSQL_inited = False Then Return False
Try
Dim SQLconnect As New SqlClient.SqlConnection
Dim SQLcommand As SqlClient.SqlCommand
SQLconnect.ConnectionString = clsCURRENT.SQLSERVER_CS
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
'Update Last Created Record in Foo
SQLcommand.CommandText = ExecuteCMD
SQLcommand.CommandTimeout = 120
SQLcommand.ExecuteNonQuery()
SQLcommand.Dispose()
SQLconnect.Close()
Return True
Catch ex As Exception
clsLogger.Add("Error in Execute_non_Query: " & ex.Message, True)
clsLogger.Add("SQL: " & ExecuteCMD, False)
Return False
End Try
End Function
Public Shared Function Execute_Scalar(cmdscalar As String)
If MSSQL_inited = False Then Return Nothing
Dim result
Try
Dim SQLconnect As New SqlClient.SqlConnection
Dim SQLcommand As SqlClient.SqlCommand
SQLconnect.ConnectionString = clsCURRENT.SQLSERVER_CS
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
'Update Last Created Record in Foo
SQLcommand.CommandText = cmdscalar
SQLcommand.CommandTimeout = 120
result = SQLcommand.ExecuteScalar()
SQLcommand.Dispose()
SQLconnect.Close()
Return result
Catch ex As Exception
clsLogger.Add("Error in Execute_Scalar: " & ex.Message, True)
clsLogger.Add("SQL: " & cmdscalar, False)
Return Nothing
End Try
End Function
Public Shared Function OracleExecute_Scalar(cmdscalar As String, OracleConnection As String)
Dim result
Try
Dim SQLconnect As New OracleConnection
Dim SQLcommand As New OracleCommand
SQLconnect.ConnectionString = OracleConnection
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
'Update Last Created Record in Foo
SQLcommand.CommandText = cmdscalar
result = SQLcommand.ExecuteScalar()
SQLcommand.Dispose()
SQLconnect.Close()
Return result
Catch ex As Exception
clsLogger.Add("Error in OracleExecute_Scalar: " & ex.Message, True)
clsLogger.Add("#SQL: " & cmdscalar, False)
Return Nothing
End Try
End Function
Public Shared Function OracleExecute_non_Query(ExecuteCMD As String, OracleConnection As String, Optional userInput As Boolean = False)
Try
Dim SQLconnect As New OracleConnection
Dim SQLcommand As OracleCommand
SQLconnect.ConnectionString = OracleConnection
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
'Update Last Created Record in Foo
SQLcommand.CommandText = ExecuteCMD
SQLcommand.ExecuteNonQuery()
SQLcommand.Dispose()
SQLconnect.Close()
Return True
Catch ex As Exception
clsLogger.Add("Error in OracleExecute_non_Query: " & ex.Message, True)
clsLogger.Add("#SQL: " & ExecuteCMD, False)
Return False
End Try
End Function
Public Shared Function Oracle_Return_Datatable(Select_anweisung As String, OracleConnection As String, Optional userInput As Boolean = False)
Try
Dim SQLconnect As New OracleConnection
Dim SQLcommand As OracleCommand
SQLconnect.ConnectionString = OracleConnection
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
SQLcommand.CommandText = Select_anweisung
Dim adapter1 As OracleDataAdapter = New OracleDataAdapter(SQLcommand)
Dim dt As DataTable = New DataTable()
adapter1.Fill(dt)
SQLconnect.Close()
Return dt
Catch ex As Exception
clsLogger.Add("Error in Oracle_Return_Datatable: " & ex.Message, True)
clsLogger.Add("#SQL: " & Select_anweisung, False)
Return Nothing
End Try
End Function
End Class

View File

@@ -0,0 +1,430 @@
Imports WINDREAMLib
Imports System.IO
Imports System.Net
Imports Newtonsoft.Json
Imports System.Text
Public Class clsDateiverarbeitung
#Region "***** Variablen und Konstanten*****"
Public Shared _windream As New clsWindream_allgemein
Public Shared pr_DTPROFIL_REGELN As DataTable
Public Shared aktfile_Exportresult
Public Shared CriticalError As Boolean = False
Private Shared regel_TYP, regel_INDEX_NAME, regel_QUELLE1, regel_FROM1, regel_FROM2 As String
Private Shared Indexe() As String = Nothing ' zum Speichern der Indexe
Private Shared NI_Values() As String = Nothing ' zum Speichern der Werte
Private Shared WD_aktivesDokument As WMObject
Const WMObjectStreamOpenModeReadWrite = 2
Const WMObjectEditModeFileSystem = &H15
#End Region
Public Shared Function InitProfilData()
Try
pr_DTPROFIL_REGELN = Nothing
' Profildaten der Klasse mitteilen
clsLogger.AddDetailLog("InitProfilData Profildaten zugewiesen....")
Return True
Catch ex As Exception
clsLogger.AddError(ex.Message, "cls_DV.InitProfilData")
Return False
End Try
End Function
'Kopiert die übergebene Datei in den Zielpfad
Public Shared Function Export_File(WDDatei As WMObject, Zielpfad As String)
Try
If Not Zielpfad.EndsWith("\") Then
Zielpfad = Zielpfad & "\"
End If
clsLogger.Add("", False)
clsLogger.Add(">> Verarbeitung von Datei: " & WDDatei.aName, False)
'Die Quelle zusammensetzen
clsLogger.AddDetailLog("PFAD: " & clsCURRENT.WDLAUFWERK & ":" & WDDatei.aPath & "\" & WDDatei.aName)
'Dim Quelle As String = IO.Path.GetDirectoryName(WDLaufwerk & ":" & WDDatei.aPath & "\" & WDDatei.aName)
Dim ExportFileIO = New WMOTOOLLib.WMFileIO ' CreateObject("WMOTOOLLib.WMFileIO") ' New WMOTOOLLib.WMFileIO
clsLogger.AddDetailLog("ExportFileIO erzeugt.....")
' Stream Interface bereitstellen
WDDatei.LockFor(WMObjectEditModeFileSystem)
Try
If Not WDDatei.aLocked Then
WDDatei.lock()
End If
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler beim Lock-Vorgang: " & ex.Message, "clsDV.Export_File")
Return False
End Try
Dim oWMStream = WDDatei.OpenStream("BinaryObject", WMObjectStreamOpenModeReadWrite)
'### VERSIONIERUNG ###
Dim version As Integer = 2
'Dim Stammname As String = System.IO.Path.GetFileNameWithoutExtension(Quelle)
Dim Filename = WDDatei.aName.Substring(0, WDDatei.aName.LastIndexOf("."))
Dim Extension = WDDatei.aName.Substring(WDDatei.aName.LastIndexOf("."))
Dim tempFilename As String = Zielpfad & Filename & Extension
'Überprüfen ob File existiert
Do While IO.File.Exists(tempFilename) = True
tempFilename = Zielpfad & Filename & "_" & version & Extension
version = version + 1
Loop
clsLogger.AddDetailLog("Zieldateiname: " & tempFilename)
' den Dateiinhalt der neuen Datei zuweisen
ExportFileIO.aWMStream = oWMStream
ExportFileIO.bstrOriginalFileName = tempFilename
'Das eigentliche kopieren
ExportFileIO.ExportOriginal(True)
' close the windream file stream
oWMStream.Close()
WDDatei.Save()
WDDatei.unlock()
clsCURRENT.EXPORTED_FILENAME = tempFilename
clsLogger.Add(">> Datei erfolgreich nach '" & tempFilename & "' verschoben.", False, "clsDV Export_File")
aktfile_Exportresult = tempFilename
Return True
Catch ex As Exception
'bei einem Fehler einen Eintrag in der Logdatei machen
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsDV.Export_File")
Return False
End Try
End Function
Public Shared Function Rename_File(WMFile As WMObject, konvention As String)
Try
clsLogger.AddDetailLog("Konvention: '" & konvention & "'")
'Regulären Ausdruck zum Auslesen der windream-Indexe definieren
Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
' einen Regulären Ausdruck laden
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg)
' die Vorkommen im SQL-String auslesen
Dim reg_elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(konvention)
Dim i As Integer = 0
' alle Vorkommen der windream-Indexe im SQL-String durchlaufen
For Each reg_element As System.Text.RegularExpressions.Match In reg_elemente
'die Zeichen [% und ] entfernen (liefert den wirklichen windream-Index)
Dim reg_element_Ohne_SZ As String = reg_element.Value.Replace("[%", "")
reg_element_Ohne_SZ = reg_element_Ohne_SZ.Replace("]", "")
clsLogger.AddDetailLog("Indexwert aus Index '" & reg_element_Ohne_SZ & "' auslesen....")
Dim wdIndexwert
'den Wert des Indexes für das aktuelle Dokument auslesen
wdIndexwert = WMFile.GetVariableValue(reg_element_Ohne_SZ)
If wdIndexwert Is Nothing = False Then
If Not wdIndexwert.GetType.ToString.Contains("System.Object") Then
clsLogger.AddDetailLog("Namenkonvention (" & i & ") " & konvention)
wdIndexwert = wdIndexwert.ToString.TrimEnd
wdIndexwert = wdIndexwert.ToString.TrimStart
clsLogger.AddDetailLog("Ausgelesener Indexwert = '" & wdIndexwert & "'")
konvention = konvention.Replace(reg_element.Value, wdIndexwert.ToString)
i += 1
Else
clsLogger.Add(">> Achtung gelesener Wert ist ein Vektorfeld - keine Umbenennung möglich ", False, "clsProfil.Profil_Durchlauf")
End If
End If
Next
Dim version As Integer = 2
Dim ZielPfad As String = Path.GetDirectoryName(aktfile_Exportresult)
clsLogger.AddDetailLog("ZielPfad: " & ZielPfad)
Dim Filename = konvention
Dim Extension = Path.GetExtension(aktfile_Exportresult)
clsLogger.AddDetailLog("Extension: " & Extension)
Dim tempFilename As String = ZielPfad & "\" & Filename & Extension
clsLogger.AddDetailLog("tempFilename: " & tempFilename)
'Überprüfen ob File existiert
Do While IO.File.Exists(tempFilename) = True
tempFilename = ZielPfad & "\" & Filename & "~" & version & Extension
version += 1
Loop
clsLogger.AddDetailLog("RenameFile - OLDFilename: " & aktfile_Exportresult & " - NEWFilename: " & Path.GetFileName(tempFilename))
My.Computer.FileSystem.RenameFile(aktfile_Exportresult, Path.GetFileName(tempFilename))
clsLogger.Add(">> Datei wurde erfolgreich umbenannt.", False, "clsProfil.RenameFile")
Return True
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.RenameFile")
Return False
End Try
End Function
Public Shared Function Rename_File_Vektor(WMFile As WMObject, WMINDEX_NAME As String)
Try
Dim WMIndexwert
Dim ZielPfad As String = Path.GetDirectoryName(aktfile_Exportresult)
clsLogger.AddDetailLog("ZielPfad: " & ZielPfad)
Dim Extension = Path.GetExtension(aktfile_Exportresult)
clsLogger.AddDetailLog("Extension: " & Extension)
If WMINDEX_NAME.StartsWith("[%") Then
WMINDEX_NAME = WMINDEX_NAME.Replace("[%", "")
WMINDEX_NAME = WMINDEX_NAME.Replace("]", "")
End If
'den Wert des Indexes für das aktuelle Dokument auslesen
WMIndexwert = WMFile.GetVariableValue(WMINDEX_NAME)
If WMIndexwert.GetType.ToString.Contains("System.Object") Then
clsLogger.AddDetailLog("Rename_File_Vektor in Progress for index " & WMINDEX_NAME)
Dim anz As Integer = 1
Dim copybasefile As String
For Each WMvalue As Object In WMIndexwert
'Für jeden Value eine Datei erzeugen
Try
If WMvalue.ToString <> String.Empty Then
Dim tempFilename As String = ZielPfad & "\" & WMvalue & Extension
clsLogger.AddDetailLog("tempFilename: " & tempFilename)
If anz = 1 Then
clsLogger.AddDetailLog("RenameFile - OLDFilename: " & aktfile_Exportresult & " - NEWFilename: " & Path.GetFileName(tempFilename))
My.Computer.FileSystem.RenameFile(aktfile_Exportresult, Path.GetFileName(tempFilename))
copybasefile = tempFilename
Else
Dim version As Integer = 2
'Überprüfen ob File existiert
Do While IO.File.Exists(tempFilename) = True
tempFilename = ZielPfad & "\" & WMvalue & "~" & version & Extension
version += 1
Loop
File.Copy(copybasefile, tempFilename, True)
End If
anz += 1
End If
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsDateiverarbeitung.ForEachWMvalue")
End Try
Next
Else
clsLogger.Add(">> Achtung WMIndex " & WMINDEX_NAME & " scheint kein Vektorfeld zu sein!", False, "clsDateiverarbeitung.Rename_File_Vektor")
Return False
End If
clsLogger.Add(">> Dateien wurde erfolgreich nach Vektorfeld erzeugt.", False, "clsDateiverarbeitung.Rename_File_Vektor")
Return True
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsDateiverarbeitung.Rename_File_Vektor")
End Try
End Function
Private Shared Function GetWMAPILink(docId As String, userId As String)
Dim hostname = "http://documents.mylogitservices.syncreon.com:8100"
Dim link As String = $"{hostname}/WMWebApi/windream.web.api/DigitalData/BNSDownload?docId={docId}&userId={userId}"
Return link
End Function
Private Shared Function GetDocTypeCategory(docType As String)
Select Case docType
Case "Abliefernachweis"
Return 5
Case "Begleitdokument"
Return 6
Case Else
Return 0
End Select
End Function
''' <summary>
''' Generiert einen Link für BNS und fügt das Dokument WMFile
''' ins BNS ein
''' </summary>
''' <param name="WMFile">Das WMObject, dass das aktuelle Dokument repräsentiert</param>
''' <param name="userId">Die eindeutige Benutzer Kennung für die Authentifizierung in Windream</param>
Public Shared Function BNSjsonDownload(WMFile As WMObject, userId As String, apiAddress As String)
Try
' Indizes für das aktuelle Dokument auslesen
Dim SENDUNGNR = WMFile.GetVariableValue("Sendungnr")
Dim DOKID = WMFile.GetVariableValue("Dokument-ID")
Dim DOKART = WMFile.GetVariableValue("Dokumentart")
Dim now As DateTime = DateTime.Now
' Download Link für Dokument erstellen
Dim link As String = GetWMAPILink(DOKID, userId)
' JSON Payload erstellen und serialisieren
Dim doc As New BNSDocument()
doc.Bemerkung = DOKART
'Dokumente sollen unbegrenzt gültig sein
'doc.Ivalidfrom = now
'doc.Ivaliduntil = now.AddDays(30)
doc.Pfad = link
doc.Dateiname = WMFile.aName
doc.Kategorien = New List(Of BNSDocumentCategory) From {
New BNSDocumentCategory With {.Id = GetDocTypeCategory(DOKART)}
}
Dim json As String = JsonConvert.SerializeObject(doc, Formatting.Indented)
Dim bytes As Byte() = Encoding.Default.GetBytes(json)
' HTTP Request machen
' Mandanten ID ist Standartmäßig 1
Dim mandatenId As Integer = 1
' Für Tests auf Sendung gesetzt, später sollte dieser String konfigurierbar sein
Dim geschaeftsObjekt = "Sendung"
' Für Tests wird hier die Sendungsnummer verwendet, später hängt der verwendete Index von 'geschaeftsObjekt' ab
Dim geschaeftsId = SENDUNGNR
Dim url As String = $"http://{apiAddress}/onwebui/api/Customer/{mandatenId}/{geschaeftsObjekt}/{geschaeftsId}/dokument"
clsLogger.Add($">> Generiertes JSON: {json}", False, "BNSjsonDownload")
clsLogger.Add($">> Creating WebRequest for {url}", False, "BNSjsonDownload")
Dim req As HttpWebRequest = WebRequest.CreateHttp(url)
req.Method = "POST"
req.ContentType = "application/json"
req.ContentLength = bytes.Length
req.Timeout = 3000
req.ServicePoint.Expect100Continue = False
Dim reqStream As Stream = req.GetRequestStream()
reqStream.Write(bytes, 0, bytes.Length)
reqStream.Close()
clsLogger.Add($">> Datei wird hochgeladen... docId: {DOKID}, dokart: {DOKART}, userId: {userId}", False, "BNSjsonDownload")
clsLogger.Add($">> Upload URL: {url}", False, "BNSjsonDownload")
Using res As HttpWebResponse = req.GetResponse()
Dim code As HttpStatusCode = res.StatusCode
Dim text As String = res.StatusDescription
' Status 201 Created bedeutet: Alles okay!
If code = HttpStatusCode.Created Then
clsLogger.Add($">> Datei geschrieben! docId: {DOKID}, dokart: {DOKART}, userId: {userId}", False, "BNSjsonDownload")
Else
Throw New Exception($"Server Error (HTTP {code}: {text})")
End If
End Using
Return True
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message & " - " & ex.Source, "BNSjsonDownload")
Return True
End Try
End Function
Public Shared Function RUN_ORACLE_COMMAND(WMFile As WMObject, OracleCS As String, OracleCommandRAW As String)
Try
Dim result = REGEX_REPLACE(WMFile, OracleCommandRAW)
If result = Nothing Then
Return False
End If
If clsDatatabase.ExecuteonOracleDb(OracleCS, result) = True Then
Return True
Else
Return False
End If
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "RUN_ORACLE_COMMAND")
Return False
End Try
End Function
Public Shared Function RUN_MSSQL_COMMAND(WMFile As WMObject, MSSQLCS As String, SQLCommandRAW As String)
Try
Dim result = REGEX_REPLACE(WMFile, SQLCommandRAW)
If result = Nothing Then
Return False
End If
If clsDatatabase.ExecuteonMSSQL(MSSQLCS, result) = True Then
Return True
Else
Return False
End If
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "RUN_MSSQL_COMMAND")
Return False
End Try
End Function
Public Shared Function REGEX_REPLACE(WMFile As WMObject, _STRING As String)
Try
clsLogger.AddDetailLog("REGEX_String before replacing: '" & _STRING & "'")
' Regulären Ausdruck zum Auslesen der windream-Indexe definieren
Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
' einen Regulären Ausdruck laden
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg)
' die Vorkommen im SQL-String auslesen
Dim reg_elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(_STRING)
Dim i As Integer = 0
' alle Vorkommen der windream-Indexe im SQL-String durchlaufen
For Each reg_element As System.Text.RegularExpressions.Match In reg_elemente
' die Zeichen [% und ] entfernen (liefert den wirklichen windream-Index)
Dim reg_element_Ohne_SZ As String = reg_element.Value.Replace("[%", "")
reg_element_Ohne_SZ = reg_element_Ohne_SZ.Replace("]", "")
clsLogger.AddDetailLog("read indexvalue from index '" & reg_element_Ohne_SZ & "'....")
If reg_element_Ohne_SZ = "EXPORTED_FILENAME" Then
If clsCURRENT.EXPORTED_FILENAME <> "" Then
_STRING = _STRING.Replace(reg_element.Value, clsCURRENT.EXPORTED_FILENAME)
End If
ElseIf reg_element_Ohne_SZ = "ENV_USERNAME" Then
_STRING = _STRING.Replace(reg_element.Value, Environment.UserName)
Else
Dim wdIndexwert
' den Wert des Indexes für das aktuelle Dokument auslesen
wdIndexwert = WMFile.GetVariableValue(reg_element_Ohne_SZ)
If wdIndexwert Is Nothing = False Then
If Not wdIndexwert.GetType.ToString.Contains("System.Object") Then
wdIndexwert = wdIndexwert.ToString.TrimEnd
wdIndexwert = wdIndexwert.ToString.TrimStart
clsLogger.AddDetailLog("indexvalue read is: '" & wdIndexwert & "'")
_STRING = _STRING.Replace(reg_element.Value, wdIndexwert.ToString)
clsLogger.AddDetailLog("REGEX_String (" & i & ") " & _STRING)
i += 1
Else
clsLogger.Add(">> Attention: WMIndex is an vectorfield - seperation of values via ;", False, "clsDateiverarbeitung.REGEX_REPLACE")
clsLogger.AddDetailLog("wdIndexValue is System.Object....")
clsLogger.AddDetailLog("trying to seperate via ,....")
Dim vector_result As String = ""
For Each WMvalue As Object In wdIndexwert
Dim x As Integer = 0
If WMvalue.ToString <> String.Empty Then
WMvalue = WMvalue.ToString.TrimEnd
WMvalue = WMvalue.ToString.TrimStart
If vector_result = "" Then
vector_result = WMvalue
Else
vector_result = vector_result & ";" & WMvalue
End If
x += 1
End If
Next
_STRING = _STRING.Replace(reg_element.Value, vector_result.ToString)
clsLogger.AddDetailLog("REGEX_String after vector-for-each (" & i & ") " & _STRING)
End If
Else
clsLogger.Add(">> Attention: Indexvalue is NOTHING, standardvalue '0' will be used", False, "clsDateiverarbeitung.REGEX_REPLACE")
_STRING = _STRING.Replace(reg_element.Value, "0")
End If
End If
Next
Return _STRING
Catch ex As Exception
clsLogger.AddError("Unexpected error: " & ex.Message, "REGEX_REPLACE")
Return Nothing
End Try
End Function
Public Class BNSDocument
Public Doksourcetype As Integer = 3
Public Pfad As String
'Dokumente sollen unbegrenzt gültig sein
'Public Ivalidfrom As DateTime
'Public Ivaliduntil As DateTime
Public Bemerkung As String
Public Primaer As Boolean = False
Public Fremsysid As Integer = 1
Public Kategorien As List(Of BNSDocumentCategory)
Public Dateiname As String
End Class
Public Class BNSDocumentCategory
Public Id As Integer
End Class
End Class

View File

@@ -0,0 +1,90 @@
Imports System.Net.Mail
Public Class clsEmail
Private Shared MailAktiv As Boolean = False
'Public Shared Function Init()
' Try
' Dim DT As DataTable = clsDatatabase.Return_Datatable("select * from TBDD_EMAIL_ACCOUNT where ACTIVE = 1")
' If DT.Rows.Count = 1 Then
' For Each row As DataRow In DT.Rows
' MailFrom = row.Item("EMAIL_ABS")
' MAilSMTP = row.Item("EMAIL_SMTP")
' MailSSL = row.Item("EMAIL_SSL")
' MailUser = row.Item("EMAIL_USER")
' MailUser_PW = row.Item("EMAIL_USER_PW")
' MailAktiv = True
' Exit For
' Next
' Else
' MailAktiv = False
' End If
' Return True
' Catch ex As Exception
' clsLogger.Add(ex.Message, True, "clsEmail.Init")
' Return False
' End Try
' End Function
Public Shared Function Send_EMail(ByVal MailBetreff As String, ByVal vBody As String, MailEmpfaenger As String, MailFrom As String, MAilSMTP As String, MailUser As String, MailUser_PW As String, SSL As Boolean,
Optional attment As String = "", Optional test As Boolean = False)
'#### E-MAIL NACHRICHT VERSENDEN
Try
Dim empfaenger As String()
If MailEmpfaenger.Contains(";") Then
empfaenger = MailEmpfaenger.Split(";")
Else
ReDim Preserve empfaenger(0)
empfaenger(0) = MailEmpfaenger
End If
'Für jeden Empfänger eine Neue Mail erzeugen
For Each _mailempfaenger As String In empfaenger
'Neue Nachricht erzeugen:
Dim message As New MailMessage(MailFrom, _mailempfaenger, MailBetreff,
"<font face=""Arial"">" & vBody & "</font>") '& "<br>" &
'"<br>Domain: " & Environment.UserDomainName &
'"<br>Gesendet am: " & My.Computer.Clock.LocalTime.ToShortDateString & "-" &
'My.Computer.Clock.LocalTime.ToLongTimeString &
' create and add the attachment(s) */
If attment <> String.Empty Then
If System.IO.File.Exists(attment) Then
Dim Attachment As Attachment = New Attachment(attment)
message.Attachments.Add(Attachment)
End If
End If
With message
.IsBodyHtml = True
End With
'Einen SMTP Client erzeugen und Anmeldungsinformationen hinterlegen
Dim emailClient As New SmtpClient(MAilSMTP)
emailClient.EnableSsl = SSL
'Email mit Authentifizierung
Dim SMTPUserInfo As New System.Net.NetworkCredential(MailUser, MailUser_PW) ', My.Settings.vDomain)
emailClient.UseDefaultCredentials = False
emailClient.Credentials = SMTPUserInfo
emailClient.Port = 25
clsLogger.Add("==> Email erfolgreich an " & _mailempfaenger & " versendet!", False)
clsLogger.Add("==> Text: " & vBody, False)
clsLogger.Add("", False)
'*Send the message */
emailClient.Send(message)
If test = True Then
MsgBox("The testmail was send successfully", MsgBoxStyle.Information)
End If
Next
Return True
Catch ex As Exception
clsLogger.Add(ex.Message, True, "cls.SendEmail")
If test = True Then
MsgBox("Unexpected error in Send Testmail: " & ex.Message, MsgBoxStyle.Critical)
End If
Return False
End Try
End Function
End Class

View File

@@ -0,0 +1,72 @@
Imports System.Security.Cryptography
Public Class clsEncryption
Private TripleDes As New TripleDESCryptoServiceProvider
Sub New(ByVal key As String)
' 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
Return Nothing
End Try
End Function
End Class

View File

@@ -0,0 +1,166 @@
Imports System.IO
Public Class clsLogger
Private Shared LogPath As String
Public Shared LogFilename As String
Private Shared logErr_name As String
Private Shared log_string As String
Private Shared Inited As Boolean = False
Public Shared Function Init(ByVal speicherort As String, ByVal prefix As String)
Try
'Den Speicherort festlegen
SetSpeicherort()
Dim logf_name As String = LogPath & "\" & System.DateTime.Now.ToString("yyyy_MM_dd") & prefix & ".txt"
logErr_name = LogPath & "\" & "ErrorLog_" & System.DateTime.Now.ToString("yyyy_MM_dd") & ".txt"
Dim anz As Integer = 1
Do While File.Exists(logf_name)
Dim info As New FileInfo(logf_name)
Dim length As Long = info.Length
If length > 5000000 Then
logf_name = IO.Path.GetDirectoryName(logf_name)
logf_name = logf_name & "\" & prefix & System.DateTime.Now.ToString("yyyy_MM_dd") & "(" & anz.ToString & ").txt"
anz = anz + 1
Else
Exit Do
End If
Loop
LogFilename = logf_name
Try
'Veruch das Log zu öffnen
Dim fs As FileStream = New FileStream(LogFilename, FileMode.OpenOrCreate, FileAccess.Write)
' --- Stream öffnen
Dim w As StreamWriter = New StreamWriter(fs)
' --- Anfügen am Ende
w.BaseStream.Seek(0, SeekOrigin.End)
' --- Zeilen schreiben
w.WriteLine(" ")
' --- Writer und Stream schließen
w.Close()
fs.Close()
Catch ex As Exception
LogEscalation_Error("The Logfile could not be created - Error: " & ex.Message)
Return False
End Try
'Alles Ok
Inited = True
Return True
Catch ex As Exception
LogEscalation_Error("Unexpected Error in init Logger - Error: " & ex.Message)
Return False
End Try
End Function
Private Shared Sub LogEscalation_Error(msg As String)
Try
'Veruch das Log zu öffnen
Dim fs As FileStream = New FileStream(logErr_name, FileMode.OpenOrCreate, FileAccess.Write)
' --- Stream öffnen
Dim w As StreamWriter = New StreamWriter(fs)
' --- Anfügen am Ende
w.BaseStream.Seek(0, SeekOrigin.End)
' --- Zeilen schreiben
w.WriteLine(msg)
' --- Writer und Stream schließen
w.Close()
fs.Close()
Catch ex As Exception
End Try
End Sub
' legt den Speicherort fest
Public Shared Sub SetSpeicherort()
Dim f As New IO.DirectoryInfo(My.Application.Info.DirectoryPath & "\Log")
If f.Exists = False Then
IO.Directory.CreateDirectory(My.Application.Info.DirectoryPath & "\Log")
End If
LogPath = My.Application.Info.DirectoryPath & "\Log\"
End Sub
Public Shared Sub Add(ByVal text As String, ByVal _error As Boolean, Optional ByVal Funktion As String = "")
If Inited = False Then
Exit Sub
End If
Dim msg As String
If log_string <> "" Then
log_string &= vbNewLine
End If
'Präfixe schreiben
If _error = True And Funktion <> "" Then
msg = ">> Achtung Fehler in Funktion '" & Funktion & "'" & vbNewLine & "Fehlermeldung: "
ElseIf _error = True Then
msg = ">> Achtung Fehler:" & vbNewLine & "Fehlermeldung: "
End If
'Präfix und Meldung zusammenstellen
msg &= text
log_string &= msg
End Sub
Public Shared Sub AddError(ByVal error_string As String, Optional ByVal Funktion As String = "")
If Inited = False Then
Exit Sub
End If
Try
'Zuerst mal die Details schreiben
WriteLog()
'Nun den eigentlichen Fehler loggen
Dim msg As String
'Präfixe schreiben
If Funktion <> "" Then
msg = ">> Achtung Fehler in Funktion '" & Funktion & "'" & vbNewLine & "Fehlermeldung: "
Else
msg = ">> Achtung Fehler:" & vbNewLine & "Fehlermeldung: "
End If
'Präfix und Meldung zusammenstellen
msg &= error_string
'Veruch das Log zu öffnen
Dim fs As FileStream = New FileStream(LogFilename, FileMode.OpenOrCreate, FileAccess.Write)
' --- Stream öffnen
Dim w As StreamWriter = New StreamWriter(fs)
' --- Anfügen am Ende
w.BaseStream.Seek(0, SeekOrigin.End)
' --- Zeilen schreiben
w.WriteLine(msg)
' --- Writer und Stream schließen
w.Close()
fs.Close()
Catch ex As Exception
LogEscalation_Error("Unexpected Error in AddError - Error: " & ex.Message)
End Try
End Sub
Public Shared Sub AddDetailLog(ByVal text As String)
If Inited = False Then
Exit Sub
End If
Try
If clsCURRENT.LOG_ERRORS_ONLY = False Then
If log_string <> "" Then
log_string &= vbNewLine
End If
log_string &= ">> " & text
End If
Catch ex As Exception
LogEscalation_Error("Unexpected Error in AddDetailLog - Error: " & ex.Message)
End Try
End Sub
Public Shared Sub WriteLog()
Try
'Veruch das Log zu öffnen
Dim fs As FileStream = New FileStream(LogFilename, FileMode.OpenOrCreate, FileAccess.Write)
' --- Stream öffnen
Dim w As StreamWriter = New StreamWriter(fs)
' --- Anfügen am Ende
w.BaseStream.Seek(0, SeekOrigin.End)
' --- Zeilen schreiben
w.WriteLine(log_string)
' --- Writer und Stream schließen
w.Close()
fs.Close()
SetSpeicherort()
'Den Meldungsstring wieder leeren
log_string = ""
Catch ex As Exception
LogEscalation_Error("Unexpected Error in WriteLog - Error: " & ex.Message)
End Try
End Sub
End Class

View File

@@ -0,0 +1,663 @@
Imports WINDREAMLib
Imports System.IO
Imports System.Text
Imports Newtonsoft.Json
Public Class clsProfil
Inherits clsCURRENT
#Region "***** Variablen *****"
Private Shared CriticalError As Boolean = False
Private Shared WD_aktivesDokument As WMObject
#End Region
Public Shared Function Init(guid As Integer)
Try
clsLogger.AddDetailLog("Start Initialisierung Profil für GUID: " & guid.ToString)
Dim DT As DataTable = clsDatatabase.Return_Datatable("Select * from TBWMRH_PROFIL where GUID = " & guid)
If DT.Rows.Count > 0 Then
For Each DR As DataRow In DT.Rows
clsCURRENT._profGUID = guid
_Profilname = CStr(DR.Item("Profilname"))
clsLogger.AddDetailLog("Check Profilname '" & _Profilname & "', GUID: " & _profGUID & " geladen")
' Überprüfen ob Profil aktiv oder inaktiv
If CBool(DR.Item("Aktiv")) = False Then
clsLogger.Add("## Profil '" & _Profilname & "' ist inaktiv geschaltet", False)
clsLogger.Add("", False)
Return False
Else
_profObjekttyp = CStr(DR.Item("Objekttyp"))
_profwdSuche = CStr(DR.Item("WindreamSuche"))
_profDay = CStr(DR.Item("Day"))
_profRunType = CStr(DR.Item("Run"))
_proflastRun = DR.Item("Letzter_Durchlauf")
clsLogger.AddDetailLog("Raw-Daten für Profil '" & _Profilname & "', GUID: " & _profGUID & " geladen")
Return True
End If
Next
Else
clsLogger.Add("Achtung - keine Profile für diesen Durchlaufthread verfügbar", False)
Return False
End If
Catch ex As Exception
clsLogger.AddError(ex.Message, "Profil_Init")
Return False
End Try
End Function
'Durchlauf des Profils wird aus dem Service gestartet wenn Init = True war
Public Shared Function Profil_Durchlauf()
Dim _error As Boolean = False
'Try
Dim Run_Profile As Boolean = False
'Soll die Verarbeitung heute durchgeführt werden??
Dim Dayofweek As Integer = My.Computer.Clock.LocalTime.DayOfWeek
If _profDay.Substring(Dayofweek - 1, 1) = 1 Then
'Verarbeitung soll heute durchgeführt werden
clsLogger.AddDetailLog("Verarbeitung soll heute durchgeführt werden!")
clsLogger.AddDetailLog("_RunType: " & _profRunType)
Dim arr As String()
arr = _profRunType.Split(";")
clsLogger.AddDetailLog("arr(1): " & arr(1).ToString)
Select Case arr(0)
Case "TIME"
' Dim intervall As Integer = clsSQLITE.konf_intervall / 60
clsLogger.AddDetailLog("Intervall: 1 Minute")
Dim Time_next As DateTime = _proflastRun.AddMinutes(1)
Dim _RunTime As Date = CDate(arr(1))
clsLogger.AddDetailLog("ProfilTime: " & _RunTime)
clsLogger.AddDetailLog("_RunTime.ToShortTimeString: " & _RunTime.ToShortTimeString & " # " & "Now.ToShortTimeString: " & Now.ToShortTimeString)
If Time_next.ToString.StartsWith("11.11.1911") Then
clsLogger.AddDetailLog("Manueller Durchlauf des Profils - 11.11.1911")
Run_Profile = True
Else
'Ist die Uhrzeit in der Range
If _RunTime.ToShortTimeString = Now.ToShortTimeString Then
Run_Profile = True
End If
End If
Case "INTV"
'Die Differenz berechnen
Dim DiffMin As Integer = DateDiff(DateInterval.Minute, _proflastRun, Date.Now)
Dim msg As String
msg = "Minutenangaben: " & vbNewLine
msg = msg & "DiffMin: " & DiffMin & vbNewLine
msg = msg & "Intervall: " & arr(1)
clsLogger.AddDetailLog(msg)
If DiffMin >= CInt(arr(1)) Then
'Den Durchlauf erlauben
Run_Profile = True
End If
Case Else
clsLogger.Add(">> _profRunType konnte nicht ausgewertet werden - " & arr(0), False)
End Select
If Run_Profile = True Then
ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL = clsDatatabase.Return_Datatable("SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1")
ClassWMResulthandler.clsCURRENT.ARR_Exported_Files = Nothing
clsLogger.Add(">> Start des Durchlaufes für Profil '" & _Profilname & "'", False)
'den Durchlaufszeitpunkt speichern
clsDatatabase.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 1 WHERE GUID = " & _profGUID)
clsLogger.AddDetailLog("Prüfen der windream-Suche.......")
If File.Exists(_profwdSuche) = False Then
clsLogger.Add("Die Windream-Suche '" & _profwdSuche & "' existiert nicht!", True, "clsProfil.Profil_Durchlauf")
'wenn die gesuchte File eine Suche ist: per MAil informierne und Indexierung abbrechen
clsDatatabase.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 0 WHERE GUID = " & _profGUID)
clsLogger.WriteLog()
Return False
Else
' windream-Suche für Profil starten
clsLogger.AddDetailLog("GetSearchDocuments für Suche '" & _profwdSuche & "' starten: ")
Dim windreamSucheErgebnisse As WMObjects = clsWindream_allgemein.GetSearchDocuments(_profwdSuche)
If windreamSucheErgebnisse Is Nothing Then
clsLogger.Add("windreamSucheErgebnisse is nothing!", True, "clsProfil.Profil_Durchlauf")
clsLogger.WriteLog()
Return False
End If
If windreamSucheErgebnisse.Count > 0 Then
clsLogger.Add("- Insgesamt sollen '" & windreamSucheErgebnisse.Count & "' Dateien bearbeitet werden", False)
clsLogger.AddDetailLog("SELECT * FROM TBWMRH_PROFIL_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE")
Dim DT_PROFIL_JOB As DataTable = clsDatatabase.Return_Datatable("SELECT * FROM TBWMRH_PROFIL_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE")
Dim DT_PROFIL_FILE_JOB As DataTable = clsDatatabase.Return_Datatable("SELECT * FROM TBWMRH_PROFIL_FILE_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE")
clsLogger.AddDetailLog("DT_PROFIL_JOB und DT_PROFIL_FILE_JOB generiert ")
clsLogger.AddDetailLog("DT_PROFIL_JOB.Rows.Count = " & DT_PROFIL_JOB.Rows.Count)
clsLogger.AddDetailLog("DT_PROFIL_FILE_JOB.Rows.Count = " & DT_PROFIL_FILE_JOB.Rows.Count)
If DT_PROFIL_JOB.Rows.Count > 0 Then
If clsDateiverarbeitung.InitProfilData = True Then
clsLogger.AddDetailLog("clsDateiverarbeitung.InitProfilData = True")
For Each _JOBROW As DataRow In DT_PROFIL_JOB.Rows
clsLogger.AddDetailLog("JOB_TYP: " & _JOBROW.Item("JOB_TYP").ToString.ToUpper & " GUID: " & _JOBROW.Item("GUID").ToString)
Next
Dim FileJobSuccessful As Boolean = False
Dim CountExportedDoc As Integer = 0
For Each WMdok As WMObject In windreamSucheErgebnisse
For Each DR_PR_JB As DataRow In DT_PROFIL_JOB.Rows
Select Case DR_PR_JB.Item("JOB_TYP").ToString.ToUpper
Case "Create Mail Attachment".ToUpper
'XX
Dim Email_Empfänger = DR_PR_JB.Item("STRING1")
clsLogger.AddDetailLog("Email_Empfänger: " & Email_Empfänger)
Dim Email_Betreff = DR_PR_JB.Item("STRING2")
clsLogger.AddDetailLog("Email_Betreff: " & Email_Betreff)
Dim Email_Body = DR_PR_JB.Item("STRING3")
clsLogger.AddDetailLog("Email_Body: " & Email_Body)
Dim EMAIL_PROFIL = DR_PR_JB.Item("STRING4")
clsLogger.AddDetailLog("EMAIL_PROFIL: " & EMAIL_PROFIL)
If Not IsNothing(ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL) And ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL.Rows.Count >= 1 Then
Dim MAILFROM As String = ""
Dim MAILSMTP As String = ""
Dim MAIL_USER As String = ""
Dim MAIL_USER_PW As String = ""
Dim MAIL_SSL As Boolean = False
For Each emailrow As DataRow In ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL.Rows
If emailrow.Item("GUID") = CInt(EMAIL_PROFIL) Then
MAILFROM = emailrow.Item("EMAIL_FROM")
MAILSMTP = emailrow.Item("EMAIL_SMTP")
MAIL_USER = emailrow.Item("EMAIL_USER")
MAIL_USER_PW = emailrow.Item("EMAIL_PW")
MAIL_SSL = emailrow.Item("SSL_AUTH")
End If
Next
Dim wrapper As New clsEncryption("!35452didalog=")
Dim PWPlain = wrapper.DecryptData(MAIL_USER_PW)
If Not IsNothing(PWPlain) Then
If PWPlain <> "" Then
MAIL_USER_PW = PWPlain
Else
clsLogger.AddError("PWPlain is string.empty - Could not decrypt passwort", "clsProfil.Profil_Durchlauf(wrapper.DecryptData(MAIL_USER_PW))")
clsLogger.WriteLog()
Return False
End If
Else
clsLogger.AddError("PWPlain is nothing - Could not decrypt passwort", "clsProfil.Profil_Durchlauf(wrapper.DecryptData(MAIL_USER_PW))")
clsLogger.WriteLog()
Return False
End If
If Email_Empfänger.ToString.Contains("[%") Then
Email_Empfänger = clsDateiverarbeitung.REGEX_REPLACE(WMdok, Email_Empfänger)
clsLogger.AddDetailLog("Email_Empfänger: " & Email_Empfänger)
End If
Email_Betreff = clsDateiverarbeitung.REGEX_REPLACE(WMdok, Email_Betreff)
Email_Body = clsDateiverarbeitung.REGEX_REPLACE(WMdok, Email_Body)
Dim FILENAME = ClassWMResulthandler.clsCURRENT.WDLAUFWERK & ":" & WMdok.aPath
clsEmail.Send_EMail(Email_Betreff, Email_Body, Email_Empfänger, MAILFROM, MAILSMTP, MAIL_USER, MAIL_USER_PW, MAIL_SSL, FILENAME)
Else
clsLogger.AddError("DT_TBDD_EMAIL is nothing or contains no rows", "clsProfil.Profil_Durchlauf(end concatted file via mail)")
clsLogger.WriteLog()
Return False
End If
Case "Export HDD".ToUpper
clsLogger.AddDetailLog("Case Export HDD")
'Für jedes Dokument in der Windream-Ergebnisliste
'For Each dok As WMObject In windreamSucheErgebnisse
' aktuelles Dokument zum Export bereitstellen
ClassWMResulthandler.clsCURRENT.EXPORTED_FILENAME = ""
If clsDateiverarbeitung.Export_File(WMdok, DR_PR_JB.Item("STRING1")) = True Then
ReDim Preserve ClassWMResulthandler.clsCURRENT.ARR_Exported_Files(CountExportedDoc)
ClassWMResulthandler.clsCURRENT.ARR_Exported_Files(CountExportedDoc) = ClassWMResulthandler.clsCURRENT.EXPORTED_FILENAME
CountExportedDoc += 1
FileJobSuccessful = True
Else
clsDatatabase.Execute_non_Query("UPDATE TBWMRH_PROFIL SET Running = 0, LETZTER_DURCHLAUF = Getdate() WHERE GUID = " & _profGUID)
End If
'Next
Case "BNS json Download".ToUpper
FileJobSuccessful = clsDateiverarbeitung.BNSjsonDownload(WMdok, DR_PR_JB.Item("STRING1"), DR_PR_JB.Item("STRING2"))
Case "Send to printer".ToUpper
Try
Dim pdfxchange = clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows(0).Item("PDF_XCHANGE_LOCATION")
Dim printername = DR_PR_JB.Item("STRING1")
Dim filename = clsCURRENT.WDLAUFWERK & ":" & WMdok.aPath '& "\" & WMdok.aName
If File.Exists(pdfxchange) = False Then
clsLogger.Add("PDFXChange existiert nicht am Ort...", True)
Continue For
End If
Dim myProcess As New Process
myProcess.StartInfo.FileName = pdfxchange
myProcess.StartInfo.CreateNoWindow = False
'PDFXCView.exe / Print(): showui = yes c:\mydocument.pdf
Dim _argument As String = "/printto: """ & printername & """ """ & filename & """"
myProcess.StartInfo.Arguments = _argument
clsLogger.AddDetailLog("Arguments: " & _argument)
Try
myProcess.Start()
Dim p As Process
p = Process.GetProcessById(myProcess.Id)
Dim sw As Stopwatch = New Stopwatch()
sw.Start()
Do While p.HasExited = False
If sw.Elapsed.TotalSeconds = 30 Then
clsLogger.AddDetailLog("Still waiting (30 sec) for ending of process-id: " & myProcess.Id.ToString)
ElseIf sw.Elapsed.TotalMinutes = 1 Then
clsLogger.AddDetailLog("Still waiting (60 sec) for ending of process-id: " & myProcess.Id.ToString & " - Exit now")
Exit Do
End If
Loop
clsLogger.AddDetailLog("...process has exited: ")
sw.Stop()
Catch ex As Exception
clsLogger.AddError(ex.Message, "clsProfil.Print2Printer StartProcess")
End Try
clsLogger.WriteLog()
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(Print2Printer)")
End Try
End Select
'Abschluss Bearbeitung Job
clsLogger.WriteLog()
Next
'##################################
'JETZT DER DURCHLAUF DER DATEI-JOBS
'##################################
If DT_PROFIL_FILE_JOB.Rows.Count > 0 Then
'Für jeden File-Job
For Each DR_PR_FILE_JOB As DataRow In DT_PROFIL_FILE_JOB.Rows
If FileJobSuccessful = False Then
clsLogger.Add("AUSSTIEG FOR SCHLEIFE...", True)
clsLogger.WriteLog()
Exit For
End If
Select Case DR_PR_FILE_JOB.Item("TYP").ToString.ToLower
Case "Set Index".ToLower
Try
'Überprüfen ob Value bereits gesetzt wurde?
Dim idxName As String = DR_PR_FILE_JOB.Item("STRING1").ToString
Dim idxvalue As String = DR_PR_FILE_JOB.Item("STRING2").ToString
If idxvalue.Contains("[%DATETIME]") Then
idxvalue = idxvalue.Replace("[%DATETIME]", Now.ToString)
End If
clsLogger.AddDetailLog("Datei soll mit Index '" & idxName & "'indexiert werden...")
Dim arrIndex() As String
ReDim Preserve arrIndex(0)
arrIndex(0) = idxName
clsLogger.AddDetailLog("...nach arrIndex")
Dim arrValue() As String
Dim aktvalue As Object
aktvalue = WMdok.GetVariableValue(idxName)
clsLogger.AddDetailLog("...nach aktValue zuweisen..")
If aktvalue Is Nothing Then
clsLogger.AddDetailLog("Index '" & idxName & "' ist noch leer.")
ReDim Preserve arrValue(0)
arrValue(0) = idxvalue
Else
clsLogger.AddDetailLog("Index '" & idxName & "' ist bereits gefüllt.")
Dim myArray()
ReDim myArray(0)
myArray(0) = idxvalue
Dim VektorArray()
VektorArray = Return_VektorArray(WMdok, idxName, myArray, True)
If VektorArray Is Nothing = False Then
ReDim arrValue(VektorArray.Length - 1)
Array.Copy(VektorArray, arrValue, VektorArray.Length)
End If
End If
If arrValue Is Nothing = False Then
clsWindream_Index.RunIndexing(WMdok, arrIndex, arrValue, _profObjekttyp)
Else
clsLogger.Add(">> arrValue is nothing - keine Indexierung", False, "clsProfil.Profil_Durchlauf")
End If
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(SetIndex)")
End Try
Case "Rename File with windream Index".ToLower
clsLogger.AddDetailLog("Exportierte Datei soll nach Indexvorgaben umbenannt werden...")
clsDateiverarbeitung.Rename_File(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString)
Case "Rename File with WMVector (only one)".ToLower
clsLogger.AddDetailLog("Exportierte Datei soll nach VektorIndexvorgaben umbenannt werden...")
clsDateiverarbeitung.Rename_File_Vektor(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString)
Case "Execute Oracle Command".ToLower
Try
clsLogger.AddDetailLog("Execute Oracle Command.......")
Dim oracleconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString
Dim oracleCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString
FileJobSuccessful = clsDateiverarbeitung.RUN_ORACLE_COMMAND(WMdok, oracleconnectionstring, oracleCommandRAW)
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteOracleCommand)")
End Try
Case "Execute MSSQL Command".ToLower
Try
Dim MSSQLconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString
Dim MSSQLCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString
clsLogger.AddDetailLog("Execute MSSQL Command.......")
FileJobSuccessful = clsDateiverarbeitung.RUN_MSSQL_COMMAND(WMdok, MSSQLconnectionstring, MSSQLCommandRAW)
Catch ex As Exception
clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteMSSQLCommand)")
End Try
End Select
'Abschluss Bearbeitung File Job
Next
clsLogger.WriteLog()
Else
clsLogger.Add(">> KEINE File-JOBS für Profil '" & _Profilname & "' angelegt!", False, "clsProfil.Profil_Durchlauf")
clsLogger.WriteLog()
End If
Next
clsLogger.WriteLog()
'Jetzt nochmal ein Durchlauf für Profiljobs wo alle Dateien abgearbeitet wurden.
For Each DR_PR_JB As DataRow In DT_PROFIL_JOB.Rows
clsLogger.AddDetailLog("Now again working on profile-type: " & DR_PR_JB.Item("JOB_TYP") & " - ID: " & DR_PR_JB.Item("GUID"))
Select Case DR_PR_JB.Item("JOB_TYP").ToString.ToUpper
Case "Concat Files to one pdf".ToUpper
clsLogger.AddDetailLog("Case Concat Files to one pdf....")
Dim pdftk = clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows(0).Item("PDF_TK_LOCATION")
clsLogger.AddDetailLog("pdftk location: " & pdftk)
clsCURRENT.CONCATTED_FILE = DR_PR_JB.Item("STRING1")
clsLogger.AddDetailLog("CONCATTED_FILE location: " & ClassWMResulthandler.clsCURRENT.CONCATTED_FILE)
Dim deleteJaNein = DR_PR_JB.Item("STRING2").ToString.ToUpper
clsLogger.AddDetailLog("deleteJaNein: " & deleteJaNein.ToString)
If File.Exists(pdftk) Then
If File.Exists(ClassWMResulthandler.clsCURRENT.CONCATTED_FILE) Then
Try
File.Delete(ClassWMResulthandler.clsCURRENT.CONCATTED_FILE)
Catch ex As Exception
End Try
End If
Try
Dim myProcess As New Process
Dim ProcID
myProcess.StartInfo.FileName = pdftk
myProcess.StartInfo.CreateNoWindow = False
Dim _argument As String
Dim i As Integer
For Each str As String In ClassWMResulthandler.clsCURRENT.ARR_Exported_Files
If i = 0 Then
_argument = """" & str & """"
Else
_argument = _argument & " " & """" & str & """"
End If
i += 1
Next
If File.Exists(ClassWMResulthandler.clsCURRENT.CONCATTED_FILE) Then
Try
File.Delete(ClassWMResulthandler.clsCURRENT.CONCATTED_FILE)
Catch ex As Exception
End Try
End If
myProcess.StartInfo.Arguments = _argument & " cat output " & ClassWMResulthandler.clsCURRENT.CONCATTED_FILE
clsLogger.AddDetailLog("Arguments: " & _argument & " cat output " & ClassWMResulthandler.clsCURRENT.CONCATTED_FILE)
myProcess.Start()
ProcID = myProcess.Id
Dim p As Process
p = Process.GetProcessById(ProcID)
Dim sw As Stopwatch = New Stopwatch()
sw.Start()
Do While p.HasExited = False
If sw.Elapsed.TotalSeconds = 30 Then
clsLogger.AddDetailLog("Still waiting (30 sec) for ending of process-id: " & ProcID.ToString)
ElseIf sw.Elapsed.TotalMinutes = 1 Then
clsLogger.AddDetailLog("Still waiting (60 sec) for ending of process-id: " & ProcID.ToString & " - Exit now")
Exit Do
End If
Loop
clsLogger.AddDetailLog("...process has exited: ")
sw.Stop()
clsLogger.AddDetailLog("Waiting for file: " & ClassWMResulthandler.clsCURRENT.CONCATTED_FILE)
Do While File.Exists(ClassWMResulthandler.clsCURRENT.CONCATTED_FILE) = False
Console.WriteLine("...not existing!")
Loop
If deleteJaNein = "JA" Then
For Each str As String In ClassWMResulthandler.clsCURRENT.ARR_Exported_Files
Try
File.Delete(str)
Catch ex As Exception
clsLogger.AddError("Unexpected error in deleting ARR_Exported_Files files: " & ex.Message, "clsProfil.Profil_Durchlauf(Concat Files to one pdf)")
End Try
Next
End If
clsLogger.WriteLog()
Catch ex As Exception
clsLogger.AddError("Unexpected error: " & ex.Message, "clsProfil.Profil_Durchlauf(Concat Files to one pdf)")
End Try
Else
clsLogger.AddError("pdftk is not existing", "clsProfil.Profil_Durchlauf(Concat Files to one pdf)")
End If
Case "Send concatted file via mail".ToUpper
clsLogger.AddDetailLog("CASE Send concatted file via mail.... ")
If File.Exists(ClassWMResulthandler.clsCURRENT.CONCATTED_FILE) = True Then
Dim Email_Empfänger = DR_PR_JB.Item("STRING1")
clsLogger.AddDetailLog("Email_Empfänger: " & Email_Empfänger)
Dim Email_Betreff = DR_PR_JB.Item("STRING2")
clsLogger.AddDetailLog("Email_Betreff: " & Email_Betreff)
Dim Email_Body = DR_PR_JB.Item("STRING3")
clsLogger.AddDetailLog("Email_Body: " & Email_Body)
Dim EMAIL_PROFIL = DR_PR_JB.Item("STRING4")
clsLogger.AddDetailLog("EMAIL_PROFIL: " & EMAIL_PROFIL)
If Not IsNothing(ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL) And ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL.Rows.Count >= 1 Then
Dim MAILFROM As String = ""
Dim MAILSMTP As String = ""
Dim MAIL_USER As String = ""
Dim MAIL_USER_PW As String = ""
Dim MAIL_SSL As Boolean = False
For Each emailrow As DataRow In ClassWMResulthandler.clsCURRENT.DT_TBDD_EMAIL.Rows
If emailrow.Item("GUID") = CInt(EMAIL_PROFIL) Then
MAILFROM = emailrow.Item("EMAIL_FROM")
MAILSMTP = emailrow.Item("EMAIL_SMTP")
MAIL_USER = emailrow.Item("EMAIL_USER")
MAIL_USER_PW = emailrow.Item("EMAIL_PW")
MAIL_SSL = emailrow.Item("SSL_AUTH")
End If
Next
Dim wrapper As New clsEncryption("!35452didalog=")
Dim PWPlain = wrapper.DecryptData(MAIL_USER_PW)
If Not IsNothing(PWPlain) Then
If PWPlain <> "" Then
MAIL_USER_PW = PWPlain
Else
clsLogger.AddError("PWPlain is string.empty - Could not decrypt passwort", "clsProfil.Profil_Durchlauf(wrapper.DecryptData(MAIL_USER_PW))")
clsLogger.WriteLog()
Return False
End If
Else
clsLogger.AddError("PWPlain is nothing - Could not decrypt passwort", "clsProfil.Profil_Durchlauf(wrapper.DecryptData(MAIL_USER_PW))")
clsLogger.WriteLog()
Return False
End If
clsEmail.Send_EMail(Email_Betreff, Email_Body, Email_Empfänger, MAILFROM, MAILSMTP, MAIL_USER, MAIL_USER_PW, MAIL_SSL, ClassWMResulthandler.clsCURRENT.CONCATTED_FILE)
Else
clsLogger.AddError("DT_TBDD_EMAIL is nothing or contains no rows", "clsProfil.Profil_Durchlauf(end concatted file via mail)")
clsLogger.WriteLog()
Return False
End If
Else
clsLogger.AddError("File not existing: " & ClassWMResulthandler.clsCURRENT.CONCATTED_FILE, "clsProfil.Profil_Durchlauf(Send concatted file via mail)")
End If
End Select
Next
clsLogger.WriteLog()
Else
clsLogger.Add(">> Initialisierung Profil nicht erfolgreich", True)
clsLogger.WriteLog()
End If
Else
clsLogger.Add(">> KEINE JOBS für Profil '" & _Profilname & "' angelegt!", False, "clsProfil.Profil_Durchlauf")
clsLogger.WriteLog()
End If
Else
' keine Dateien zum Importieren
clsLogger.Add(">> Keine windream-Dokumente für Profil '" & _Profilname & "' vorhanden/gefunden.", False)
clsLogger.Add("", False)
clsLogger.WriteLog()
End If
End If
End If
Else
clsLogger.AddDetailLog("Verarbeitung für heute NICHT konfiguriert")
clsLogger.WriteLog()
End If
'Abschluss des Profiles
clsDatatabase.Execute_non_Query("UPDATE TBWMRH_PROFIL SET Running = 0, LETZTER_DURCHLAUF = GETDATE() WHERE GUID = " & _profGUID)
clsLogger.AddDetailLog("'UPDATE TBWMRH_PROFIL SET Running = 0' ausgeführt")
clsLogger.WriteLog()
Return True
'Catch ex As Exception
' clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf")
' clsDatatabase.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 0 WHERE GUID = " & _profGUID)
' CriticalError = False
' Return False
'End Try
End Function
Private Shared Function Return_VektorArray(ByVal oDocument As WMObject, vktIndexName As String, NIIndexe As Object, CheckDuplikat As Boolean)
Try
Dim missing As Boolean = False
Dim Anzahl As Integer = 0
Dim ValueArray()
'Jeden Wert des Vektorfeldes durchlaufen
Dim wertWD = oDocument.GetVariableValue(vktIndexName)
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
clsLogger.AddDetailLog("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
clsLogger.AddDetailLog("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
clsLogger.AddDetailLog("New Value (" & Anzahl & ") " & NewValue.ToString)
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = NewValue.ToString
Anzahl += 1
Else
clsLogger.AddDetailLog("Value '" & NewValue.ToString & "' bereits in Vektorfeld enthalten")
End If
End If
Next
End If
End If
Else
clsLogger.AddDetailLog("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
clsLogger.AddDetailLog("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
clsLogger.AddDetailLog("Return ValueArray: length " & ValueArray.Length)
Return ValueArray
Catch ex As Exception
clsLogger.AddError(ex.Message, "Return_VektorArray")
Return Nothing
End Try
End Function
End Class

View File

@@ -0,0 +1,479 @@
Imports WINDREAMLib
Imports WINDREAMLib.WMCOMEvent
Imports WINDREAMLib.WMEntity
Imports WINDREAMLib.WMObjectEditMode
Imports WINDREAMLib.WMSearchOperator
Imports WINDREAMLib.WMSearchRelation
Imports WMOBRWSLib
Imports WMOSRCHLib
Imports System.IO
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 oSession '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
#End Region
#Region "+++++ Allgemeine Methoden und Funktionen +++++"
''' <summary>
''' Konstruktor für die windream-Klasse
''' </summary>
''' <remarks></remarks>
Sub New()
' wenn ein Fehler bei der Initialisierung auftrat
If Not Init() Then
' Nachricht ausgeben
clsLogger.Add("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", True, "clsWindream_allgemein.Init")
' 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
' Session-Objekt instanziieren und mit dem im Client ausgewählten Server belegen
oSession = CreateObject("Windream.WMSession", GetCurrentServer)
' Connection-Objekt instanziieren
oConnect = CreateObject("Windream.WMConnect")
'MsgBox("windrem init 'ed")
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"
' clsLogger.AddDetailLog("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(oSession)
clsLogger.AddDetailLog("windream-Server: '" & GetCurrentServer() & "'")
clsLogger.AddDetailLog("windream-UserName: '" & oConnect.UserName & "'")
If oSession.aLoggedin = False Then
clsLogger.Add("Es konnte keine Verbindung mit dem windream-Server hergestellt werden", True, "clswindream.Init")
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
oSession.SwitchEvents(WMCOMEventWMSessionNeedIndex, False)
' der Parameter WMEntityDocument definiert, dass nur Dokumenttypen und keine
' Ordnertypen ausgelesen werden
oDokumentTypen = oSession.GetWMObjectTypes(WINDREAMLib.WMEntity.WMEntityDocument)
Catch ex As Exception
clsLogger.AddError("Problem beim Auslesen der Objekttypen", "clswindream.Init")
Return False
End Try
End If
clsLogger.AddDetailLog("Alles OK - Erfolgreich angemeldet und Session aufgebaut")
Return True
Catch ex As Exception
If Err.Number = -2147220985 Then
clsLogger.AddError("Die installierte windream-Version ist nicht ausreichend für den Betrieb", "clswindream.Init")
Else
clsLogger.AddError("Fehler beim Login an windream: " & ex.Message, "clswindream.Init")
End If
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
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()
Try
Dim objektTypenStr(oDokumentTypen.Count) As String
For i As Integer = 0 To oDokumentTypen.Count
objektTypenStr(i) = oDokumentTypen.Item(i).aName
Next
Return objektTypenStr
Catch ex As Exception
clsLogger.AddError("Fehler beim Auslesen der Objekttypen als String: " & ex.Message, "clswindream.GetObjecttypesAsStrings")
Return Nothing
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 = oSession.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
clsLogger.AddError("Fehler beim Auslesen der windream-Indexe: " & ex.Message, "clswindream.GetIndicesByObjecttype")
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 = oSession.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
clsLogger.AddError("Ein Objekttyp kopnnte nicht erstellt werden. Fehler: " & ex.Message, "clswindream.GetObjecttypeByName")
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
clsLogger.AddError("Beim Prüfen ob ein Index für einen Objekttypen existiert, ist ein Fehler aufgetreten. Fehler: " & ex.Message, "clswindream.ExistIndexInObjekttyp")
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 oSession.aLoggedin
Catch ex As Exception
clsLogger.AddError("Es konnte nicht erfolgreich geprüft werden, ob das Programm am windream-Server angemeldet ist. Fehler: " & ex.Message, "clswindream.IsLoggedIn")
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 Shared Function GetCurrentServer() As String
Try
clsLogger.AddDetailLog(oBrowser.GetCurrentServer.ToString)
Return oBrowser.GetCurrentServer 'ClassWindream.oBrowser.GetCurrentServer
Catch ex As Exception
clsLogger.AddError("Der aktuell gewählte windream-Server konnte nicht ausgelesen werden. Fehler: " & ex.Message, "clswindream.GetCurrentServer")
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 = oSession.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 = oSession.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
clsLogger.Add("Auswahlliste: " & indexname & " nicht gefunden.", True, "clswindream.GetValuesfromAuswahlliste")
Return Nothing
End If
Catch ex As Exception
clsLogger.AddError("Fehler: " & ex.Message, "clswindream.GetValuesfromAuswahlliste")
Return Nothing
End Try
End Function
Public Shared Function WDObject_exists(wdobj_location As String)
Dim WDObject As WMObject
Try
WDObject = oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, wdobj_location.Substring(2))
If WDObject Is Nothing Then
Return False
Else
clsLogger.AddDetailLog("WDObject exists")
Return True
End If
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei machen
clsLogger.AddError("Es konnte kein windream-Object erzeugt werden - " & ex.Message, "clswindream.WDObject_exists")
Return False
End Try
End Function
Public Shared Function GetSearchDocuments(ByVal wdfLocation As String)
'wdfLocation = 'W:\System\Suchen\WDRH\TestPDF.wdf'
Try
Dim SearchName = wdfLocation.Substring(wdfLocation.LastIndexOf("\") + 1)
Dim SearchPath = wdfLocation.Substring(0, wdfLocation.Length - SearchName.Length)
clsLogger.Add("WMSearch: " & wdfLocation.ToLower, False)
If System.IO.File.Exists(wdfLocation.ToLower) Then
clsLogger.AddDetailLog("Search exists")
End If
oController.CheckSearchProfile(wdfLocation.ToLower) 'wdfLocation.ToLower)
clsLogger.AddDetailLog("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")
clsLogger.AddDetailLog("WD Objekte in GetSearchDocuments erzeugt")
clsLogger.AddDetailLog(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)
clsLogger.AddDetailLog("Session created...")
oConnect.LoginSession(srchIndex.WMSession)
clsLogger.AddDetailLog("LoginSession...")
srchIndex.SearchProfilePath = SearchPath
clsLogger.AddDetailLog("SearchPath...")
srchIndex.LoadSearchProfile(SearchName)
clsLogger.AddDetailLog("LoadSearchProfile...")
oSearch = srchIndex.GetSearch()
clsLogger.AddDetailLog("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
clsLogger.Add("KEIN GÜLTIGER WINDREAM-SUCHTYP", True, "clswindream.GetSearchDocuments")
Return Nothing
End Select
Dim WMObjects As Object
WMObjects = oSearch.Execute
clsLogger.AddDetailLog("WD Objekte werden zurückgegeben")
Return oSearch.execute
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei machen
clsLogger.AddError(ex.Message, "clswindream.GetSearchDocuments")
Return Nothing
End Try
End Function
#End Region
End Class

View File

@@ -0,0 +1,620 @@
Imports WINDREAMLib
Imports WMOSRCHLib
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
'Dim srchQuick = CreateObject("WMOSrch.WMQuickSearch") 'As WMOSRCHLib.WMQuickSearch
#End Region
#Region "+++++ Allgemeine Methoden und Funktionen +++++"
Sub New()
MyBase.New()
End Sub
Private Shared 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 = oSession.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 Shared 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
clsLogger.Add(" >> RunIndexing_Vektor: Indexwert ist leer/Nothing - Keine Nachindexierung", False)
Else
'Jetzt jeden Indexwert durchlaufen
Dim indexname As String
indexname = Indizes(0)
clsLogger.AddDetailLog("RunIndexing_Vektor: Indexname: " & indexname)
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
clsLogger.AddDetailLog("RunIndexing_Vektor: VEKTORFELD-Indexierung: Vorbereiten des Arrays")
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname)
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
Select Case (vType)
Case 4097
clsLogger.AddDetailLog("Typ des windream-Indexes: 4097 Vektor alphanumerisch")
Case 4098
clsLogger.AddDetailLog("Typ des windream-Indexes: 4098 Vektor Numerisch")
Case 4099
clsLogger.AddDetailLog("Typ des windream-Indexes: 4099 Vektor Kommazahl")
Case 4101
clsLogger.AddDetailLog("Typ des windream-Indexes: 4101 Vektor Date")
Case 4103
clsLogger.AddDetailLog("Typ des windream-Indexes: 4103 Vektor DateTime")
Case 4107
clsLogger.AddDetailLog("Typ des windream-Indexes: 4107 Vektor Integer(64bit)")
Case 36865
clsLogger.AddDetailLog("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
clsLogger.AddDetailLog("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 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
clsLogger.AddDetailLog("RunIndexing_Vektor: Konvertierter Wert: " & myArray(0).ToString)
Else
clsLogger.AddDetailLog("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 convertValue
If IsNumeric(wert) Then
Try
convertValue = CInt(wert)
Catch ex As Exception
clsLogger.AddDetailLog("Wert muss in Int64 konvertiert werden")
convertValue = Convert.ToInt64(wert) 'ToInt64
End Try
Else
' clsLoggerNI.Add("Indexierungswert '" & wert.ToString & "' kann nicht in Integer konvertiert werden")
Return False
End If
myArray(i1) = convertValue
Case 4099
myArray(i1) = CDbl(aValue.Replace(".", ",").Replace(" ", ""))
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)
clsLogger.AddDetailLog("RunIndexing_Vektor: 'SetVariableValue' für VEKTOR erfolgreich")
oDocument.Save()
oDocument.unlock()
clsLogger.AddDetailLog("RunIndexing_Vektor: Indexierung erfolgreich beendet (Save und Unlock durchgeführt)")
Return True
End If
Else
clsLogger.Add(" >> RunIndexing_Vektor: Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!", True)
Return False
End If
End If
Catch ex As Exception
clsLogger.AddError("## Fehler in RunIndexing_Vektor - Fehler: " & ex.Message, "RunIndexingVektor")
oDocument.Save()
oDocument.unlock()
Return False
End Try
End Function
Public Shared 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
clsLogger.AddDetailLog("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 = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, Objekttyp)
' WMObject.aObjectType = selectedProfile.Dokumenttyp
clsLogger.AddDetailLog("Objekttyp war Standard und wurde in '" & Objekttyp & "' geändert.")
Else
clsLogger.AddDetailLog("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 = oSession.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
clsLogger.AddDetailLog("Indexierung von Index '" & indexname & "'")
'MsgBox(oDocument.aName & vbNewLine & aValues(i) & vbNewLine & vType, MsgBoxStyle.Exclamation, "Zeile 87")
Dim value = aValues(i)
Dim convertValue
Dim vektor As Boolean = False
'Den Typ des Index-Feldes auslesen
'MsgBox(value.GetType.ToString)
Select Case (vType)
'Case WMObjectVariableValueTypeUndefined
Case WMObjectVariableValueTypeString
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeString")
convertValue = CStr(value)
Case WMObjectVariableValueTypeInteger
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeInteger")
value = value.ToString.Replace(" ", "")
If IsNumeric(value) = False Then
clsLogger.AddDetailLog("Achtung: Value '" & value & "' kann nicht in Zahl konvertiert werden!")
End If
value = value.ToString.Replace(" ", "")
convertValue = CInt(value)
_int = True
Case WMObjectVariableValueTypeFloat
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
value = value.ToString.Replace(" ", "")
convertValue = CDbl(value)
Case WMObjectVariableValueTypeFixedPoint
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint")
value = value.ToString.Replace(" ", "")
convertValue = CDbl(value)
_dbl = True
Case WMObjectVariableValueTypeBoolean
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeBoolean")
convertValue = CBool(value)
_bool = True
Case WMObjectVariableValueTypeDate
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeDate")
_date = True
'Dim _date As Date = value
convertValue = value
Case WMObjectVariableValueTypeTimeStamp
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp")
convertValue = CDbl(value)
Case WMObjectVariableValueTypeCurrency
clsLogger.AddDetailLog("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))
convertValue = aValueWrapper
Case WMObjectVariableValueTypeTime
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeTime")
'If ((value)) Then
' convertValue = CDate(value)
'Else
' convertValue = ""
'End If
'Dim _date As Date = value
convertValue = convertValue '*_date.ToShortTimeString
Case WMObjectVariableValueTypeFloat
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
convertValue = CStr(value)
Case WMObjectVariableValueTypeVariant
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeVariant")
convertValue = CStr(value)
Case WMObjectVariableValueTypeFulltext
clsLogger.AddDetailLog("Typ des windream-Indexes: WMObjectVariableValueTypeFulltext")
convertValue = CStr(value)
Case 4097
clsLogger.AddDetailLog("Typ des windream-Indexes: 4097 Vektor alphanumerisch")
'Vektor alphanumerisch
vektor = True
Case 4098
clsLogger.AddDetailLog("Typ des windream-Indexes: 4098 Vektor Numerisch")
'Vektor Numerisch
vektor = True
Case 4099
clsLogger.AddDetailLog("Typ des windream-Indexes: 4099 Vektor Kommazahl")
'Vektor Kommazahl
vektor = True
Case 4101
clsLogger.AddDetailLog("Typ des windream-Indexes: 4101 Vektor Date")
'Vektor Kommazahl
vektor = True
Case 4103
clsLogger.AddDetailLog("Typ des windream-Indexes: 4103 Vektor DateTime")
'Vektor DateTime
vektor = True
Case 4107
clsLogger.AddDetailLog("Typ des windream-Indexes: 4107 Integer 64bit")
vektor = True
Case 36865
clsLogger.AddDetailLog("Typ des windream-Indexes: 36865 Vektor alphanumerisch")
'Vektor Kommazahl
vektor = True
Case Else
clsLogger.AddDetailLog("Typ des windream-Indexes konnte nicht bestimmt werden!")
clsLogger.AddDetailLog("Versuch des Auslesens (vType): " & vType)
'MsgBox(vType & vbNewLine & CStr(value), MsgBoxStyle.Exclamation, "Marlon-Case Else")
convertValue = ""
End Select
If vektor = False Then
If convertValue.ToString Is Nothing = False Then
clsLogger.AddDetailLog("Konvertierter Wert: '" & convertValue.ToString & "'")
End If
End If
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
'############################################################################################
If vektor = False Then
If convertValue.ToString Is Nothing = False Then
clsLogger.AddDetailLog("Versuch dem Dok einen Index zuzuweisen: oDocument.SetVariableValue(" & aName & ", " & convertValue & ")")
If _int = True Then
convertValue = convertValue.ToString.Replace(" ", "")
oDocument.SetVariableValue(aName, CInt(convertValue))
ElseIf _date = True Then
oDocument.SetVariableValue(aName, CDate(convertValue))
ElseIf _bool Then
oDocument.SetVariableValue(aName, CBool(convertValue))
ElseIf _dbl Then
convertValue = convertValue.ToString.Replace(" ", "")
oDocument.SetVariableValue(aName, CDbl(convertValue))
Else
oDocument.SetVariableValue(aName, convertValue)
End If
clsLogger.Add(" >> Index '" & aName & "' wurde geschrieben", False)
clsLogger.Add("", False)
Else
clsLogger.Add(" >> Kein Indexwert vorhanden", False)
End If
Else
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
clsLogger.AddDetailLog("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 Then
clsLogger.AddDetailLog("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 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
clsLogger.AddDetailLog("Konvertierter Wert: " & myArray(0).ToString)
Else
clsLogger.AddDetailLog("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)
clsLogger.AddDetailLog("Konvertierter Wert: (" & i1 & ")" & myArray(i1).ToString)
i1 = i1 + 1
Next
For Each NewValue As Object In aValues
myArray(i1) = CStr(NewValue)
clsLogger.AddDetailLog("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)
clsLogger.AddDetailLog("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)
clsLogger.AddDetailLog("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(".", ","))
clsLogger.AddDetailLog("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(".", ","))
clsLogger.AddDetailLog("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)
clsLogger.AddDetailLog("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)
clsLogger.AddDetailLog("'SetVariableValue' für VEKTOR erfolgreich")
End If
Else
clsLogger.AddDetailLog("Array der Indexwerte ist leer/Nothing - Keine Nachindexierung")
End If
i += 1
Next
' oDocument.LockRights()
'SetRights(WMObject, User)
oDocument.Save()
oDocument.unlock()
clsLogger.AddDetailLog("Indexierung erfolgreich beendet (Save und Unlock durchgeführt)")
clsLogger.AddDetailLog("")
Return False
Else
clsLogger.Add(" >> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!", False)
'oDocument.unlock()
Return True
End If
End If
Catch ex As Exception
clsLogger.AddError(ex.Message, "ClassSearchResult.RunIndexing")
oDocument.Save()
oDocument.unlock()
Return True
End Try
End Function
#End Region
#Region "+++++ Allgemeine Funktionen die Informationen zurückliefern +++++"
''' 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 = oSession.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
#End Region
End Class

View File

@@ -0,0 +1,4 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="Newtonsoft.Json" version="11.0.2" targetFramework="net461" />
</packages>

View File

@@ -0,0 +1,20 @@
The MIT License (MIT)
Copyright (c) 2007 James Newton-King
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff