Imports WINDREAMLib Imports WINDREAMLib.WMCOMEvent Imports WINDREAMLib.WMEntity Imports WINDREAMLib.WMObjectEditMode Imports WINDREAMLib.WMSearchOperator Imports WINDREAMLib.WMSearchRelation Imports WMOBRWSLib Imports WMOSRCHLib Imports WMCNNCTDLLLib Imports WMOTOOLLib Public Class Windream Inherits Constants #Region "+++++ Variables +++++" Private Shared Logger As NLog.Logger = NLog.LogManager.GetCurrentClassLogger Private ServerBrowser As IServerBrowser Private CurrentController As WMOSearchController Private CurrentSession As WMSession Private CurrentConnect As WMConnect Private CurrentServer As String Private CurrentObjecttypes As WMObjects Public ReadOnly Property ReconnectSession As Boolean Public ReadOnly Property DriveLetter As String Public ReadOnly Property Support64Bit As Boolean Public Property LoggedInSession As Boolean = False #End Region #Region "+++++ Init +++++" ''' ''' Initializes windream and creates a windream session with the actual user ''' ''' Public Sub New( Optional DriveLetter As String = "W", Optional ReconnectSession As Boolean = False, Optional Support64Bit As Boolean = False, Optional ServerName As String = Nothing, Optional UserName As String = Nothing, Optional UserPass As String = Nothing, Optional UserDomain As String = Nothing ) Try Me.DriveLetter = DriveLetter Me.ReconnectSession = ReconnectSession Me.Support64Bit = Support64Bit Dim session As WMSession = NewSession(ServerName, UserName, UserPass, UserDomain) If session Is Nothing Then Throw New Exception("Login failed") End If CurrentSession = session CurrentServer = ServerName CurrentObjecttypes = GetObjectTypes() Catch ex As Exception Logger.Error(ex) End Try End Sub Public Function NewSession(Optional serverName As String = Nothing) As WMSession Dim browser As ServerBrowser Dim connect As WMConnect Dim session As WMSession Dim credentials As WMUserIdentity Try browser = New ServerBrowser() connect = New WMConnect() Logger.Info("Successfully created windream objects") Catch ex As Exception Logger.Error(ex, "Error while creating windream objects") Return Nothing End Try Try If serverName Is Nothing OrElse serverName.Length = 0 Then serverName = browser.GetCurrentServer() End If Catch ex As Exception Logger.Error(ex, "Error while getting current server") Return Nothing End Try Try credentials = New WMUserIdentity() With { .aServerName = serverName } Catch ex As Exception Logger.Error(ex, "Error while creating user identity") Return Nothing End Try Try session = connect.Login(credentials) 'LoggedInSession = True CurrentServer = serverName Return session Catch ex As Exception Logger.Error(ex, "Error while logging in") Return Nothing End Try End Function Public Function NewSession(Optional serverName As String = Nothing, Optional userName As String = Nothing, Optional password As String = Nothing, Optional domain As String = Nothing) As WMSession Dim browser As ServerBrowser Dim connect As WMConnect Dim session As WMSession Dim credentials As WMUserIdentity Dim impersonation As Boolean Dim serverNameFromClient As Boolean Try browser = New ServerBrowser() connect = New WMConnect() Logger.Info("Successfully created windream objects") Catch ex As Exception Logger.Error(ex, "Error while creating windream objects") Return Nothing End Try ' If no server was supplied, try to get the current server set in the client Try If serverName Is Nothing OrElse serverName.Length = 0 Then serverName = browser.GetCurrentServer serverNameFromClient = True Else serverNameFromClient = False End If Catch ex As Exception Logger.Error(ex, "Error while getting Servername") Return Nothing End Try Logger.Info("Servername: {0}", serverName) Logger.Info("Servername aquired from client: {0}", serverNameFromClient) 'TODO: Test connection to windream server ' If username, password and domain are set, login with impersonation ' Else, login with current credentials If userName IsNot Nothing And password IsNot Nothing And domain IsNot Nothing Then impersonation = True credentials = New WMUserIdentity() With { .aServerName = serverName, .aUserName = userName, .aPassword = password, .aDomain = domain } connect.ModuleId = 9 Logger.Info("Impersonated Login: True") Logger.Info("Username: {0}", userName) Logger.Info("Domain: {0}", domain) Else impersonation = False credentials = New WMUserIdentity() With { .aServerName = serverName } Logger.Info("Impersonated Login: False") Logger.Info("Username: {0}", Environment.UserName) Logger.Info("Domain: {0}", Environment.UserDomainName) End If Try session = connect.Login(credentials) Catch ex As Exception Logger.Error(ex, "Error while logging in") Return Nothing End Try Try ' Standardmässig hinterlegen dass abgelegte Dateien keine Indexmaske öffnet session.SwitchEvents(WMCOMEventWMSessionNeedIndex, False) Catch ex As Exception Logger.Error(ex, "Could not SwitchEvents") Return Nothing End Try If session.aLoggedin = False Then Logger.Warn("Session created but user {0} could not be logged in", Environment.UserName) Return Nothing End If Return session End Function Private Function GetObjectTypes() As WMObjects Dim objectTypes As WMObjects Try objectTypes = CurrentSession.GetWMObjectTypes(WMEntityDocument) Return objectTypes Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function ''' ''' Returns all Objecttypes of current server as list of strings ''' ''' List of String of all objecttypes ''' Public Function GetObjecttypeNames() As List(Of String) Dim objectTypes As New List(Of String) Try For i As Integer = 0 To CurrentObjecttypes.Count objectTypes.Add(CurrentObjecttypes.Item(i).aName) Next Return objectTypes Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function Private Function NormalizePath(path As String) Dim normalizedPath = path If Not path.StartsWith("\") And path.ToUpper().StartsWith(DriveLetter.ToUpper) Then normalizedPath = path.Substring(2) End If Return normalizedPath End Function ''' ''' Creates a windream session with the current user and the current server ''' ''' Returns true when created, false if not ''' 'Public Function NewSession() As Boolean ' Try ' ServerBrowser = New ServerBrowser() ' CurrentServer = ServerBrowser.GetCurrentServer ' Catch ex As Exception ' Logger.Error(ex, "Could not create ServerBrowser") ' Return False ' End Try ' Try ' ' Create Connect Object for Session ' CurrentConnect = New WMConnect ' Catch ex As Exception ' Logger.Error(ex, "Could not create WMConnect") ' Return False ' End Try ' Try ' ' Create session object with severname set ' CurrentSession = CreateObject("Windream.WMSession", ServerBrowser.GetCurrentServer) ' Catch ex As Exception ' Logger.Error(ex, "Could not create WMConnect") ' Return False ' End Try ' Try ' CurrentConnect.LoginSession(CurrentSession) ' LoggedInSession = True ' Catch ex As Exception ' Logger.Error(ex, "Could not login session") ' Return False ' End Try ' Try ' ' Standardmässig hinterlegen dass abgelegte Dateien keine Indexmaske öffnet ' CurrentSession.SwitchEvents(WMCOMEventWMSessionNeedIndex, False) ' Catch ex As Exception ' Logger.Error(ex, "Could not SwitchEvents") ' Return False ' End Try ' If TestLoggedInSession() = False Then ' Logger.Warn("Session created but user {0} could not be logged in", Environment.UserName) ' Return False ' End If ' Return True 'End Function #End Region #Region "+++++ New +++++" ''' ''' Creates a folder in windream. All folder-parts will be checked ''' ''' full path of new folder ''' Returns true when folder was created, false if not ''' Public Function NewFolder(ByVal folderpath As String) Try If TestLoggedInSession() = False Then Return False End If folderpath = NormalizePath(folderpath) Dim folders() As String = folderpath.Split("\") For Each folder As String In folders Dim WMObject As WINDREAMLib.WMObject If TestFolderExists(folder) = False Then Try WMObject = CurrentSession.GetNewWMObjectFS(WMEntityFolder, folder, WMObjectEditModeNoEdit) Catch ex As Exception Logger.Error(ex) 'clsLogger.Add("Could not create WMObject for folderpath '" & folder & "': " & ex.Message, True) Return False End Try End If Next Return True Catch ex As Exception Logger.Error(ex) 'clsLogger.Add("Unexpected error in NewFolder: " & ex.Message, True) Return False End Try End Function ''' ''' Indexes the file with the given values ''' ''' full filepath ''' Name of the index ''' values as array ''' Returns true when folder was created, false if not ''' Public Function NewIndexFile(WMFile As String, ByVal indexname As String, ByVal aValues() As String) As Boolean If TestLoggedInSession() = False Then Return False End If Dim oWMFile As WMObject = GetWMObjectForFile(WMFile) If IsNothing(oWMFile) Then Return False End If Dim vektInsState As Integer = 1 Try If Not oWMFile.aLocked Then oWMFile.lock() Else Logger.Info("WMDoc is locked already!") Return False End If If aValues.Length = 1 And aValues(0) = "" Then Logger.Info("Indexvalue is empty - No indexing") Return False End If Logger.Info("Indexing of index '" & indexname) Dim oWMType Try ' das entsprechende Attribut aus windream auslesen Dim oAttribute = CurrentSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname) ' den Variablentyp (String, Integer, ...) auslesen oWMType = oAttribute.GetVariableValue("dwAttrType") Catch ex As Exception Logger.Error(ex) Return False End Try ' wenn in aValues an Position i ein Wert steht Dim i As Integer = 0 Dim value = aValues(i) Dim oWMValueConverted = Nothing Dim vektor As Boolean = False 'Den Typ des Index-Feldes auslesen Logger.Info("type of windreamIndex: " & oWMType.ToString) Select Case (oWMType) Case INDEX_TYPE_STRING oWMValueConverted = CStr(value) Case INDEX_TYPE_INTEGER value = value.ToString.Replace(" ", "") value = value.ToString.Replace(" ", "") oWMValueConverted = CInt(value) Case INDEX_TYPE_FLOAT value = value.ToString.Replace(" ", "") oWMValueConverted = CDbl(value) Case INDEX_TYPE_FIXED_POINT value = value.ToString.Replace(" ", "") oWMValueConverted = CDbl(value) Case INDEX_TYPE_BOOLEAN oWMValueConverted = CBool(value) Case INDEX_TYPE_DATE 'Dim _date As Date = value oWMValueConverted = value Case INDEX_TYPE_TIME oWMValueConverted = CDbl(value) Case INDEX_TYPE_CURRENCY '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)) oWMValueConverted = aValueWrapper Case INDEX_TYPE_TIME 'If ((value)) Then ' oWMValueConverted = CDate(value) 'Else ' oWMValueConverted = "" 'End If 'Dim _date As Date = value oWMValueConverted = oWMValueConverted '*_date.ToShortTimeString Case INDEX_TYPE_FLOAT oWMValueConverted = CStr(value) Case INDEX_TYPE_VARIANT oWMValueConverted = CStr(value) Case INDEX_TYPE_FULLTEXT oWMValueConverted = CStr(value) Case 4097 'Vektor alphanumerisch vektor = True Case 4098 'Vektor Numerisch vektor = True Case 4099 'Vektor Kommazahl vektor = True Case 4100 'Vektor Kommazahl vektor = True Case 4101 'Vektor Kommazahl vektor = True Case 4103 'Vektor DateTime vektor = True Case 4107 vektor = True Case 36865 'Vektor Kommazahl vektor = True Case Else oWMValueConverted = "" End Select If vektor = False Then If oWMValueConverted.ToString Is Nothing = False Then Logger.Info("Converted value is: " & oWMValueConverted.ToString) End If End If '############################################################################################ '####################### Der eigentliche Indexierungsvorgang ################################ '############################################################################################ If vektor = False Then Try If oWMValueConverted.ToString Is Nothing = False Then Logger.Info("Now: oWMFile.SetVariableValue(" & indexname & ", " & oWMValueConverted & ")") oWMFile.SetVariableValue(indexname, oWMValueConverted) 'Die Datei speichern oWMFile.Save() Logger.Info("Index has been written!") Else Logger.Info("No indexvalue exists!") End If Catch ex As Exception Logger.Error(ex) oWMFile.Save() oWMFile.unlock() Return False End Try Else Logger.Info("Vectorfield: Preparing of Array!") Dim myArray() Dim Anzahl As Integer = aValues.Length 'Vektorfeld wird mit EINEM Wert gefüllt If Anzahl = 1 Then Logger.Info("Vectorfield will be filled with ONE VALUE!") ReDim myArray(0) myArray(0) = Helpers.Convert_VectorType(oWMType, value) 'Jetzt überprüfen ob Werte in Vektorfeld angefügt oder überschrieben werden sollen Logger.Info("Converted Value: " & myArray(0).ToString) Dim VektorArray() VektorArray = Return_VektorArray(oWMFile, indexname, myArray, oWMType) If VektorArray Is Nothing = False Then ReDim myArray(VektorArray.Length - 1) Array.Copy(VektorArray, myArray, VektorArray.Length) 'Jetzt die Nachindexierung oWMFile.SetVariableValue(indexname, myArray) ' Logger.Info("Vectorindex has been written!") 'Die Änderungen festsschreiben/speichern oWMFile.Save() End If End If End If i += 1 oWMFile.unlock() Logger.Info("...and unlock") Return True Catch ex As Exception Logger.Error(ex) oWMFile.Save() oWMFile.unlock() Return False End Try End Function Private Function NewLockWMFile(oWMFile As WMObject) As Boolean Try oWMFile.lock() Return True Catch ex As Exception Logger.Error(ex) Return False End Try End Function ''' ''' Sets the folder-objecttype. ''' ''' full path of folder ''' Obcjectype Name ''' Returns true when Otype was set, false if not ''' Public Function NewObjecttypeForFolder(folderpath As String, folderObjecttype As String) As Boolean Try If TestLoggedInSession() = False Then Return False End If Dim result As Boolean = False Dim WMFolder As WINDREAMLib.WMObject folderpath = NormalizePath(folderpath) If TestFolderExists(folderpath) = True Then WMFolder = CurrentSession.GetWMObjectByPath(WMEntityFolder, folderpath) Try ' die Datei sperren WMFolder.lock() Catch ex As Exception ' nichts tun (Datei ist bereits gesperrt) End Try ' wenn der Datei noch kein Dokumenttyp zugewiesen wurde If WMFolder.aObjectType.aName = "Standard" Then ' ihr den entsprechenden Dokumenttyp zuweisen WMFolder.aObjectType = CurrentSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, folderObjecttype) ' WMObject.aObjectType = Me.selectedProfile.Dokumenttyp Logger.Info("Objecttype has been set") result = True Else If WMFolder.aObjectType.aName <> "Standard" Then Logger.Warn("An Objecttype has already been set!") End If End If Try WMFolder.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 Try WMFolder.unlock() Catch ex As Exception ' wenn das entsperren nicht geklappt hat, dann war die Datei auch nicht gesperrt End Try End If Return result Catch ex As Exception Logger.Error(ex) Return False End Try End Function ''' ''' Creates a new version of the file ''' ''' full path to the file ''' Comment ''' Returns true when version was created, false if not ''' Public Function NewVersion(ByVal WMPath As String, ByVal Comment As String) Try If TestLoggedInSession() = False Then Return False End If WMPath = NormalizePath(WMPath) Dim WMObject As WMObject '= CreateObject("WINDREAMLib.WMObject") 'New WINDREAMLib.WMObject Try WMObject = CurrentSession.GetWMObjectByPath(WMEntityDocument, WMPath) 'WINDREAMLib.WMEntity.WMEntityDocument Catch ex As Exception Logger.Warn("Could not create WMObject in Create_Version for file '" & WMPath & "': " & ex.Message) Return False End Try WMObject.CreateVersion2(False, "HISTORY_New_From_Version", Comment) Return True Catch ex As Exception Logger.Error(ex) Return False End Try End Function #End Region #Region "+++++ Get +++++" ''' ''' Returns all choicelists ''' ''' Choicelists as List of Strings or empty list if no choice lists are found Public Function GetChoiceLists() As List(Of String) Dim items As New List(Of String) If TestLoggedInSession() = False Then Return items End If Try Dim choiceLists As WMObjects Dim choiceList As IWMObject2 'load list of choicelists choiceLists = CurrentSession.GetAllObjects(WMEntityChoiceList) For Each choiceList In choiceLists items.Add(choiceList.aName) Next Return items Catch ex As Exception Logger.Error(ex) Return items End Try End Function ''' ''' Returns all indices for an objecttype ''' ''' Name of objecttype ''' Names of indices as list of String ''' Public Function GetIndicesByObjecttype(ByVal ObjecttypeName As String) As List(Of String) Try If TestLoggedInSession() = False Then Return Nothing End If Dim oObjectType As WMObject Dim oIndexAttributes As WMObjectRelation Dim oIndexAttribute As WMObject Dim oIndex As WMObject Dim oRelProperties As WMObjectRelation ' den Objekttyp laden oObjectType = CurrentSession.GetWMObjectByName(WMEntityObjectType, ObjecttypeName) ' Beziehung zu Indizes des Objekttyp auslesen oIndexAttributes = oObjectType.GetWMObjectRelationByName("TypeAttributes") ' Array für Indizes vorbereiten 'Dim aIndexNames(oIndexAttributes.Count - 1) As String Dim indexNames As New List(Of String) ' alle Indizes durchlaufen For j As Integer = 0 To oIndexAttributes.Count - 1 ' aktuellen Index auslesen oIndexAttribute = oIndexAttributes.Item(j) ' Eigenschaften des Index auslesen oRelProperties = oIndexAttribute.GetWMObjectRelationByName("Attribute") ' Index aus den Eigenschaften auslesen oIndex = oRelProperties.Item(0) ' Indexname speichern 'aIndexNames(j) = oIndex.aName indexNames.Add(oIndex.aName) Next ' Indexarray zurückgeben 'Return aIndexNames Return indexNames Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function ''' ''' Returns all items of a choicelist ''' ''' name of choicelist ''' Items as list of String ''' Public Function GetChoicelistItems(ByVal NameChoicelist As String) As List(Of String) Dim items As New List(Of String) If TestLoggedInSession() = False Then Return Nothing End If Dim choiceList As WMObject ' Try to get the choicelist first and abort if an error occurs Try Dim session As IWMSession2 = DirectCast(CurrentSession, IWMSession2) choiceList = session.GetWMObjectByName(WMEntityChoiceList, NameChoicelist) Catch ex As Exception Logger.Error(ex) Return Nothing End Try ' Try to get choicelist items Try Dim values As Object = choiceList.GetVariableValue("vItems") ' If values is nothing, the list is empty If values Is Nothing Then Return items End If For Each value In values items.Add(value) Next Catch ex As Exception Logger.Error(ex) Return Nothing End Try Return items End Function ''' ''' Returns the result of windream-search ''' ''' filepath of windreamSearch-file ''' Name of the Docid Index ''' Returns datatable ''' Public Function GetSearchDocuments(ByVal wdfLocation As String, NameIndexDocID As String) As DataTable Dim dtresult As New DataTable dtresult.Columns.Add("DOC_ID", GetType(Integer)) dtresult.Columns.Add("PATH", GetType(String)) If Not TestLoggedInSession() = False Then Return dtresult End If If TestWMFileExists(wdfLocation) = False Then Return dtresult End If Try Dim ProfileName = wdfLocation.Substring(wdfLocation.LastIndexOf("\") + 1) Dim ProfilePath = wdfLocation.Substring(0, wdfLocation.Length - ProfileName.Length) CurrentController = New WMOSearchController CurrentController.CheckSearchProfile(wdfLocation.ToLower) Dim suchTyp = CurrentController.SearchProfileTargetProgID Dim ExSettings As Object Dim oSearch As Object ExSettings = CurrentController.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") Dim suchTyp1 = suchTyp.ToString.ToUpper '' 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", CurrentServer) CurrentConnect.LoginSession(srchQuick.WMSession) srchQuick.ClearSearch() srchQuick.SearchProfilePath = ProfilePath srchQuick.LoadSearchProfile(ProfileName) oSearch = srchQuick.GetSearch() Case "WMOSRCH.WMINDEXSEARCH" srchIndex.WMSession = CreateObject("Windream.WMSession", CurrentServer) CurrentConnect.LoginSession(srchIndex.WMSession) srchIndex.ClearSearch() srchIndex.SearchProfilePath = ProfilePath srchIndex.LoadSearchProfile(ProfileName) oSearch = srchIndex.GetSearch() Case "WMOSRCH.WMOBJECTTYPESEARCH" srchObjectType.WMSession = CreateObject("Windream.WMSession", CurrentServer) CurrentConnect.LoginSession(srchObjectType.WMSession) srchObjectType.ClearSearch() srchObjectType.SearchProfilePath = ProfilePath srchObjectType.LoadSearchProfile(ProfileName) oSearch = srchObjectType.GetSearch() Case Else Logger.Warn("No valid WM-SearchType") Return dtresult End Select Dim WMObjects As Object WMObjects = oSearch.Execute 'If returnDT = True Then If WMObjects.Count > 0 Then For Each dok As WMObject In WMObjects Dim path As String = dok.aPath Dim DOC_ID = dok.GetVariableValue(NameIndexDocID) Logger.Info("Adding DocInfo for DocID: " & DOC_ID.ToString) dtresult.Rows.Add(DOC_ID, path) Next dtresult.AcceptChanges() End If Return dtresult Catch ex As Exception Logger.Error(ex) Return dtresult End Try End Function ''' ''' Returns a windream-type as Integer. ''' ''' Name of indexfield ''' Returns integer, which describes the type ''' Public Function GetTypeOfIndexAsInt(ByVal indexname As String) As Integer Try If TestLoggedInSession() = False Then Return False End If Dim oAttribute = CurrentSession.GetWMObjectByName(WMEntityAttribute, indexname) Dim vType = oAttribute.GetVariableValue("dwAttrType") Return vType Catch ex As Exception Return Nothing End Try End Function ''' ''' Returns the value(s) for an index as a datatable ''' ''' filepath of windream-file ''' Name of the index ''' Datatable ''' Public Function GetValueforIndex(ByVal WMFile As String, ByVal NameIndex As String) As DataTable Dim dt As New DataTable dt.Columns.Add("RESULT", GetType(String)) If TestLoggedInSession() = False Then Return dt End If Try If Not WMFile.StartsWith("\") And WMFile.ToUpper.StartsWith(DriveLetter.ToUpper) Then WMFile = WMFile.Substring(2) End If Dim WMObject As WINDREAMLib.WMObject '= CreateObject("WINDREAMLib.WMObject") 'New WINDREAMLib.WMObject Try WMObject = CurrentSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, WMFile) 'WINDREAMLib.WMEntity.WMEntityDocument Catch ex As Exception Logger.Error(ex) Return dt End Try Dim result = WMObject.GetVariableValue(NameIndex) If IsNothing(result) Then Return Nothing Else If result.GetType.ToString.Contains("System.Object") Then For Each val As String In result dt.Rows.Add(val) Next dt.AcceptChanges() Else dt.Rows.Add(result) End If End If Return dt Catch ex As Exception Logger.Error(ex) Return dt End Try End Function ''' ''' Returns the values for a vektorfield plus the new ones ''' ''' windream-file as Object ''' Name of the index ''' Returns value as Datatable ''' Public Function Return_VektorArray(ByVal oDocument As WMObject, vktIndexName As String, arrIndexwerte As Object, vType As Object) Try If TestLoggedInSession() = False Then Return False End If Dim missing As Boolean = False Dim valueCount As Integer = 0 Dim ValueArray() = Nothing 'Jeden Wert des Vektorfeldes durchlaufen Dim DT_RESULT = GetValueforIndex(oDocument.aPath, vktIndexName) If DT_RESULT.Rows.Count > 0 Then 'Erst die aktuellen Werte speichern und schreiben For Each row As DataRow In DT_RESULT.Rows ReDim Preserve ValueArray(valueCount) 'Den Wert im Array speichern ValueArray(valueCount) = Helpers.Convert_VectorType(vType, row.Item(0)) valueCount += 1 Next 'Jetzt die Neuen Werte auf Duplikate überprüfen For Each NewValue As Object In arrIndexwerte If NewValue Is Nothing = False Then If ValueArray.Contains(NewValue) = False Then 'Das Array anpassen ReDim Preserve ValueArray(valueCount) 'Den Wert im Array speichern ValueArray(valueCount) = Helpers.Convert_VectorType(vType, NewValue) valueCount += 1 Else Logger.Info("Value '" & NewValue.ToString & "' already existing in vectorfield(1)") End If End If Next Else Logger.Info(" vectorfield is empty....") 'Den/die Neuen Wert(e) anfügen For Each NewValue As Object In arrIndexwerte If NewValue Is Nothing = False Then If ValueArray Is Nothing = False Then If ValueArray.Contains(NewValue) = False Then 'Das Array anpassen ReDim Preserve ValueArray(valueCount) 'Den Wert im Array speichern ValueArray(valueCount) = Helpers.Convert_VectorType(vType, NewValue) valueCount += 1 Else Logger.Info("Value '" & NewValue.ToString & "' already existing in vectorfield(2)") End If Else 'Dererste Wert, also hinzufügen 'Das Array anpassen ReDim Preserve ValueArray(valueCount) 'Den Wert im Array speichern ValueArray(valueCount) = Helpers.Convert_VectorType(vType, NewValue) valueCount += 1 End If End If Next End If Return ValueArray Catch ex As Exception Logger.Error(ex) End Try End Function ''' ''' Returns a WMObject if file exists ''' ''' full path to the file ''' Returns WMObject ''' Public Function GetWMObjectForFile(ByVal WMPath As String) As WMObject Try If TestLoggedInSession() = False Then Return Nothing End If WMPath = NormalizePath(WMPath) Dim oWMObject As WINDREAMLib.WMObject Try oWMObject = CurrentSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, WMPath) Catch ex As Exception Logger.Warn("Could not create WMObject for file '" & WMPath & "': " & ex.Message) Return Nothing End Try Return oWMObject Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function #End Region #Region "+++++ Test +++++" ''' ''' Checks if the folder exists ''' ''' The path of the folder ''' True if exists or false if not or error occured ''' Public Function TestFolderExists(folderpath As String) Try If TestLoggedInSession() = False Then Return False End If folderpath = NormalizePath(folderpath) Try Dim exists = CurrentSession.WMObjectExists(WMEntityFolder, folderpath, 0, 0) Return exists Catch ex As Exception Logger.Error(ex) Return False End Try Catch ex As Exception Return False End Try End Function ''' ''' Checks wether file exists in windream ''' ''' full path to the file ''' Returns true when file was deleted, false if not ''' Public Function TestWMFileExists(ByVal WMPath As String) Try If TestLoggedInSession() = False Then Return False End If WMPath = NormalizePath(WMPath) If IsNothing(GetWMObjectForFile(WMPath)) Then Return False Else Return True End If Catch ex As Exception Logger.Error(ex) Return False End Try End Function Private Function TestLoggedInSession() As Boolean Try If CurrentSession.aLoggedin Then Return True Else Logger.Warn("There is no active WM-SSession!") Return False End If Catch ex As Exception Return False End Try End Function ''' ''' Checks if user exists in windream. ''' ''' test username ''' Returns true if exists, false if not ''' Public Function TestWMUSerExists(username As String) As Boolean Try If TestLoggedInSession() = False Then Return False End If Return CurrentSession.WMObjectExists(WMEntityUser, username, 0, 0) Catch ex As Exception Logger.Error(ex) Return False End Try End Function ''' ''' Checks if group exists in windream. ''' ''' test username ''' Returns true if exists, false if not ''' Public Function TestWMGroupExists(groupname As String) Try If TestLoggedInSession() = False Then Return False End If Return CurrentSession.WMObjectExists(WMEntityGroups, groupname, 0, 0) Catch ex As Exception Logger.Error(ex) Return False End Try End Function #End Region #Region "+++++ Remove +++++" ''' ''' Deletes a file in windream ''' ''' full path to the file ''' Returns true when file was deleted, false if not ''' Public Function RemFile(ByVal WMPath As String) Try WMPath = NormalizePath(WMPath) Dim oWMObject = GetWMObjectForFile(WMPath) If IsNothing(oWMObject) = False Then oWMObject.Delete() Return True Else Return False End If Catch ex As Exception Logger.Error(ex) Return False End Try End Function ''' ''' Removes the vektorlink from windream ''' ''' full path to the file ''' Indexname of Vektor-Index ''' Value which is to be deleted ''' Returns true when indexing was successfull, false if not ''' Public Function REMOVE_VEKTOR_LINK(ByVal WMPath As String, vktIndexName As String, deleteValue As String) Try Logger.Info("Removing Value '" & deleteValue & "' of Index '" & vktIndexName & "' " & WMPath) Dim oWMFile As WMObject = GetWMObjectForFile(WMPath) If IsNothing(oWMFile) Then Logger.Warn("Exit from REMOVE_VEKTOR_LINK...") Return False End If Dim containsvalue As Boolean = False Dim ValueArray() = Nothing 'Jeden Wert des Vektorfeldes durchlaufen Dim WMValue = oWMFile.GetVariableValue(vktIndexName) If WMValue Is Nothing = False Then 'Nochmals prüfen ob wirklich Array If WMValue.GetType.ToString.Contains("System.Object") Then ' das entsprechende Attribut aus windream auslesen Dim oAttribute = CurrentSession.GetWMObjectByName(WMEntityAttribute, vktIndexName) ' den Variablentyp (String, Integer, ...) auslesen Dim vType = oAttribute.getVariableValue("dwAttrType") Dim Anzahl As Integer = 0 For Each WDValue As Object In WMValue If WDValue Is Nothing = False Then If WDValue = deleteValue Then containsvalue = True Logger.Info("The Index contains the value to be deleted!") End If If WDValue <> deleteValue Then 'Erst die ALten Werte schreiben ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = Helpers.Convert_VectorType(vType, WDValue) Anzahl += 1 End If End If Next Else Logger.Warn("Index is not a vector") Return False End If Else Logger.Warn("oWMObject is nothing") Return True End If If containsvalue = True Then 'And Not IsNothing(ValueArray) If NewLockWMFile(oWMFile) = False Then Return False End If 'Indexiern des Vektorfeldes oWMFile.SetVariableValue(vktIndexName, ValueArray) ' die Indexinformationen des Dokuments speichern oWMFile.Save() Logger.Info("The new vectorvalues were saved!") ' Unlock in einem unbehandelten Try-Block um Fehler abzufangen, Try ' die Sperrung des Dokuments aufheben oWMFile.unlock() Catch ex As Exception ' nichts tun (Datei war nicht gesperrt) End Try 'Zurückgeben Return True Else Logger.Info("containsvalue is not true") Return True End If Catch ex As Exception Logger.Error(ex) Return False End Try End Function #End Region End Class