ToolCollection/ToolCollection/ClassNIWindream.vb
Digital Data - Marlon Schreiber f8bf313d71 ms
2017-10-06 10:32:19 +02:00

994 lines
59 KiB
VB.net

Imports WINDREAMLib
Imports WMOSRCHLib
Public Class ClassNIWindream
Inherits ClassWindream_allgemein
Private email As New ClassNIEmail
Private _selectedProfil As ClassNIProfil
#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()
MyBase.New()
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 Shared Function GetIndex_Type(idxName) As String
Try
Dim oAttribute = ClassNIWindream.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 = "Variant"
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 4104
Type = "Vektor Währung"
Case 4107
Type = "Vektor Integer(64bit)"
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())
Dim myArray
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
ClassLoggerNI.Add(" >> RunIndexing_Vektor: Indexwert ist leer/Nothing - Keine Nachindexierung", False)
Else
'Jetzt jeden Indexwert durchlaufen
Dim indexname As String
indexname = Indizes(0)
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: Indexname: " & indexname, False)
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: VEKTORFELD-Indexierung: Vorbereiten des Arrays", False)
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = Me.oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname)
' den Variablentyp (String, Integer, ...) auslesen
Dim vType = oAttribute.getVariableValue("dwAttrType")
Select Case (vType)
Case 4097
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4097 Vektor alphanumerisch", False)
Case 4098
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4098 Vektor Numerisch", False)
Case 4099
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4099 Vektor Kommazahl", False)
Case 4101
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4101 Vektor Date", False)
Case 4103
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4103 Vektor DateTime", False)
Case 4107
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4107 Vektor Integer(64bit)", False)
Case 36865
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 36865 Vektor alphanumerisch", False)
End Select
Dim Anzahl As Integer = aValues.Length - 1
'Vektorfeld wird mit EINEM Wert gefüllt
If Anzahl = 0 Then
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: Vektorfeld wird mit EINEM Wert gefüllt ", False)
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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: Konvertierter Wert: " & myArray(0).ToString, False)
Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: Vektorfeld wird mit MEHREREN Werten gefüllt ", False)
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 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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Wert muss in Int64 konvertiert werden", False)
convertValue = Convert.ToInt64(wert) 'ToInt64
End Try
Else
' ClassLoggerNI.Add(" - Indexierungswert '" & wert.ToString & "' kann nicht in Integer konvertiert werden", False)
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
Catch ex As Exception
ClassLoggerNI.Add("## Error in converting array with more values - error: " & ex.Message)
'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)
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: 'SetVariableValue' für VEKTOR erfolgreich", False)
oDocument.Save()
oDocument.unlock()
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> RunIndexing_Vektor: Indexierung erfolgreich beendet (Save und Unlock durchgeführt)", False)
Return True
End If
Else
ClassLoggerNI.Add(" >> RunIndexing_Vektor: Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!", False)
Return False
End If
End If
Catch ex As Exception
ClassLoggerNI.Add("## Unexpected Error in RunIndexing_Vektor - error: " & ex.Message)
If Not IsNothing(myArray) Then
Dim i1 As Integer = 0
For Each aValue As String In myArray
ClassLoggerNI.Add(String.Format(">> myArray Value({0}): " & aValue.ToString, i1), False)
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
ClassLoggerNI.Add("ACHTUNG: Fehler bei Locken der Archivierten Datei (ClassNiWindream.RunIndexing): " & ex1.Message, True)
Return True
End Try
Else
Try
oDocument.lock()
Catch ex As Exception
If ex.Message.Contains("Object not editable in mode") Then
Try
'ClassLoggerNI.Add(" >> Ergebnis CStr(dwflag): " & CStr(dwflag) & " - Versuch die Datei mit erweitertem Modus zu locken!", False)
oDocument.LockFor(CLng(WMObjectEditModeChangeArchivedIndex))
Catch exlock2 As Exception
ClassLoggerNI.Add("ACHTUNG: Fehler bei Locken der Datei mit erweitertem Modus WMobjectEMCArchived: " & exlock2.Message, True)
ClassLoggerNI.Add(" >>Ergebnis CStr(dwflag): " & CStr(dwflag), False)
Return True
End Try
Else
ClassLoggerNI.Add("ACHTUNG: Fehler bei Locken der Datei (ClassNiWindream.RunIndexing): " & ex.Message, True)
ClassLoggerNI.Add("Ergebnis CStr(dwflag): " & CStr(dwflag), False)
Return True
End If
End Try
End If
Dim i As Integer = 0
Dim indexname As String
If aValues.Length = 1 And aValues(0) = "" Then
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Indexwert ist leer/Nothing - Keine Nachindexierung", False)
End If
' wenn der Datei noch kein Dokumenttyp zugewiesen wurde
If oDocument.aObjectType.aName <> Objekttyp Then
' ihr den entsprechenden Dokumenttyp zuweisen
oDocument.aObjectType = Me.oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, Objekttyp)
' WMObject.aObjectType = Me.selectedProfile.Dokumenttyp
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Objekttyp '" & oDocument.aObjectType.aName & "' wurde in '" & Objekttyp & "' geändert.", False)
Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Objekttyp war bereits gesetzt", False)
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
If My.Settings.vLogErrorsonly = False Then
ClassLoggerNI.Add(" ", False)
ClassLoggerNI.Add(" >> Indexierung von Index '" & indexname & "'", False)
End If
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = Me.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 Me.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
'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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeString", False)
convertValue = CStr(value)
Case WMObjectVariableValueTypeInteger
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeInteger", False)
value = value.ToString.Replace(" ", "")
If IsNumeric(value) = False Then
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Achtung: Value '" & value & "' kann nicht in Zahl konvertiert werden!", False)
frmNIHauptseite._MRKONVERT_FEHLER = 1
Else
frmNIHauptseite._MRKONVERT_FEHLER = 0
End If
value = value.ToString.Replace(" ", "")
convertValue = CInt(value)
_int = True
Case WMObjectVariableValueTypeFloat
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFloat", False)
value = value.ToString.Replace(" ", "")
convertValue = CDbl(value)
Case WMObjectVariableValueTypeFixedPoint
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint", False)
value = value.ToString.Replace(" ", "")
convertValue = CDbl(value)
_dbl = True
Case WMObjectVariableValueTypeBoolean
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeBoolean", False)
convertValue = CBool(value)
_bool = True
Case WMObjectVariableValueTypeDate
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeDate", False)
_date = True
'Dim _date As Date = value
convertValue = value
Case WMObjectVariableValueTypeTimeStamp
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp", False)
convertValue = CDbl(value)
Case WMObjectVariableValueTypeCurrency
ClassLoggerNI.Add(">> Typ des windream-Indexes: WMObjectVariableValueTypeCurrency", False)
'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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeTime", False)
'If ((value)) Then
' convertValue = CDate(value)
'Else
' convertValue = ""
'End If
'Dim _date As Date = value
convertValue = convertValue '*_date.ToShortTimeString
Case WMObjectVariableValueTypeFloat
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFloat", False)
convertValue = CStr(value)
Case WMObjectVariableValueTypeVariant
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeVariant", False)
convertValue = CStr(value)
Case WMObjectVariableValueTypeFulltext
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFulltext", False)
convertValue = CStr(value)
Case 4097
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4097 Vektor alphanumerisch", False)
'Vektor alphanumerisch
vektor = True
Case 4098
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4098 Vektor Numerisch", False)
'Vektor Numerisch
vektor = True
Case 4099
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4099 Vektor Kommazahl", False)
'Vektor Kommazahl
vektor = True
Case 4101
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4101 Vektor Date", False)
'Vektor Kommazahl
vektor = True
Case 4103
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4103 Vektor DateTime", False)
'Vektor DateTime
vektor = True
Case 4107
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 4107 Integer 64bit", False)
vektor = True
Case 36865
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: 36865 Vektor alphanumerisch", False)
'Vektor Kommazahl
vektor = True
Case Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes konnte nicht bestimmt werden!", False)
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> 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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Konvertierter Wert: '" & convertValue.ToString & "'", False)
End If
End If
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
'############################################################################################
If vektor = False Then
If convertValue.ToString Is Nothing = False Then
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Versuch dem Dok einen Index zuzuweisen: oDocument.SetVariableValue(" & aName & ", " & convertValue & ")", False)
Try
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
'Die Datei speichern
oDocument.Save()
Catch ex As Exception
If ex.Message.Contains("External edit not allowed:") Then
ClassLoggerNI.Add("Achtung das Ändern des Indexes: '" & aName & "' ist nicht mehr erlaubt! Bitte überprüfen Sie Ihre Nachindexierungslogik und den Objekttyp.", False)
oDocument.Save()
Else
ClassLoggerNI.Add("Unvorhergesehener Fehler bei NonVektor-SetVariableValue:", True)
ClassLoggerNI.Add("Fehlermeldung:" & ex.Message, True)
oDocument.Save()
oDocument.unlock()
Return True
End If
End Try
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Index '" & aName & "' wurde geschrieben", False)
Else
ClassLoggerNI.Add(" >> Kein Indexwert vorhanden", False)
End If
Else
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> VEKTORFELD: Vorbereiten des Arrays", False)
Dim DS As DataSet
Dim DT As DataTable
Dim DR As DataRow
Dim BS As New System.Windows.Forms.BindingSource
' --- DataSet zuweisen
DS = myDS
' --- Zugriff auf Tabelle
DT = 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("Wert")))
'Next
Dim Anzahl As Integer = BS.Count
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Anzahl Vektorwerte: " & Anzahl.ToString, False)
'Vektorfeld wird mit EINEM Wert gefüllt
Dim temp_arr As New ArrayList
If Anzahl = 1 Then
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Vektorfeld wird mit EINEM Wert gefüllt ", False)
ReDim myArray(0)
myArray(0) = Convert_VectorType(vType, value)
'Jetzt überprüfen ob Werte in Vektorfeld angefügt oder überschrieben werden sollen
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Konvertierter Wert: " & myArray(0).ToString, False)
' 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 VektorArray
Select Case Me._selectedProfil._links.selectedLink.vktins_state
Case 1
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> vektInsState = '1'", False)
ReDim Preserve VektorArray(0)
VektorArray(0) = myArray(0)
Case 2 'Anfügen
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> vektInsState = '2'", False)
VektorArray = Return_VektorArray(oDocument, aName, myArray, False, vType)
Case 3 'Anfügen mit DuplikatCheck
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> vektInsState = '3'", False)
VektorArray = Return_VektorArray(oDocument, aName, myArray, True, vType)
End Select
If VektorArray Is Nothing = False Then
ReDim myArray(VektorArray.Length - 1)
Array.Copy(VektorArray, myArray, VektorArray.Length)
'Jetzt die Nachindexierung für Vektor-Felder
If BS.Count = 1 Then
If vType = 4097 Then
Dim strArray()
ReDim Preserve strArray(0)
strArray(0) = myArray(0)
temp_arr.Add(CStr(myArray(0)))
oDocument.SetVariableValue(aName, strArray)
ElseIf vType = 4098 Then
temp_arr.Add(CInt(myArray(0)))
If temp_arr.Count > 0 Then
If My.Settings.vLogErrorsonly = False Then ClassLoggerDI.Add("- Einträge in temp_arr also Speichern des Arrays in convertValue", False)
convertValue = Nothing
convertValue = temp_arr.ToArray
Else
convertValue = vbEmpty
End If
' den konvertierten Indexwert dem entsprechenden Index zuweisen
oDocument.SetVariableValue(aName, convertValue)
Else
oDocument.SetVariableValue(aName, myArray(0))
End If
Else
oDocument.SetVariableValue(aName, myArray)
End If
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> 'SetVariableValue' für VEKTOR mit einem Wert erfolgreich", False)
'Die Änderungen festsschreiben/speichern
oDocument.Save()
End If
Else
ClassLoggerNI.Add(">> Achtung: Der Link konnte nicht geladen werden - _selectedProfil._links.selectedLink is NOTHING", False)
End If
Else
ClassLoggerNI.Add(">> Achtung: Das Profil konnte nicht geladen werden - _selectedProfil is NOTHING", False)
End If
Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> (RI) Vektorfeld wird mit MEHREREN Werten gefüllt ", False)
' das ausgewählte Profil in _selectedProfile laden
_selectedProfil = ClassNIProfile.getProfilByName(Profil)
'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 DR In DT.Rows
If DR.Item("Indexname") = aName.ToString Then
If vType = 4098 Then
myArray(i1) = CInt(DR.Item("Wert"))
ElseIf vType = 4101 Then
myArray(i1) = CDate(DR.Item("Wert"))
Else
myArray(i1) = CStr(DR.Item("Wert"))
End If
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Value (" & i1 & "): '" & DR.Item("Wert").ToString & "'", False)
i1 = i1 + 1
End If
Next
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Array wurde erfolgreich erzeugt", False)
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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> vektInsState = '1'", False)
Dim z As Integer = 0
ReDim VektorArray(myArray.Length)
For Each str As Object In myArray
If str Is Nothing = False Then
'Das Array anpassen
ReDim Preserve VektorArray(z)
'Den Wert im Array speichern
If vType = 4098 Then
VektorArray(z) = CInt(str)
Else
VektorArray(z) = str
End If
z += 1
End If
Next
Case 2 'Anfügen
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> vektInsState = '2'", False)
VektorArray = Return_VektorArray(oDocument, aName, myArray, False, vType)
Case 3 'Anfügen mit DuplikatCheck
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> vektInsState = '3'", False)
VektorArray = Return_VektorArray(oDocument, aName, myArray, True, vType)
End Select
If VektorArray Is Nothing = False Then
'Das Array wieder anpassen
ReDim myArray(VektorArray.Length - 1)
Array.Copy(VektorArray, myArray, VektorArray.Length)
'Jetzt die Nachindexierung für Vektor-Felder
oDocument.SetVariableValue(aName, myArray)
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> 'SetVariableValue' für VEKTOR erfolgreich", False)
' oDocument.LockRights()
'Die Änderungen festsschreiben/speichern
oDocument.Save()
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Indexierung erfolgreich beendet (Save ...", False)
Else
ClassLoggerNI.Add(">> Achtung: VektorArray Is NOTHING", False)
oDocument.Save()
Return True
End If
Else
ClassLoggerNI.Add(">> Achtung: Der Link konnte nicht geladen werden - _selectedProfil._links.selectedLink is NOTHING", False)
oDocument.Save()
Return True
End If
Else
ClassLoggerNI.Add(">> Achtung: Das Profil konnte nicht geladen werden - _selectedProfil is NOTHING", False)
oDocument.Save()
Return True
End If
End If
End If
Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Array der Indexwerte ist leer/Nothing - Keine Nachindexierung", False)
End If
i += 1
Next
oDocument.unlock()
If My.Settings.vLogErrorsonly = False Then
ClassLoggerNI.Add(" >> Unlock durchgeführt)", False)
ClassLoggerNI.Add("", False)
End If
Return False
Else
ClassLoggerNI.Add(" >> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!", False)
'oDocument.unlock()
Return True
End If
End If
Catch ex As Exception
ClassLoggerNI.Add("ACHTUNG: Unvohergesehener Fehler in ClassNiWindream.RunIndexing: " & ex.Message, True)
If Not IsNothing(myArray) Then
Dim i1 As Integer = 0
For Each aValue As String In myArray
ClassLoggerNI.Add(String.Format(">> myArray Value({0}): " & aValue.ToString, i1), False)
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 ValueArray()
'Jeden Wert des Vektorfeldes durchlaufen
Dim wertWD = oDocument.GetVariableValue(vktIndexName)
If wertWD Is Nothing = False Then
'Nochmals prüfen ob wirklich Array
If wertWD.GetType.ToString.Contains("System.Object") Then
'Keine Duplikatprüfung also einfach neues Array füllen
If CheckDuplikat = False Then
For Each value As Object In wertWD
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = Convert_VectorType(vType, value)
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) = Convert_VectorType(vType, NewValue)
Anzahl += 1
End If
Next
Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Duplikatprüfung soll durchgeführt werden.", False)
'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) = Convert_VectorType(vType, WDValue)
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
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = Convert_VectorType(vType, NewValue)
Anzahl += 1
Else
ClassLoggerNI.Add(" >> Value '" & NewValue.ToString & "' bereits in Vektorfeld enthalten", False)
End If
End If
Next
End If
End If
Else
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Vektorfeld ist noch leer....", False)
'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) = Convert_VectorType(vType, NewValue)
Anzahl += 1
Else
ClassLoggerNI.Add(" >> Value '" & NewValue.ToString & "' bereits in Array enthalten", False)
End If
Else 'Dererste Wert, also hinzufügen
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = Convert_VectorType(vType, NewValue)
Anzahl += 1
End If
Else
'Das Array anpassen
ReDim Preserve ValueArray(Anzahl)
'Den Wert im Array speichern
ValueArray(Anzahl) = Convert_VectorType(vType, NewValue)
Anzahl += 1
End If
End If
Next
End If
Return ValueArray
Catch ex As Exception
ClassLoggerNI.Add("ClassNiWindream.Return_VektorArray", ex)
End Try
End Function
Private Shared Function Convert_VectorType(vType As Object, value As String)
Select Case vType
Case 36865
'Umwandeln in String
Return CStr(value)
Case 4097
'Umwandeln in String
Return CStr(value)
Case 4098
'Umwandeln in Integer
value = value.ToString.Replace(" ", "")
Return CInt(value)
Case 4099
Dim Str As String = value
Str = Str.ToString.Replace(" ", "")
'Umwandeln in Double
Return CDbl(Str.Replace(".", ","))
Case 4101
'Umwandeln in Date
Return CDate(value)
Case 4107
Return Convert.ToInt64(value)
Case 4103
'Umwandeln in Datum Uhrzeit
Return value
Case Else
'Umwandeln in String
Return CStr(value)
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.oSession.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
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Typ des windream-Indexes: " & vType.ToString)
Select Case (vType)
Case WMObjectVariableValueTypeBoolean
convertValue = CBool(value)
Case Else
ClassLoggerNI.Add(" >> Typ des windream-Indexes ist nicht BOOLEAN also Abbruch:")
End Select
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
oDocument.SetVariableValue(Indexname, convertValue)
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Finaler Index '" & Indexname & "' wurde gesetzt")
oDocument.Save()
oDocument.unlock()
ClassLoggerNI.Add(" >> DATEI wurde erfolgreich als fertig nachindexiert gekennzeichnet")
End If
Else
ClassLoggerNI.Add(" >> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
End If
End If
Catch ex As Exception
ClassLoggerNI.Add("ClassSearchResult.SetfinalIndex", 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)
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(srchQuick.WMSession)
srchQuick.ClearSearch()
srchQuick.SearchProfilePath = ProfilePath
srchQuick.LoadSearchProfile(ProfileName)
oSearch = srchQuick.GetSearch()
Case "WMOSRCH.WMINDEXSEARCH"
srchIndex.WMSession = 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 = CreateObject("Windream.WMSession", Me.GetCurrentServer)
Me.oConnect.LoginSession(srchObjectType.WMSession)
srchObjectType.ClearSearch()
srchObjectType.SearchProfilePath = ProfilePath
srchObjectType.LoadSearchProfile(ProfileName)
oSearch = srchObjectType.GetSearch()
Case Else
ClassLoggerNI.Add("KEIN GÜLTIGER WINDREAM-SUCHTYP")
Return Nothing
End Select
Dim WMObjects As Object
If My.Settings.vLogErrorsonly = False Then ClassLoggerNI.Add(" >> Start der Suche: " & Now, False)
' System.Threading.Thread.Sleep(200000)
WMObjects = oSearch.Execute
Return oSearch.execute
Catch ex As Exception
' bei einem Fehler einen Eintrag in der Logdatei machen
ClassLoggerNI.Add("Fehler in GetSearchDocuments()", ex)
Return Nothing
End Try
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 = oSession.GetWMObjectByPath(WMEntityDocument, _fullfilepath) 'WINDREAMLib.WMEntity.WMEntityDocument
IndexwertAusWindream = _dok.GetVariableValue(_indexname)
Return IndexwertAusWindream.ToString
Catch ex As Exception
'MsgBox(ex.Message)
Return Nothing
End Try
End Function
#End Region
End Class