EmailProfiler/App/EmailProfiler.Common/clsWindream_Index.vb
2023-09-19 11:39:27 +02:00

848 lines
47 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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