ToolCollection/ToolCollection/ClassNIWindream.vb

1063 lines
56 KiB
VB.net

Imports WINDREAMLib
Imports WMOSRCHLib
Imports DigitalData.Modules.Logging
Public Class ClassNIWindream
Inherits ClassWindream_allgemein
Private Shared _Logger As DigitalData.Modules.Logging.Logger
Private Shared _MyLogger As LogConfig
Private _selectedProfil As ClassNIProfil
Private database As ClassNIDatenbankzugriff
#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
Protected Const WMObjectStatusArchived = "&h00002000"
Const WMObjectEditModeChangeArchivedIndex = "&h00004000" ' indices marked as "always editable" can be edited even if the object is already archived or an older version of a file
#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(LogConfig As LogConfig)
MyBase.New(LogConfig)
_MyLogger = LogConfig
_Logger = _MyLogger.GetLogger
database = New ClassNIDatenbankzugriff(LogConfig)
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 = "Variant"
Case WMObjectVariableValueTypeFulltext
Type = "Fulltext"
Case 4097
Type = "Vektor String"
Case 4098
Type = "Vektor Numerisch"
Case 4099
Type = "Vektor Float"
Case 4100
Type = "Vektor Boolean"
Case 4101
Type = "Vektor Date"
Case 4103
Type = "Vektor DateTime"
Case 4104
Type = "Vektor Währung"
Case 4107
Type = "Vektor Integer(64bit)"
Case 36865
Type = "Vektor Alpha"
Case 8204
Type = "Vektor Integer"
Case 8
Type = "Vektor Boolean"
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())
Dim myArray
Try
If Indizes IsNot Nothing And aValues IsNot Nothing Then
_Logger.Debug(" RunIndexing_Vektor()...")
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)
If My.Settings.vLogErrorsonly = False Then _Logger.Warn(" >> RunIndexing_Vektor: Indexname: " & indexname)
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
If My.Settings.vLogErrorsonly = False Then _Logger.Warn(" >> RunIndexing_Vektor: VEKTORFELD-Indexierung: Vorbereiten des Arrays")
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = Me.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")
Case 8204
_Logger.Debug("Typ des windream-Indexes: 8204 Integer")
Case 8
_Logger.Debug("Typ des windream-Indexes: 8 Vektor Boolean")
End Select
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)
myArray(0) = Convert_IndexValue(vType, aValues(0))
_Logger.Debug("RunIndexing_Vektor: Konvertierter Wert: " & myArray(0).ToString)
Else
_Logger.Debug("RunIndexing_Vektor: Vektorfeld wird mit MEHREREN Werten gefüllt ")
Dim _value As String
Try
'Die Größe des Arrays festlegen
ReDim myArray(Anzahl)
Dim i1 As Integer = 0
For Each aValue As String In aValues
_value = aValue
Select Case (vType)
Case 4098
Dim wert = aValue.Replace(" ", "")
Dim convertValue
If IsNumeric(wert) Then
Try
myArray(i1) = Convert_IndexValue(vType, aValue)
Catch ex As Exception
_Logger.Debug("Wert muss in Int64 konvertiert werden")
convertValue = Convert.ToInt64(wert) 'ToInt64
End Try
Else
' ClassLoggerNI.Add(" - Indexierungswert '" & wert.ToString & "' kann nicht in Integer konvertiert werden")
Return False
End If
myArray(i1) = convertValue
Case Else
myArray(i1) = Convert_IndexValue(vType, aValue)
End Select
i1 += 1
Next
Catch ex As Exception
_Logger.Error(ex)
'ClassLoggerNI.Add(String.Format("## Error in converting array with more values: value ('{0}') - error: " & ex.Message, _value))
End Try
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.Info("RunIndexing_Vektor: Indexierung erfolgreich beendet (Save und Unlock durchgeführt)")
Return True
End If
Else
_Logger.Info("RunIndexing_Vektor: Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
Return False
End If
End If
Catch ex As Exception
_Logger.Error(ex)
If Not IsNothing(myArray) Then
Dim i1 As Integer = 0
For Each aValue As String In myArray
_Logger.Debug(String.Format("myArray Value({0}): " & aValue.ToString, i1))
i1 += 1
Next
End If
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, ByVal myDS As DataSet, Profil As String, Objekttyp As String)
Dim vektInsState As Integer = 1
Dim myArray
Try
If Indizes IsNot Nothing And aValues IsNot Nothing Then
If Not oDocument.aLocked Then
'Überprüfen ob Archiviert ja oder nein
Dim dwflag = oDocument.GetVariableValue("dwFlags")
If CStr(dwflag) = 4204032 Then
Try
oDocument.LockFor(CLng(WMObjectEditModeChangeArchivedIndex))
Catch ex1 As Exception
_Logger.Error(ex1)
Return True
End Try
Else
Try
oDocument.lock()
Catch ex As Exception
If ex.Message.Contains("Object not editable in mode") Then
Try
'_Logger.Debug("Ergebnis CStr(dwflag): " & CStr(dwflag) & " - Versuch die Datei mit erweitertem Modus zu locken!")
oDocument.LockFor(CLng(WMObjectEditModeChangeArchivedIndex))
Catch exlock2 As Exception
_Logger.Error(ex)
_Logger.Warn("ACHTUNG: Fehler bei Locken der Datei mit erweitertem Modus WMobjectEMCArchived: " & exlock2.Message)
_Logger.Warn("Ergebnis CStr(dwflag): " & CStr(dwflag))
Return True
End Try
Else
_Logger.Warn($"ACHTUNG: Fehler bei Locken der Datei (ClassNiWindream.RunIndexing): " & ex.Message)
_Logger.Warn("Ergebnis CStr(dwflag): " & CStr(dwflag))
Return True
End If
End Try
End If
Dim i As Integer = 0
Dim indexname As String
Try
If aValues.Length = 1 And aValues(0) = "" Then
_Logger.Info($"Indexwert ist leer/Nothing - Keine Nachindexierung 313 Dokument [{oDocument.aName}]")
End If
Catch ex As Exception
Try
If aValues.Count = 1 And aValues(0) = "" Then
_Logger.Info("Indexwert ist leer/Nothing - Keine Nachindexierung 318")
End If
Catch ex1 As Exception
_Logger.Warn("Unexpected error in RunIndexing 321: " + ex.Message)
End Try
End Try
' wenn der Datei noch kein Dokumenttyp zugewiesen wurde
If oDocument.aObjectType.aName <> Objekttyp Then
' ihr den entsprechenden Dokumenttyp zuweisen
oDocument.aObjectType = Me.oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, Objekttyp)
' WMObject.aObjectType = Me.selectedProfile.Dokumenttyp
_Logger.Debug("Objekttyp '" & oDocument.aObjectType.aName & "' wurde in '" & Objekttyp & "' geändert.")
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
End If
'Jetzt jeden Indexwert durchlaufen
For Each aName As String In Indizes
indexname = aName
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = Me.oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, Indizes(i))
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
_Logger.Debug($"RunIndexing on Index [{aName}]...dwAttrType [{vType}]..")
' wenn in aValues an Position i ein Wert steht
If Me.IsNotEmpty(aValues(i)) Then
'If indexname = "Tournr" Then
' MsgBox("Index: " & indexname & vbNewLine & "wert: " & aValues(i), MsgBoxStyle.Information, "Index: " & aName.ToString)
'End If
'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
'_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.Info("Achtung: Value '" & value & "' kann nicht in Zahl konvertiert werden!")
frmNIHauptseite._MRKONVERT_FEHLER = 1
Else
frmNIHauptseite._MRKONVERT_FEHLER = 0
End If
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeFloat
_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeFixedPoint
'_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint")
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeBoolean
'_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeBoolean")
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeDate
'_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeDate")
'Dim _date As Date = value
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeTimeStamp
'_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp")
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeCurrency
' _Logger.Debug(">> Typ des windream-Indexes: WMObjectVariableValueTypeCurrency")
'Wegen currency muß ein eigenes Objekt vom typ Variant erzeugt werden
convertValue = Convert_IndexValue(vType, value)
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 = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeFloat
'_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFloat")
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeVariant
'_Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeVariant")
convertValue = Convert_IndexValue(vType, value)
Case WMObjectVariableValueTypeFulltext
' _Logger.Debug("Typ des windream-Indexes: WMObjectVariableValueTypeFulltext")
convertValue = Convert_IndexValue(vType, 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 4100
'Vektor Boolean
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 8204
' _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 8193
_Logger.Debug("Typ des WMIndexes: manuellerVolltext")
convertValue = Convert_IndexValue(vType, value)
Case 8
_Logger.Debug("Typ des WMIndexes: Vektor 8 Boolean")
vektor = True
Case Else
_Logger.Warn("Typ des windream-Indexes konnte nicht bestimmt werden!")
_Logger.Debug("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
' _Logger.Debug("Konvertierter Wert: '" & convertValue.ToString & "'")
' End If
'End If
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang #########konn#######################
'############################################################################################
If vektor = False Then
If convertValue.ToString Is Nothing = False Then
_Logger.Debug("oDocument.SetVariableValue(" & aName & ", " & convertValue & ")")
Try
convertValue = Convert_IndexValue(vType, value)
oDocument.SetVariableValue(aName, convertValue)
'Die Datei speichern
oDocument.Save()
Catch ex As Exception
If ex.Message.Contains("External edit not allowed:") Then
_Logger.Info("Achtung das Ändern des Indexes: '" & aName & "' ist nicht mehr erlaubt! Bitte überprüfen Sie Ihre Nachindexierungslogik und den Objekttyp.")
oDocument.Save()
Else
_Logger.Warn("Unvorhergesehener Fehler bei NonVektor-SetVariableValue:")
_Logger.Warn("Fehlermeldung:" & ex.Message)
oDocument.Save()
oDocument.unlock()
Return True
End If
End Try
'_Logger.Debug("Index '" & aName & "' wurde geschrieben")
Else
_Logger.Info("Kein Indexwert vorhanden")
End If
Else
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
_Logger.Debug("VEKTORFELD: Vorbereiten des Arrays")
Dim DS As DataSet
Dim DT_VEKTOR As DataTable
Dim DR As DataRow
Dim BS As New System.Windows.Forms.BindingSource
' --- DataSet zuweisen
DS = myDS
' --- Zugriff auf Tabelle
DT_VEKTOR = DS.Tables("TBVEKTOR_ARRAY")
' --- den Filter auf den Indexnamen setzen
BS.DataSource = DS
BS.DataMember = "TBVEKTOR_ARRAY"
BS.Filter = "IndexName = '" & aName.ToString & "'"
'For Each row As DataRow In DT.Rows
'MsgBox(aName & vbNewLine & row.Item("IndexName") & vbNewLine & CStr(row.Item("Value")))
'Next
Dim oAnzahl As Integer = BS.Count
'Vektorfeld wird mit EINEM Wert gefüllt
If oAnzahl = 1 Then
_Logger.Debug("Vektorfeld wird mit EINEM Wert gefüllt ")
ReDim myArray(0)
myArray(0) = Convert_IndexValue(vType, value)
'Jetzt überprüfen ob Werte in Vektorfeld angefügt oder überschrieben werden sollen
_Logger.Debug("Konvertierter Wert: " & myArray(0).ToString)
' das ausgewählte Profil in _selectedProfile laden
_selectedProfil = ClassNIProfile.getProfilByName(Profil)
If _selectedProfil Is Nothing = False Then
Me._selectedProfil._links.selectedLink = Me._selectedProfil._links.getLinkByIndex(aName)
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
Dim oVektorList As New List(Of String)
Select Case Me._selectedProfil._links.selectedLink.vktins_state
Case 1
_Logger.Debug("vektInsState = '1'")
oVektorList.Add(myArray(0))
Case 2 'Anfügen
_Logger.Debug("vektInsState = '2'-550")
oVektorList = Return_VektorArray(oDocument, aName, myArray, False, vType)
Case 3 'Anfügen mit DuplikatCheck
_Logger.Debug("vektInsState = '3'")
oVektorList = Return_VektorArray(oDocument, aName, myArray, True, vType)
End Select
If oVektorList Is Nothing = False Then
Try
ReDim myArray(oVektorList.Count - 1)
Dim oIndex As Integer = 0
For Each oString As String In oVektorList
myArray(oIndex) = Convert_IndexValue(vType, oString)
oIndex += 1
Next
Try
_Logger.Debug($"Vektortype is {vType}: Indexing with [{oVektorList.Count}] values!")
Catch ex As Exception
End Try
oDocument.SetVariableValue(aName, myArray)
'End If
_Logger.Debug("[SetVariableValue] für VEKTOR erfolgreich")
'Die Änderungen festsschreiben/speichern
oDocument.Save()
Catch ex As Exception
_Logger.Warn($"Unexpected error while indexing vectorfield [{aName}] - Error: [{ex.Message}]")
End Try
End If
Else
_Logger.Warn(">> Achtung: Der Link konnte nicht geladen werden - _selectedProfil._links.selectedLink is NOTHING")
End If
Else
_Logger.Warn(">> Achtung: Das Profil konnte nicht geladen werden - _selectedProfil is NOTHING")
End If
Else
_Logger.Debug("Vektorfeld wird mit MEHREREN Werten [oAnzahl] gefüllt ")
' das ausgewählte Profil in _selectedProfile laden
_selectedProfil = ClassNIProfile.getProfilByName(Profil)
'Die Größe des Arrays festlegen
ReDim myArray(oAnzahl - 1)
Dim i1 As Integer = 0
'Die Datatable durchlaufen und Werte für den Index in Array schreiben
For Each DR In DT_VEKTOR.Rows
If DR.Item("IndexName") = aName.ToString Then
myArray(i1) = Convert_IndexValue(vType, DR.Item("Value"))
_Logger.Debug("Value (" & i1 & "): '" & DR.Item("Value").ToString & "'")
i1 = i1 + 1
End If
Next
_Logger.Debug("Array wurde erfolgreich erzeugt")
If _selectedProfil Is Nothing = False Then
Me._selectedProfil._links.selectedLink = Me._selectedProfil._links.getLinkByIndex(aName)
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
Dim VektorArray
Select Case Me._selectedProfil._links.selectedLink.vktins_state
Case 1
_Logger.Debug("vektInsState = '1' - Vektovalues will be replaced")
Dim z As Integer = 0
Try
ReDim VektorArray(myArray.Length)
Catch ex As Exception
ReDim VektorArray(myArray.Count)
End Try
For Each oVectValue As Object In myArray
If oVectValue Is Nothing = False Then
'Das Array anpassen
ReDim Preserve VektorArray(z)
'Den Wert im Array speichern
VektorArray(z) = Convert_IndexValue(vType, oVectValue)
z += 1
End If
Next
Case 2 'Anfügen
_Logger.Debug("vektInsState = '2'-638")
VektorArray = Return_VektorArray(oDocument, aName, myArray, False, vType)
Case 3 'Anfügen mit DuplikatCheck
_Logger.Debug("vektInsState = '3'")
VektorArray = Return_VektorArray(oDocument, aName, myArray, True, vType)
End Select
If VektorArray Is Nothing = False Then
'Das Array wieder anpassen
Try
ReDim myArray(VektorArray.Length - 1)
Catch ex As Exception
ReDim myArray(VektorArray.count - 1)
End Try
Dim oIndex As Integer = 0
For Each oStr In VektorArray
myArray(oIndex) = oStr
oIndex += 1
Next
'Jetzt die Nachindexierung für Vektor-Felder
oDocument.SetVariableValue(aName, myArray)
_Logger.Debug("'SetVariableValue' für VEKTOR erfolgreich")
' oDocument.LockRights()
'Die Änderungen festsschreiben/speichern
oDocument.Save()
_Logger.Debug("Indexierung erfolgreich beendet (Save ...")
Else
If My.Settings.vLogErrorsonly = False Then _Logger.Info("Achtung: VektorArray Is NOTHING")
oDocument.Save()
Return True
End If
Else
_Logger.Warn(">> Achtung: Der Link konnte nicht geladen werden - _selectedProfil._links.selectedLink is NOTHING")
oDocument.Save()
Return True
End If
Else
_Logger.Warn(">> Achtung: Das Profil konnte nicht geladen werden - _selectedProfil is NOTHING")
oDocument.Save()
Return True
End If
End If
End If
Else
_Logger.Debug("Array der Indexwerte ist leer/Nothing - Keine Nachindexierung")
End If
i += 1
Next
oDocument.unlock()
_Logger.Debug(">> Unlock durchgeführt)")
Return False
Else
_Logger.Info(">> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
'oDocument.unlock()
Return True
End If
End If
Catch ex As Exception
_Logger.Error(ex)
If Not IsNothing(myArray) Then
Dim i1 As Integer = 0
For Each aValue As String In myArray
_Logger.Debug(String.Format(">> myArray Value({0}): " & aValue.ToString, i1))
i1 += 1
Next
End If
If My.Settings.vNIMailsenden = True Then
'email.Send_EMail("Fehler bei RunIndexing - Datei: " & oDocument.aName.ToString & "<br>Profilname: " & Profil & "<br>Fehler: " & ex.Message)
End If
oDocument.Save()
oDocument.unlock()
Return True
End Try
End Function
Private Function Return_VektorArray(ByVal oDocument As WMObject, vktIndexName As String, NIIndexe As Object, CheckDuplikat As Boolean, vType As Object)
Try
Dim missing As Boolean = False
Dim Anzahl As Integer = 0
Dim oValues As New List(Of String)
'Jeden Wert des Vektorfeldes durchlaufen
Dim oWMValue = oDocument.GetVariableValue(vktIndexName)
If oWMValue Is Nothing = False Then
'Nochmals prüfen ob wirklich Array
If oWMValue.GetType.ToString.Contains("System.Object") Then
'Keine Duplikatprüfung also einfach neues Array füllen
If CheckDuplikat = False Then
_Logger.Debug("Return_VektorArray: no duplicatecheck...")
If Not IsNothing(oWMValue) Then
Dim oWMValueArr() As Object
oWMValueArr = oWMValue
For Each oWMValueExisting As Object In oWMValueArr
Try
If oWMValueExisting Is Nothing = False Then
_Logger.Debug($"oWMValueExisting = [{oWMValueExisting.ToString}]")
Dim oconvertedvalue = Convert_IndexValue(vType, oWMValueExisting.ToString)
oValues.Add(oconvertedvalue)
Anzahl += 1
End If
Catch ex As Exception
_Logger.Warn($"Return_VektorArray: Could not convert value [{oWMValueExisting.ToString}] - {ex.Message}")
End Try
Next
_Logger.Debug($"...we got [{Anzahl}] existing values!")
End If
'Und jetzt den/die Neuen Wert(e) anfügen
For Each oNewValue As Object In NIIndexe
If oNewValue Is Nothing = False Then
_Logger.Debug($"oNewValue = [{oNewValue}]")
'Den Wert im Array speichern
oValues.Add(Convert_IndexValue(vType, oNewValue))
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 oWMValue
If WDValue Is Nothing = False Then
oValues.Add(Convert_IndexValue(vType, 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 oValues.Contains(NewValue) = False Then
oValues.Add(Convert_IndexValue(vType, NewValue))
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 oValues.Count > 0 Then
If oValues.Contains(NewValue) = False Then
oValues.Add(Convert_IndexValue(vType, NewValue))
Anzahl += 1
Else
_Logger.Debug(">> Value '" & NewValue.ToString & "' bereits in Array enthalten")
End If
Else 'Dererste Wert, also hinzufügen
oValues.Add(Convert_IndexValue(vType, NewValue))
Anzahl += 1
End If
Else
oValues.Add(Convert_IndexValue(vType, NewValue))
Anzahl += 1
End If
End If
Next
End If
Return oValues
Catch ex As Exception
_Logger.Warn($"Unexpected Error Return_VektorArray [{vktIndexName}] # ERROR: {ex.Message}")
_Logger.Debug($"Unexpected Error Return_VektorArray [{vktIndexName}] # ERROR: {ex.Message}")
End Try
End Function
Private Shared Function Convert_IndexValue(vType As Object, oIndexValue As String)
Select Case vType
Case 8
'Umwandeln in Boolean
oIndexValue = oIndexValue.ToString.Replace(" ", "")
Return CBool(oIndexValue)
Case WMObjectVariableValueTypeBoolean
oIndexValue = oIndexValue.ToString.Replace(" ", "")
Return CBool(oIndexValue)
Case 36865
'Umwandeln in String
Return CStr(oIndexValue)
Case 4097
'Umwandeln in String
Return CStr(oIndexValue)
Case 4098
'Umwandeln in Integer
oIndexValue = oIndexValue.ToString.Replace(" ", "")
Return CInt(oIndexValue)
Case WMObjectVariableValueTypeFixedPoint
oIndexValue = oIndexValue.ToString.Replace(" ", "")
Return CInt(oIndexValue)
Case 4099
Dim Str As String = oIndexValue
Str = Str.ToString.Replace(" ", "")
Str = Str.Replace(".", ",").Replace(" ", "")
'Umwandeln in Double
Return CDbl(Str)
Case WMObjectVariableValueTypeFloat
Dim Str As String = oIndexValue
Str = Str.ToString.Replace(" ", "")
Str = Str.Replace(".", ",").Replace(" ", "")
'Umwandeln in Double
Return CDbl(Str)
Case 4099
Dim Str As String = oIndexValue
Str = Str.ToString.Replace(" ", "")
Case 4100
'Umwandeln in Boolean
Return CBool(oIndexValue)
Case WMObjectVariableValueTypeDate
'Umwandeln in Date
Return CDate(oIndexValue)
Case 4101
'Umwandeln in Date
Return CDate(oIndexValue)
Case 4107
oIndexValue = oIndexValue.Replace(" ", "")
Return Convert.ToInt64(oIndexValue)
Case 4103
'Umwandeln in Datum Uhrzeit
Return oIndexValue
Case 8204
oIndexValue = oIndexValue.Replace(" ", "")
Return CInt(oIndexValue)
Case WMObjectVariableValueTypeCurrency
Dim aValueWrapper As System.Runtime.InteropServices.CurrencyWrapper = New System.Runtime.InteropServices.CurrencyWrapper(CDec(oIndexValue))
Return aValueWrapper
Case Else
'Umwandeln in String
Return CStr(oIndexValue)
End Select
End Function
Private Function AddToArray(ByVal myArray As Object, Anzahl As Integer, newvalue As Object)
'Das Array anpassen
ReDim Preserve myArray(Anzahl)
'Den Wert im Array speichern
myArray(Anzahl) = newvalue.ToString
Return myArray
End Function
Public Sub SetfinalIndex(ByVal oDocument As WMObject, ByVal Indexname As String, ByVal _state As Boolean)
Try
If Indexname IsNot Nothing Then
If Not oDocument.aLocked Then
oDocument.lock()
Dim i As Integer = 0
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = Me.oWMSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, Indexname)
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
'MsgBox("Typ: " & vType.ToString, MsgBoxStyle.Critical, "_state: " & _state.ToString)
' wenn in aValues an Position i ein Wert steht
If Me.IsNotEmpty(Indexname) Then
'MsgBox(oDocument.aName & vbNewLine & aValues(i) & vbNewLine & vType, MsgBoxStyle.Exclamation, "Zeile 87")
Dim value = _state
Dim convertValue
'Den Typ des Index-Feldes auslesen
_Logger.Debug("Typ des windream-Indexes: " & vType.ToString)
Select Case (vType)
Case WMObjectVariableValueTypeBoolean
convertValue = CBool(value)
Case Else
_Logger.Warn(" >> Typ des windream-Indexes ist nicht BOOLEAN also Abbruch:")
End Select
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
oDocument.SetVariableValue(Indexname, convertValue)
_Logger.Debug("Finaler Index '" & Indexname & "' wurde gesetzt")
oDocument.Save()
oDocument.unlock()
_Logger.Info(" >> DATEI wurde erfolgreich als fertig nachindexiert gekennzeichnet")
End If
Else
_Logger.Warn(" >> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
End If
End If
Catch ex As Exception
_Logger.Error(ex)
If My.Settings.vNIMailsenden = True Then
'email.Send_EMail("Fehler bei SetfinalIndex - Datei: " & oDocument.aName.ToString & " - Fehler: " & ex.Message)
End If
oDocument.Save()
oDocument.unlock()
End Try
End Sub
#End Region
#Region "+++++ Allgemeine Funktionen die Informationen zurückliefern +++++"
Public Function GetSearchDocuments(ByVal wdfLocation As String)
WMSearchIsSQL = False
wdfLocation = wdfLocation.Replace("W:", "\\windream\objects")
wdfLocation = wdfLocation.Replace("X:", "\\windream\objects")
wdfLocation = wdfLocation.Replace("U:", "\\windream\objects")
If System.IO.File.Exists(wdfLocation) Then
Try
Dim ProfileName = wdfLocation.Substring(wdfLocation.LastIndexOf("\") + 1)
Dim ProfilePath = wdfLocation.Substring(0, wdfLocation.Length - ProfileName.Length)
Me.oController.CheckSearchProfile(wdfLocation.ToLower)
Dim suchTyp = Me.oController.SearchProfileTargetProgID
Dim ExSettings As Object
Dim oSearch As Object
ExSettings = Me.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")
'' 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", Me.GetCurrentServer)
'Me.oConnect.LoginSession(oWMSession) 'srchQuick.WMSession)
srchQuick.ClearSearch()
srchQuick.SearchProfilePath = ProfilePath
srchQuick.LoadSearchProfile(ProfileName)
oSearch = srchQuick.GetSearch()
Case "WMOSRCH.WMINDEXSEARCH"
srchIndex.WMSession = oWMSession 'CreateObject("Windream.WMSession", Me.GetCurrentServer)
'Me.oConnect.LoginSession(srchIndex.WMSession)
srchIndex.ClearSearch()
srchIndex.SearchProfilePath = ProfilePath
srchIndex.LoadSearchProfile(ProfileName)
oSearch = srchIndex.GetSearch()
Case "WMOSRCH.WMOBJECTTYPESEARCH"
srchObjectType.WMSession = oWMSession 'CreateObject("Windream.WMSession", Me.GetCurrentServer)
'Me.oConnect.LoginSession(oWMSession) 'srchObjectType.WMSession)
srchObjectType.ClearSearch()
srchObjectType.SearchProfilePath = ProfilePath
srchObjectType.LoadSearchProfile(ProfileName)
oSearch = srchObjectType.GetSearch()
Case Else
_Logger.Debug("KEIN GÜLTIGER WINDREAM-SUCHTYP")
Return Nothing
End Select
'Dim WMObjects As Object
_Logger.Debug("Start der Suche: " & Now)
' System.Threading.Thread.Sleep(200000)
'WMObjects = oSearch.Execute
Return oSearch.execute
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei machen
_Logger.Error(ex)
Return Nothing
End Try
Else
If wdfLocation.ToUpper.Contains("SELECT") Or wdfLocation.ToUpper.Contains("EXEC") Then
WMSearchIsSQL = True
End If
End If
Return Nothing
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
Public Function NEW_MOVE_FILE(targetpath As String, sourcepath As String, oMethod As String) As Boolean
Dim oWMFile As WINDREAMLib.WMObject
Try
If My.Settings.vLogErrorsonly = False Then
_Logger.Info($"targetpath ({targetpath})")
_Logger.Info($"sourcepath ({sourcepath})")
End If
Dim sw As New ClassStopwatch("NEW_MOVE_FILE")
Dim oTargetpath = System.IO.Path.GetDirectoryName(targetpath)
oTargetpath = oTargetpath.Replace("\\windream\objects", "")
oTargetpath = oTargetpath.Replace("W:\", "\")
targetpath = targetpath.Replace("\\windream\objects", "")
targetpath = targetpath.Replace("W:\", "\")
sourcepath = sourcepath.Replace("\\windream\objects", "")
sourcepath = sourcepath.Replace("W:\", "\")
Const WMEntityDocument = 1
Dim IndexwertAusWindream As Object = Nothing
oWMFile = oWMSession.GetWMObjectByPath(WMEntityDocument, sourcepath)
If oWMFile.lock Then
oWMFile.aPath = targetpath
oWMFile.Save()
oWMFile.unlock()
_Logger.Info($"NEW_MOVE_FILE ({oMethod}): file has been moved - target: '" & targetpath & "'")
Dim msg = sw.Done
If msg <> String.Empty Then _Logger.Debug(msg)
Return True
Else
Dim msg = sw.Done
If msg <> String.Empty Then _Logger.Debug(msg)
Return False
End If
Catch ex As Exception
_Logger.Error(ex)
If Not IsNothing(oWMFile) Then
oWMFile.unlock()
End If
Return False
End Try
End Function
#End Region
End Class