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 clsLogger.AddDetailLog("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 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) 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 Return Nothing End Try End Function #End Region End Class