Imports WINDREAMLib Imports WMOSRCHLib Imports DigitalData.Modules.Logging Public Class clsWindream_Index Inherits clsWindream_allgemein Dim Logger As Logger #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(MyLogger As LogConfig) MyBase.New(MyLogger) Logger = MyLogger.GetLogger() 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 = 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 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 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 convertValue If IsNumeric(wert) Then Try convertValue = CInt(wert) Catch ex As Exception Logger.Debug("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) 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 Logger.Debug($"aObjectType.aName: [{oDocument.aObjectType.aName}] <> Objekttyp: [{Objekttyp}]") ' ihr den entsprechenden Dokumenttyp zuweisen oDocument.aObjectType = oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, Objekttyp) Try oDocument.Save() Catch ex As Exception ' wenn es einen Fehler beim speichern gab, dann konnte auch kein Objekttyp gesetzt werden -> es kann also auch keine ' Indexierung stattfinden und die Indexierung muss nicht fortgesetzt werden Logger.Warn($"ATTENTION: COULD NOT SET OBJECTTYPE: [{ex.Message}]") Return False End Try ' WMObject.aObjectType = selectedProfile.Dokumenttyp Logger.Debug("Objekttyp war Standard und wurde in '" & Objekttyp & "' geändert.") Else Logger.Debug("Objekttyp war bereits gesetzt") End If '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 'End If Logger.Debug("Indexierung von Index '" & indexname & "'") Dim value = aValues(i) Dim convertValue Dim vektor As Boolean = False 'Den Typ des Index-Feldes auslesen Select Case (vType) 'Case WMObjectVariableValueTypeUndefined Case WMObjectVariableValueTypeString Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeString") convertValue = CStr(value) 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(" ", "") convertValue = CInt(value) _int = True Case WMObjectVariableValueTypeFloat Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat") value = value.ToString.Replace(" ", "") convertValue = CDbl(value) Case WMObjectVariableValueTypeFixedPoint Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint") value = value.ToString.Replace(" ", "") convertValue = CDbl(value) _dbl = True Case WMObjectVariableValueTypeBoolean Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeBoolean") convertValue = CBool(value) _bool = True Case WMObjectVariableValueTypeDate Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeDate") _date = True 'Dim _date As Date = value convertValue = value Case WMObjectVariableValueTypeTimeStamp Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp") convertValue = 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)) convertValue = aValueWrapper Case WMObjectVariableValueTypeTime Logger.Debug("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 Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat") convertValue = CStr(value) Case WMObjectVariableValueTypeVariant Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeVariant") convertValue = CStr(value) Case WMObjectVariableValueTypeFulltext Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFulltext") convertValue = CStr(value) Case 4097 Logger.Debug("Typ des windream-Indexes: 4097 Vektor alphanumerisch") 'Vektor alphanumerisch vektor = True Case 4098 Logger.Debug("Typ des windream-Indexes: 4098 Vektor Numerisch") 'Vektor Numerisch vektor = True Case 4099 Logger.Debug("Typ des windream-Indexes: 4099 Vektor Kommazahl") 'Vektor Kommazahl vektor = True Case 4101 Logger.Debug("Typ des windream-Indexes: 4101 Vektor Date") 'Vektor Kommazahl vektor = True Case 4103 Logger.Debug("Typ des windream-Indexes: 4103 Vektor DateTime") 'Vektor DateTime vektor = True Case 4107 Logger.Debug("Typ des windream-Indexes: 4107 Integer 64bit") vektor = True Case 36865 Logger.Debug("Typ des windream-Indexes: 36865 Vektor alphanumerisch") 'Vektor Kommazahl vektor = True Case Else Logger.Debug("Typ des windream-Indexes konnte nicht bestimmt werden!") Logger.Debug("Versuch des Auslesens (vType): " & vType) convertValue = "" End Select If vektor = False Then If convertValue.ToString Is Nothing = False Then Logger.Debug("Konvertierter Wert: '" & convertValue.ToString & "'") End If End If '############################################################################################ '####################### Der eigentliche Indexierungsvorgang ################################ '############################################################################################ If vektor = False Then If convertValue.ToString Is Nothing = False Then Logger.Debug("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 Logger.Info("Index '" & aName & "' wurde geschrieben") 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) 'Next Dim Anzahl As Integer = aValues.Length 'Vektorfeld wird mit EINEM Wert gefüllt If Anzahl = 1 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 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 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.Debug("'SetVariableValue' für VEKTOR erfolgreich") 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)") Return False Else Logger.Warn("Document is locked, no indexing!") 'oDocument.unlock() Return True End If End If Catch ex As Exception Logger.Error(ex) 'clsLogger.AddError(ex.Message, "ClassSearchResult.RunIndexing") If oDocument.aLocked Then oDocument.unlock() End If 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 = oWMSession.GetWMObjectByPath(WMEntityDocument, _fullfilepath) 'WINDREAMLib.WMEntity.WMEntityDocument IndexwertAusWindream = _dok.GetVariableValue(_indexname) Return IndexwertAusWindream.ToString Catch ex As Exception Return Nothing End Try End Function #End Region End Class