Imports WINDREAMLib
Imports WMOSRCHLib
Public Class ClassPMWindream
Inherits ClassWindream_allgemein
Dim clsWM As ClassWindream_allgemein
'Private email As New ClassNIEmail
Private allgFunk As New ClassAllgemeineFunktionen
#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
Const WMObjectEditModeIndexEdit = &H3DA
#End Region
#Region "+++++ Variablen +++++"
Private oController As New WMOSearchController
#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
Return True
'If TypeOf aValue Is String Then
' ' Änderung 28.08.2018: Auch ein leerer String gilt als Wert, damit indexfelder auch geleert werden können
' '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 GetValuesfromAuswahlliste(ByVal listname As String)
Try
'Dim oAttribute = Me.oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, listname)
'Dim vType = oAttribute.getVariableValue("vItems")
'Return vType
Dim oChoiceList = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityChoiceList, listname)
If Err.Number = 0 And TypeName(oChoiceList) <> "Nothing" Then
Dim Values = oChoiceList
Values = oChoiceList.GetVariableValue("vItems")
Dim anz As Integer = 0
For Each CLItem In Values
If oChoiceList.aName IsNot Nothing Then
anz += 1
End If
Next
Dim strListe(anz - 1)
Dim zahl As Integer = 0
For Each CLItem In Values
If oChoiceList.aName IsNot Nothing Then
strListe(zahl) = CLItem
zahl += 1
End If
Next
Return strListe
Else
MsgBox("Auswahlliste: " & listname & " nicht gefunden!", MsgBoxStyle.Critical, "Fehler:")
Return Nothing
End If
Catch ex As Exception
LOGGER.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in GetValuesfromAuswahlliste:")
Return Nothing
End Try
End Function
Public Function Return_Type(Indexname As String)
Try
' 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")
Return vType.ToString
Catch ex As Exception
LOGGER.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in Return_Type:")
Return ""
End Try
End Function
Public Function RunIndexing(ByVal oDocument As WMObject, ByVal Indizes() As String, ByVal aValues() As Object)
Dim vType
Try
If Indizes IsNot Nothing And aValues IsNot Nothing Then
If Not oDocument.aLocked Then
' 02.07. Änderung der Lock Methode, um eine Validierung auch zuzulassen, wenn das Recht "Datei ändern"
' nicht gesetzt ist
'oDocument.lock()
oDocument.LockFor(WMObjectEditModeIndexEdit)
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", False)
End If
'Jetzt jeden Indexwert durchlaufen
For Each aName As String In Indizes
indexname = aName
' das entsprechende Attribut aus windream auslesen
Dim oAttribute = Me.oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, Indizes(i))
' den Variablentyp (String, Integer, ...) auslesen
vType = oAttribute.getVariableValue("dwAttrType")
' wenn in aValues an Position i ein Wert steht
If IsNotEmpty(aValues(i)) Then
Dim _int As Boolean = False
Dim _date As Boolean = False
Dim _dbl As Boolean = False
Dim _bool As Boolean = False
'If indexname = "Tournr" Then
' MsgBox("Index: " & indexname & vbNewLine & "wert: " & aValues(i), MsgBoxStyle.Information, "Index: " & aName.ToString)
'End If
LOGGER.Debug(" ### Indexierung von Index: " & indexname & " ####", False)
'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", False)
convertValue = CStr(value)
Case WMObjectVariableValueTypeInteger
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeInteger", False)
If IsNumeric(value) = False Then
frmValidator.idxerr_message = "Unerlaubte Eingabe in Numerisches Feld: " & value
LOGGER.Debug(" >> Achtung: Value " & value & " kann nicht in Zahl konvertiert werden!", False)
oDocument.Save()
oDocument.unlock()
Return False
End If
convertValue = CInt(value)
_int = True
Case WMObjectVariableValueTypeFloat
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFloat", False)
Try
convertValue = CDbl(value)
Catch ex As Exception
LOGGER.Error(ex)
frmValidator.idxerr_message = "Could't convert value '" & value & "' to double!"
oDocument.Save()
oDocument.unlock()
Return False
End Try
Case WMObjectVariableValueTypeFixedPoint
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint", False)
Try
convertValue = CDbl(value)
Catch ex As Exception
LOGGER.Error(ex)
frmValidator.idxerr_message = "Could't convert value '" & value & "' to double!"
oDocument.Save()
oDocument.unlock()
Return False
End Try
_dbl = True
Case WMObjectVariableValueTypeBoolean
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeBoolean", False)
convertValue = CBool(value)
_bool = True
Case WMObjectVariableValueTypeDate
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeDate", False)
_date = True
'Dim _date As Date = value
convertValue = value
Case WMObjectVariableValueTypeTimeStamp
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp", False)
convertValue = CInt(value)
Case WMObjectVariableValueTypeCurrency
LOGGER.Info(" >> 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
LOGGER.Debug(" >> 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
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFloat", False)
convertValue = CStr(value)
Case WMObjectVariableValueTypeVariant
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeVariant", False)
convertValue = CStr(value)
Case WMObjectVariableValueTypeFulltext
LOGGER.Debug(" >> Typ des windream-Indexes: WMObjectVariableValueTypeFulltext", False)
convertValue = CStr(value)
Case 4100
LOGGER.Debug(" >> Typ des windream-Indexes: 4100 Vektor Boolean", False)
vektor = True
Case 4101
LOGGER.Debug(" >> Typ des windream-Indexes: 4101 Vektor Date", False)
vektor = True
Case 4104
LOGGER.Debug(" >> Typ des windream-Indexes: 4104 Vektor Currency", False)
vektor = True
Case 4097
LOGGER.Debug(" >> Typ des windream-Indexes: 4097 Vektor alphanumerisch", False)
vektor = True
Case 4098
LOGGER.Debug(" >> Typ des windream-Indexes: 4098 Vektor Numerisch", False)
vektor = True
Case 4099
LOGGER.Debug(" >> Typ des windream-Indexes: 4099 Vektor Kommazahl", False)
vektor = True
Case 36865
LOGGER.Debug(" >> Typ des windream-Indexes: 36865 Vektor alphanumerisch", False)
vektor = True
Case Else
LOGGER.Debug(" >> Typ des windream-Indexes konnte nicht bestimmt werden!", False)
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 & "'", False)
End If
End If
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
'############################################################################################
If vektor = False Then
If convertValue.ToString Is Nothing = False Then
Try
LOGGER.Debug(" >> Jetzt indexieren: oDocument.SetVariableValue(" & aName & ", " & convertValue.ToString & ")", False)
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(" >> Unexpected Error in Logging SetVariableValue for " & aName & ": " & ex.Message, False)
End Try
'Dim ArrValues()
'ReDim ArrValues(0)
'ArrValues(0) = convertValue
'Dim ArrName()
'ReDim ArrName(0)
'ArrName(0) = "Tournr"
'oDocument.SetValues(ArrName, ArrValues)
If _int = True Then
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
oDocument.SetVariableValue(aName, CDbl(convertValue))
Else
oDocument.SetVariableValue(aName, convertValue)
End If
LOGGER.Debug(" >> Index '" & aName & "' wurde geschrieben", False)
Else
LOGGER.Info(" >> Kein Indexwert vorhanden", False)
End If
Else
'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST
LOGGER.Debug(" >> VEKTORFELD: Vorbereiten des Arrays", False)
Dim myArray()
'Dim anz As Integer = 0
'For Each obj In aValues
'ReDim Preserve myArray(anz)
Select Case vType
Case 4100
'Vektortyp Boolean
'Umwandeln in Boolean
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
Select Case obj.ToString.ToLower
Case "falsch"
obj = False
Case "wahr"
obj = True
Case "nein"
obj = False
Case "ja"
obj = True
End Select
myArray(i1) = CBool(obj)
i1 = i1 + 1
Next
Case 4101
'Vektortyp Date
'Umwandeln in String
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
myArray(i1) = CDate(obj)
i1 = i1 + 1
Next
Case 4104
'Vektortyp Currency
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
Dim aValueWrapper As System.Runtime.InteropServices.CurrencyWrapper = New System.Runtime.InteropServices.CurrencyWrapper(CDec(obj))
myArray(i1) = aValueWrapper
i1 = i1 + 1
Next
Case 4097
'Vektortyp ALPHANUMERISCH
'Umwandeln in String
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
myArray(i1) = CStr(obj)
i1 = i1 + 1
Next
Case 4098
'Umwandeln in Integer
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
myArray(i1) = CInt(obj)
i1 = i1 + 1
Next
Case 4099
'Umwandeln in Double
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
Dim Str As String = obj
myArray(i1) = CDbl(Str.Replace(".", ","))
i1 = i1 + 1
Next
Case 36865
'Umwandeln in String
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
myArray(i1) = CStr(obj)
i1 = i1 + 1
Next
Case Else
'Umwandeln in String
'Die Größe des Arrays festlegen
ReDim myArray(aValues.Length - 1)
Dim i1 As Integer = 0
'Das Array durchlaufen und Werte für den Index in Array schreiben
For Each obj In aValues
myArray(i1) = CStr(obj)
i1 = i1 + 1
Next
End Select
'Jetzt die Nachindexierung für Vektor-Felder
oDocument.SetVariableValue(aName, myArray)
LOGGER.Debug(" >> 'SetVariableValue' für VEKTOR erfolgreich", False)
End If
End If
i += 1
Next
' oDocument.LockRights()
'SetRights(WMObject, User)
oDocument.Save()
oDocument.unlock()
LOGGER.Debug(" ### Indexierung erfolgreich beendet (Save und Unlock durchgeführt) ###", False)
Return True
Else
LOGGER.Info(" ### Dokument ist gesperrt, Indexierung nicht möglich! ###", False)
frmValidator.idxerr_message = "Dokument " & oDocument.aName & " ist gesperrt, Indexierung nicht möglich"
Return False
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("ClassSearchResult.RunIndexing - " & ex.Message, True)
frmValidator.idxerr_message = "Unvorhergesehener Fehler in Indexing: " & ex.Message & vbNewLine & "vType: " & vType.ToString
allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Unvorhergesehener Fehler beim Indexieren der Datei: " & oDocument.aName & " - ERROR: " & ex.Message, Environment.UserName)
oDocument.Save()
oDocument.unlock()
Return False
End Try
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.LockFor(WMObjectEditModeIndexEdit)
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
'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.Info(">> Typ des windream-Indexes ist nicht BOOLEAN also Abbruch:")
End Select
'############################################################################################
'####################### Der eigentliche Indexierungsvorgang ################################
oDocument.SetVariableValue(Indexname, convertValue)
LOGGER.Debug(">> Index '" & Indexname & "' wurde gesetzt")
oDocument.Save()
oDocument.unlock()
LOGGER.Info(">> DATEI wurde erfolgreich als fertig nachindexiert gekennzeichnet")
Else
LOGGER.Info(">> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!")
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("ClassSearchResult.SetfinalIndex - " & ex.Message, True)
'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 Get_No_Documents(Profil As String, WD_Search As String)
Try
Dim wmsearch_exists As Boolean
Try
wmsearch_exists = System.IO.File.Exists(WD_Search)
Catch ex As Exception
LOGGER.Error(ex)
wmsearch_exists = clsWM.CheckFileExists(WD_Search)
End Try
If wmsearch_exists = False Then
LOGGER.Info(">> Windream Suche für Profil: '" & Profil & "' konnte nicht ausgeführt werden! Die Datei '" & WD_Search & "' existiert nicht!", False)
MsgBox("Windream Suche für Profil: '" & Profil & "' konnte nicht ausgeführt werden!" & vbNewLine & "Die Datei '" & WD_Search & "' existiert nicht!", MsgBoxStyle.Exclamation, "Achtung:")
'wenn die gesuchte File eine Suche ist: per MAil informierne und Indexierung abbrechen
'If My.Settings.vNIMailsenden = True Then
' email.Send_EMail("Fehler bei Nachindexierung:
>> Profil: " & Me.aktivesProfil.Profilname & "
>> die windream-Suche : " & Me.aktivesProfil.WindreamSuche & " konnte nicht gefunden werden!" & _
' "
>> Mögliche Fehlerursache: Das W-Laufwerk ist nicht verfügbar!")
'End If
Return 0
Else
' windream-Suche für Profil starten
Dim windreamSucheErgebnisse As WMObjects = Me.GetSearchDocuments(WD_Search)
If windreamSucheErgebnisse.Count > 0 Then
' neue Anzahl von Dateien
Return windreamSucheErgebnisse.Count
Else
' keine Dateien zum Importieren
Return 0
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(ex.Message)
Return 0
End Try
End Function
Public Function GetSearchDocuments(ByVal wdfLocation As String)
If clsWM.CheckFileExists(wdfLocation) = True 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")
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
LOGGER.Info("KEIN GÜLTIGER WINDREAM-SUCHTYP")
Return Nothing
End Select
Dim WMObjects As Object
WMObjects = oSearch.Execute
Return oSearch.execute
Catch ex As Exception
LOGGER.Error(ex)
' bei einem Fehler einen Eintrag in der Logdatei machen
LOGGER.Info("Fehler in GetSearchDocuments - " & ex.Message, True)
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
LOGGER.Error(ex)
'MsgBox(ex.Message)
Return Nothing
End Try
End Function
#End Region
End Class