Imports WINDREAMLib Imports WINDREAMLib.WMCOMEvent Imports WINDREAMLib.WMEntity Imports WINDREAMLib.WMObjectEditMode Imports WINDREAMLib.WMSearchOperator Imports WINDREAMLib.WMSearchRelation Imports WMOBRWSLib Imports WMOSRCHLib Imports System.IO Public Class ClassWindream #Region "+++++ Konstanten +++++" Const DEBUG = AUS Const AUS = 0 Const WINDREAM = 1 Const VARIABLEN = 2 Const WMObjectStreamOpenModeReadWrite = 2 Const WMObjectVariableValueTypeUndefined = 0 Const WMObjectVariableValueTypeString = 1 Const WMObjectVariableValueTypeInteger = 2 Const WMObjectVariableValueTypeFloat = 3 Const WMObjectVariableValueTypeBoolean = 4 Const WMObjectVariableValueTypeDate = 5 Const WMObjectVariableValueTypeFixedPoint = 6 Const WMObjectVariableValueTypeTimeStamp = 7 Const WMObjectVariableValueTypeCurrency = 8 Const WMObjectVariableValueTypeTime = 9 Const WMObjectVariableValueTypeVariant = 10 Const WMObjectVariableValueTypeMask = &HFFF Const WMObjectVariableValueFlagMask = &HFFFFF000 Const WMObjectVariableValueTypeVector = &H1000 Const WMObjectVariableValueTypeFulltext = &H2000 Const WMObjectVariableValueTypeDefaultValue = &H4000 #End Region #Region "+++++ Variablen +++++" Public Shared oConnect ' der Typ darf nicht festgelegt werden (warum auch immer... geht sonst nicht) Public Shared oSession 'As WINDREAMLib.WMSession ' der Typ darf nicht festgelegt werden (warum auch immer... geht sonst nicht) Public Shared oBrowser As New WMOBRWSLib.ServerBrowser Public Shared oDokumentTypen As WINDREAMLib.WMObjects Private oController As New WMOSearchController Public Shared _WDObjekttyp As String Private Shared aktWMObject As WINDREAMLib.WMObject #End Region #Region "+++++ Allgemeine Methoden und Funktionen +++++" ''' ''' Konstruktor für die windream-Klasse ''' ''' Sub New() ' wenn ein Unexpected error in der Initialisierung auftrat If Not ClassWindream.Init() Then ' Nachricht ausgeben MsgBox("Es trat ein Unexpected error in der Initialisierung der Klasse windream auf. Bitte prüfen Sie ob der windream-Server aktiv ist und alle Dienste gestartet sind.", MsgBoxStyle.Exclamation, "Unexpected error in Initialisierung") ' das Programm "abschießen" Process.GetCurrentProcess.Kill() End If End Sub 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) oController = New WMOSearchController 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 MsgBox("KEIN GÜLTIGER WINDREAM-SUCHTYP") Return Nothing End Select Dim WMObjects As Object WMObjects = oSearch.Execute Return oSearch.execute Catch ex As Exception ' bei einem Fehler einen Eintrag in der Logdatei machen MsgBox("Fehler in GetSearchDocuments: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return Nothing End Try End If Return Nothing End Function Public Function GetSearchDocuments_Objekttype(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 srchObjectType As WMOSRCHLib.WMObjectTypeSearch = CreateObject("WMOSrch.WMObjectTypeSearch") '' Der öffentliche Member CheckSearchProfile für den Typ IWMQuickSearch7 wurde nicht gefunden. [Microsoft.VisualBasic] => GetSearchDocuments() srchObjectType.WMSession = CreateObject("Windream.WMSession", Me.GetCurrentServer) Me.oConnect.LoginSession(srchObjectType.WMSession) srchObjectType.ClearSearch() srchObjectType.SearchProfilePath = ProfilePath srchObjectType.LoadSearchProfile(ProfileName) oSearch = srchObjectType.GetSearch() Dim WMObjects As Object WMObjects = oSearch.Execute Return oSearch.execute Catch ex As Exception ' bei einem Fehler einen Eintrag in der Logdatei machen MsgBox("Fehler in GetSearchDocuments()" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return Nothing End Try End If Return Nothing End Function ''' ''' Initialisiert die statische Klasse (Login, Session starten, usw.) ''' ''' Liefert True wenn das Anmelden erfolgreich war, sonst False ''' Public Shared Function Init() As Boolean Try Try ' Session-Objekt instanziieren und mit dem im Client ausgewählten Server belegen oSession = CreateObject("Windream.WMSession", GetCurrentServer) If LogErrorsOnly = False Then ClassLogger.Add(" ...windream-Server: '" & GetCurrentServer() & "'", False) ' Connection-Objekt instanziieren oConnect = CreateObject("Windream.WMConnect") 'MsgBox("windrem init 'ed") Catch ex As Exception ClassLogger.Add("Windream konnte nicht initiiert werden: " & ex.Message, True) Return False End Try ' wenn windream nicht angemeldet ist If Not IsLoggedIn() Then ' Art der Anmeldung an windream festlegen ' 0x0L (also 0) = Standard windream Benutzer ' WM_ODULE_ID_DOCTYPEEDITOR_LIC = ermöglicht Zugriff auf die windream Management Funktionen (Z.B. zur Verwaltung der windream Dokumententypen, Auswahllisten, etc.) ' WM_MODULE_ID_INDEXSERVICE = ermöglicht der Session die Indexierungs-Events vom windream DMS-Service zu empfangen oConnect.ModuleID = 0 ' setzt die minimal erwartete windream-Version oConnect.MinReqVersion = "4" ' -- Impersonifizierung nur möglich mit registry-eintrag -- ' oConnect.UserName "\schulung\windream" ' oConnect.Password "windream" ' Verbindung mit Session-Objekt (und dem ausgewählten Server) aufbauen oConnect.LoginSession(oSession) If oSession.aLoggedin = False Then MsgBox("Es konnte keine Verbindung mit dem windream-Server hergestellt werden", MsgBoxStyle.Exclamation, "Verbindung konnte nicht hergestellt werden") Return False End If 'If My.Settings.vDetailLog Then ' ClassLogger.Add(" >> windream-Version: '" & oSession.GetSystemInfo("WindreamVersion") & "'", False) 'End If ' AUSGABE VON SYSTEMINFORMATIONEN ' Gibt die Versionsart (Lizenztyp) also Small-Business-Edition (SBE), Small-Business-Extension (SBX) ' oder Business-Edition (BE) aus 'MsgBox("WindreamVersion: " & oSession.GetSystemInfo("WindreamVersion") & vbNewLine & "LicenceKey: " & oSession.GetSystemInfo("LicenceKey") & vbNewLine & _ ' vbNewLine & "LicenceName: " & oSession.GetSystemInfo("LicenceName")) 'Dim WMCtrl As AISCONTROLDATACOMLib.AISControlData 'WMCtrl = New AISCONTROLDATACOMLib.AISControlData '' liefert die Versionsnummer des Clients 'MsgBox(WMCtrl.WMWorkstationBuildNo) 'MsgBox(WMCtrl.W '' liefert den Servernamen des angemeldeten windreams 'MsgBox(WMCtrl.WMServerName) Try oSession.SwitchEvents(WMCOMEventWMSessionNeedIndex, False) ' der Parameter WMEntityDocument definiert, dass nur Dokumenttypen und keine ' Ordnertypen ausgelesen werden oDokumentTypen = oSession.GetWMObjectTypes(WINDREAMLib.WMEntity.WMEntityDocument) Catch ex As Exception Return False End Try End If Return True Catch ex As Exception If Err.Number = -2147220985 Then MsgBox("Die installierte windream-Version ist nicht ausreichend für den Betrieb der Tool Collection für windream." & vbNewLine & _ "Bitte kontaktieren Sie Digital Data." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & Err.Description, MsgBoxStyle.Exclamation, "Unzureichende windream-Version") Else MsgBox("Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Login an windream") End If Return False End Try End Function #End Region #Region "+++++ Funktionen die für den Objekttyp relevate Informationen zurückliefern +++++" ''' ''' Liefert alle Objekttypen des aktuellen Servers als windream-Objekte. ''' ''' Alle Objekttypen als WMObjects-Objekt ''' Public Shared Function GetObjecttypesAsObjects() As WMObjects Try Return oDokumentTypen Catch ex As Exception MsgBox("Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Auslesen der Objekttypen") Return Nothing End Try End Function ''' ''' Liefert alle Objekttypen des aktuellen Servers als Array aus Strings. ''' ''' Array mit allen Objekttypen als Strings ''' Public Function GetObjecttypesAsStrings() As String() Try Dim objektTypenStr(Me.oDokumentTypen.Count) As String For i As Integer = 0 To Me.oDokumentTypen.Count objektTypenStr(i) = Me.oDokumentTypen.Item(i).aName Next Return objektTypenStr Catch ex As Exception MsgBox("Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Auslesen der Objekttypen als String") Return Nothing End Try End Function Public Function GetTypeOfIndex(ByVal indexname As String) As Integer Try Dim oAttribute = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname) Dim vType = oAttribute.getVariableValue("dwAttrType") Return vType Catch ex As Exception Return Nothing End Try End Function Public Shared Function GetSystemIndices(ByVal name As String) Dim oObjectType As WMObject ' den Objekttyp laden oObjectType = oSession.GetWMObjectByName(WMEntityObjectType, name) Dim msg As String Dim oSystemIndexes = oObjectType.GetVariableNames(1, False) msg = "System indices (internal column names): " & vbNewLine For Each oSystemIndex In oSystemIndexes msg = msg & vbNewLine & oSystemIndex Next MsgBox(msg) End Function Public Shared Function GetTypIndexNames(ByVal name As String) Dim oObjectType As WMObject ' den Objekttyp laden oObjectType = oSession.GetWMObjectByName(WMEntityObjectType, name) Dim msg As String Dim oSystemIndexes = oObjectType.GetVariableNames(2, False) msg = "Type Indices (type Index names): " & vbNewLine For Each oSystemIndex In oSystemIndexes msg = msg & vbNewLine & oSystemIndex Next MsgBox(msg) End Function ''' ''' Liefert alle Indexe eines Objekttypen. ''' ''' Name des Objekttyps ''' Array mit allen Objekttyp zugeordneten Indexen als String ''' Public Shared Function GetIndicesByObjecttype(ByVal Objecttype_name As String) As String() Try Dim oObjectType As WMObject Dim oIndexAttributes As WMObjectRelation Dim oIndexAttribute As WMObject Dim oIndex As WMObject Dim oRelProperties As WMObjectRelationClass ' den Objekttyp laden oObjectType = oSession.GetWMObjectByName(WMEntityObjectType, Objecttype_name) ' Beziehung zu Indizes des Objekttyp auslesen oIndexAttributes = oObjectType.GetWMObjectRelationByName("TypeAttributes") ' Array für Indizes vorbereiten Dim aIndexNames(oIndexAttributes.Count - 1) As 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) 'Dim o = oRelProperties.Item(2) ' Indexname speichern aIndexNames(j) = oIndex.aName Next 'Indexarray sortiert zurückgeben Array.Sort(aIndexNames) ' Indexarray zurückgeben Return aIndexNames Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Auslesen der windream-Indexe") Return Nothing End Try End Function ''' ''' Liefert einen Objekttyp als WMObject an Hand dessen Name. ''' ''' Name des Objekttyps ''' Objekttyp als WMObject ''' Public Function GetObjecttypeByName(ByVal objekttypName As String) As WMObject Try ' alle Objekttypen auslesen Dim oObjectTypes As WMObjects = Me.oSession.GetWMObjectTypes(WINDREAMLib.WMEntity.WMEntityDocument) ' alle Objekttypen durchlaufen und nach dem mit dem angegebenen Namen suchen For Each oObjectType As WMObject In oObjectTypes If oObjectType.aName = objekttypName Then Return oObjectType End If Next Return Nothing Catch ex As Exception MsgBox("Es konnte ein Objekttyp nicht erstellt werden." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Objekttyp konnte nicht erstellt werden") Return Nothing End Try End Function ''' ''' Überprüft ob der angegebene Index im Objekttyp existiert ''' ''' Name des zu durchsuchenden Objekttyps ''' Name des zu suchenden Indexes ''' Liefert True wenn der Index im Objekttyp existiert, sonst False ''' Public Shared Function ExistIndexInObjekttyp(ByVal objekttyp As String, ByVal indexname As String) As Boolean Try Dim indexnamen() As String = GetIndicesByObjecttype(objekttyp) If indexnamen Is Nothing Then Return False For Each index As String In indexnamen If index = indexname Then Return True Next Catch ex As Exception MsgBox("Beim Prüfen ob ein Index für einen Objekttypen existiert, ist ein Fehler aufgetreten." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Prüfen auf Existenz eines Index in einem Objekttyp") End Try Return False End Function #End Region #Region "+++++ Allgemeine Funktionen die Informationen zurückliefern +++++" ''' ''' Liefert True wenn die windream-Session angemeldet ist und False für den Fall, dass die Session nicht eingeloggt ist. ''' ''' Anmeldestatus als Boolean ''' Public Shared Function IsLoggedIn() As Boolean Try Return oSession.aLoggedin Catch ex As Exception MsgBox("Es konnte nicht erfolgreich geprüft werden, ob das Programm am windream-Server angemeldted ist." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Loggedin-Prüfung") End Try Return False End Function ''' ''' Liefert den Servernamen an dem windream aktuell angemeldet ist. ''' ''' Servername als String ''' Public Shared Function GetCurrentServer() As String Try Return oBrowser.GetCurrentServer 'ClassWindream.oBrowser.GetCurrentServer Catch ex As Exception MsgBox("Der aktuell gewählte windream-Server konnte nicht ausgelesen werden." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Auslesen des windream-Servers") End Try Return "" End Function ''' ''' Liefert das Windream-Laufwerk des windream-Servers, in Form '[Laufwerksbuchstabe]:'. (z.B. 'W:') ''' ''' Laufwerksbuchstabe mit Doppelpunkt als String ''' 'Public Function GetWindreamDriveLetter() As String ' Try ' Dim oControl As AISCONTROLDATACOMLib.AISControlData ' Dim sDrive As String = "" ' oControl = New AISCONTROLDATACOMLib.AISControlData ' sDrive = oControl.GetStringValue(&H10040003) ' Return sDrive & ":" ' Catch ex As Exception ' MsgBox("Fehlernachricht: " & ex.Message, MsgBoxStyle.Critical, "Unexpected error inm Auslesen des windream-Laufwerks") ' End Try ' Return "" 'End Function ''' ''' Liefert den Typen eines Indexes als Integer. ''' ''' Name des zu überprüfenden Indexfeldes ''' Liefert eine Zahl, die einen Typen beschreibt ''' Public Function GetValuesfromAuswahlliste(ByVal _auswahlliste As String) As Object Try 'Dim oAttribute = Me.oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname) 'Dim vType = oAttribute.getVariableValue("vItems") 'Return vType Dim oChoiceList = oSession.GetWMObjectByName(WMEntityChoiceList, _auswahlliste) 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: " & _auswahlliste & " nicht gefunden!", MsgBoxStyle.Critical, "Fehler:") Return Nothing End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in GetValuesfromAuswahlliste:") Return Nothing End Try End Function #End Region Public Shared Function Stream_File(ByVal filenameQuelle As String, ByVal newfilename As String) On Error Resume Next aktWMObject = Nothing Dim Zielverzeichnis As String = Path.GetDirectoryName(newfilename) If My.Computer.FileSystem.DirectoryExists(Zielverzeichnis) = False Then My.Computer.FileSystem.CreateDirectory(Zielverzeichnis) ClassLogger.Add(" - Zielverzeichnis neu erzeugt!", False) End If Const STREAM_BinaryObject = "BinaryObject" If LogErrorsOnly = False Then ClassLogger.Add(" ...Stream_File wurde gestartet", False) Dim windreamFilename As String = "" ' Objekt für Datei und Zielverzeichnis anlegen Dim Quelldatei_Name As String = Path.GetFileName(filenameQuelle) If LogErrorsOnly = False Then ClassLogger.Add(" ...Quelldatei gelesen", False) '"Version-KZ entfernen newfilename = newfilename.Replace("\\", "\") windreamFilename = newfilename.Substring(2) If windreamFilename.Contains("[%Version]") Then windreamFilename = windreamFilename.Replace("[%Version]", "") newfilename = windreamFilename End If If My.Computer.FileSystem.DirectoryExists(Zielverzeichnis) Then If LogErrorsOnly = False Then ClassLogger.Add(" ...targetPath existiert", False) ' Überprüfen ob der zu Kopieren notwendige Speicherplatz auf Ziellaufwerk vorhanden ist Dim dvr As New DriveInfo(vWLaufwerk & ":") Dim freeSpace = dvr.TotalFreeSpace Dim info As New FileInfo(filenameQuelle) ' Get length of the file. Dim length As Long = info.Length If freeSpace < length Then If USER_LANGUAGE = "de-DE" Then MsgBox("Auf dem Zielverzeichnis ist nicht genug Speicherplatz zum Übertragen frei.", MsgBoxStyle.Exclamation, "Nicht genug Speicherplatz") Else MsgBox("Not enough diskspace in Target-Directory.", MsgBoxStyle.Exclamation, "Not enough diskspace") End If Return -10 End If If LogErrorsOnly = False Then ClassLogger.Add(" ...Datei kopieren von '" & filenameQuelle & "' nach '" & newfilename & "'.", False) Dim Connect Dim Session Dim WMObject Dim aFileIO Dim aWMStream Dim wmbrwsr Dim dmsServer As String If LogErrorsOnly = False Then ClassLogger.Add(" ...Connect definieren: CreateObject('Windream.WMConnect')", False) Connect = CreateObject("Windream.WMConnect") aFileIO = New WMOTOOLLib.WMFileIO 'If My.Settings.DLL_WMOTOOL = "" Then ' aFileIO = New WMOTOOLLib.WMFileIO ' If LogErrorsOnly = False Then ClassLogger.Add(" ...Direkter Verweis auf New WMOTOOLLib.WMFileIO", False) 'Else ' aFileIO = CreateObject(My.Settings.DLL_WMOTOOL) 'WMOTool.WMFileIO oder WMOTOOLLib.WMFileIO ' If LogErrorsOnly = False Then ClassLogger.Add(" ...Verwendeter Verweis aus Anwendungsstring: '" & My.Settings.DLL_WMOTOOL & "'", False) 'End If wmbrwsr = CreateObject("WMOBrws.ServerBrowser") '================================================================== ' get the current DMS-server to log in '================================================================== dmsServer = wmbrwsr.GetCurrentServer '================================================================== ' create a session '================================================================== Session = CreateObject("Windream.WMSession", dmsServer) '================================================================== ' login session '================================================================== Connect.LoginSession(Session) Dim LoggedIn = Session.aLoggedin If LoggedIn Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Login ok. You are logged in as '" & Connect.UserName & "' on Server '" & dmsServer, False) 'MsgBox("Login ok. You are logged in as '" + Connect.UserName + "' on Server '" + dmsServer + "'") Else ClassLogger.Add(" >> Login on dms-Server failed", False) ' MsgBox("Login failed. ") End If oSession = Session Const WMCOMEventWMSessionNeedIndex = 1 'windream Objekte erstellen ohne Indexierungs-Event Session.SwitchEvents(WMCOMEventWMSessionNeedIndex, False) '================================================================== ' check if files exist '================================================================== If LogErrorsOnly = False Then ClassLogger.Add(" ...ÜBERPRÜFTER DATEINAME => " & windreamFilename, False) Dim wdFilexists As Boolean If LogErrorsOnly = False Then ClassLogger.Add(" ...Versuch auf die Datei in W: zuzugreifen und zu sperren...", False) wdFilexists = Session.WMObjectExists(WMEntityDocument, windreamFilename, 0, 0) Err.Clear() If wdFilexists = False Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Datei ist NICHT vorhanden, kann also einfach neu angelegt werden", False) '================================================================== ' create an object '================================================================== WMObject = Session.GetNewWMObjectFS(WMEntityDocument, windreamFilename, WMObjectEditModeObject) 'WMEntityDocument, windreamFilename, WMObjectEditModeObject If Err.Number > 0 Then ClassLogger.Add(" FEHLER: WMObject konnte nicht erzeugt werden - Error: '" & Err.Description & "'") 'MsgBox(Err.Description) End If ' MsgBox("Created file: " + windreamFilename) Else ' wenn auf die Datei zugeriffen werden konnte ist sie bereits vorhanden -> Datum anhängen If LogErrorsOnly = False Then ClassLogger.Add(" ...Es konnte zugegriffen werden -> DATEI IST BEREITS VORHANDEN", False) If CURRENT_DOKART_DUPLICATE_HANDLING = "Default" Or CURRENT_DOKART_DUPLICATE_HANDLING = "Question" Then ''########## Dim msg = String.Format("Eine Datei mit identischem Namen " & vbNewLine & "'{0}'" & vbNewLine & "existiert bereits!" & vbNewLine & "Wollen Sie die bestehende Datei ersetzen?", newfilename) If USER_LANGUAGE <> "de-DE" Then msg = "There is already a file with the same name! Would You like to replace the file?" End If Dim result As MsgBoxResult result = MessageBox.Show(msg, "File alredy exists:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.No Then windreamFilename = ClassFilehandle.Versionierung_Datei(newfilename).ToString.Substring(2) Else If Delete_WDFile(windreamFilename) = False Then Return False End If End If ElseIf CURRENT_DOKART_DUPLICATE_HANDLING = "New version" Then windreamFilename = ClassFilehandle.Versionierung_Datei(newfilename).ToString.Substring(2) End If WMObject = Session.GetNewWMObjectFS(1, windreamFilename, 31) 'WMEntityDocument, windreamFilename, WMObjectEditModeObject If Err.Number > 0 Then ClassLogger.Add(" FEHLER: Neues WMObject (Kopie) konnte nicht erzeugt werden - Error: '" & Err.Description & "'") 'MsgBox(Err.Description) End If If LogErrorsOnly = False Then ClassLogger.Add(" ...WMObject zugewiesen", False) End If If LogErrorsOnly = False Then ClassLogger.Add(" ...ENDGÜLTIGER DATEINAME => " & windreamFilename, False) If WMObject IsNot Nothing Then newfilename = vWLaufwerk & ":" & windreamFilename ' lock object for file system access (to change the file itself) WMObject.lock() ' set fileIO the local source file aFileIO.bstrOriginalFileName = filenameQuelle If Err.Number > 0 Then ClassLogger.Add(" FEHLER: fileIO konnte nicht gesetzt werden - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") ClassLogger.Add(" HINWEIS: Überprüfen Sie den Verweis auf die Bibliotheken 'WMOTool.WMFileIO' UND 'WMOTOOLLib.WMFileIO' und ändern diese in den Anwendungseinstellungen (DLL_WMOTOOL)'", False) WMObject.Unlock() Delete_WDFile(windreamFilename) Return False ' MsgBox(Err.Description) End If ' open the windream object's file stream for writing aWMStream = WMObject.OpenStream(STREAM_BinaryObject, WMObjectStreamOpenModeReadWrite) If Err.Number > 0 Then ClassLogger.Add(" Unexpected error in OpenStream - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") WMObject.Unlock() Delete_WDFile(windreamFilename) Return False 'MsgBox(Err.Description) End If If LogErrorsOnly = False Then ClassLogger.Add(" ...oWMStream erzeugt", False) ' give fileIO helper object the windream stream aFileIO.aWMStream = aWMStream If Err.Number > 0 Then ClassLogger.Add(" Unexpected error in Zuweisen aWMStream zu aFileIO - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") WMObject.Unlock() Delete_WDFile(windreamFilename) Return False 'MsgBox(Err.Description) End If ' let fileIO object import the original file into windream aFileIO.ImportOriginal(True) If Err.Number > 0 Then ClassLogger.Add(" Unexpected error in FileIO.ImportOriginal(True) - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") WMObject.Unlock() Delete_WDFile(windreamFilename) Return False ' MsgBox(Err.Description) End If If LogErrorsOnly = False Then ClassLogger.Add(" ...Inhalt der Datei konnte übertragen werden", False) ' close the windream file stream aWMStream.Close() If Err.Number > 0 Then ClassLogger.Add(" Unexpected error in aWMStream.Close() - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") WMObject.Unlock() Delete_WDFile(windreamFilename) Return False 'MsgBox(Err.Description) End If ' save new windream object WMObject.save() If Err.Number > 0 Then ClassLogger.Add(" Unexpected error in WMObject.save - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") WMObject.Unlock() Delete_WDFile(windreamFilename) Return False 'MsgBox(Err.Description) End If If LogErrorsOnly = False Then ClassLogger.Add(" ...Datei konnte gespeichert werden", False) ' unlock the windream object WMObject.unlock() If Err.Number > 0 Then ClassLogger.Add(" Unexpected error in WMObject.unlock - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") WMObject.Unlock() Delete_WDFile(windreamFilename) Return False 'MsgBox(Err.Description) End If 'DATEI GRÖSSE ERMITTELN - MANCHMAL KOMMT ES VOR DAS DATEIGRÖße 0 ist Dim info2 As New FileInfo(newfilename) Dim length1 As Long = info2.Length If LogErrorsOnly = False Then ClassLogger.Add(" ...Length der Zieldatei: " & length1.ToString, False) If length > 0 And Err.Number = 0 Then Dim p As String If windreamFilename.StartsWith("\") Then If windreamFilename.StartsWith("\\") Then p = windreamFilename.Replace("\\", "\") Else p = windreamFilename End If Else p = "\" & windreamFilename End If CURRENT_NEWFILENAME = vWLaufwerk & ":" & p ClassLogger.Add(" >> Datei '" & CURRENT_NEWFILENAME & "' wurde erfolgreich importiert!", False) aktWMObject = WMObject Return True Else Delete_WDFile(windreamFilename) Console.WriteLine(Err.Number.ToString) ClassLogger.Add(" Unexpected error in Datei-Übertragen - FileLength ist 0, Übertragene Datei wurde gelöscht") Return False End If Else ClassLogger.Add(" Could not create a WMObject for file:'" & windreamFilename) If Not Err() Is Nothing Then If Not Err.Description Is Nothing Then ClassLogger.Add(Err.Description) End If End If Return False End If Else If LogErrorsOnly = False Then ClassLogger.Add("...targetPath existiert NICHT", False) Return False End If End Function Public Shared Function Delete_WDFile(ByVal WD_File As String) Try If Not WD_File.StartsWith("\") Then WD_File = WD_File.Substring(2) End If Dim WMObject As WINDREAMLib.WMObject '= CreateObject("WINDREAMLib.WMObject") 'New WINDREAMLib.WMObject Try WMObject = oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, WD_File) 'WINDREAMLib.WMEntity.WMEntityDocument Catch ex As Exception ClassLogger.Add(">> Could not create WMObject for file '" & WD_File & "' - so it is not existing", False) Return False End Try If LogErrorsOnly = False Then ClassLogger.Add(" >> Deleting started - Object created", False) WMObject.Delete() Return True Catch ex As Exception MsgBox("Unexpected Error in Delete_WDFile: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Unexpected Error in Delete_WDFile: " & ex.Message, False) Return False End Try End Function ''' ''' Übergibt einer in windream gespeicherten Datei Indexwerte ''' ''' Name der zu indexierenden Datei ''' neuer Name der zu indexierenden Datei ''' Liefert True wenn das Indexieren erfolgreich war, sonst False ''' Public Shared Function DateiIndexieren(ByVal WD_File As String, ByVal _Indexname As String, ByVal _Value As String) Try If LogErrorsOnly = False Then ClassLogger.Add(" ...DateiIndexieren wurde aufgerufen", False) WD_File = WD_File.Substring(2) Dim WMObject As WINDREAMLib.WMObject '= CreateObject("WINDREAMLib.WMObject") 'New WINDREAMLib.WMObject 'MsgBox("DateiIndexieren:" & vbNewLine & ClassDateiimportWindream.GetWindreamDriveLetter & filenameZiel & vbNewLine & Me.selectedProfile.DokumenttypString) ' den Dokumenttyp schreiben If LogErrorsOnly = False Then ClassLogger.Add(" ## Indexieren wird gestartet ##", False) ' ein windream-Objekt der Datei anlegen WMObject = aktWMObject 'oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, WD_File) Try ' die Datei sperren WMObject.lock() Catch ex As Exception ' nichts tun (Datei ist bereits gesperrt) End Try ' wenn der Datei noch kein Dokumenttyp zugewiesen wurde If WMObject.aObjectType.aName = "Standard" Then ' ihr den entsprechenden Dokumenttyp zuweisen WMObject.aObjectType = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, _WDObjekttyp) ' WMObject.aObjectType = Me.selectedProfile.Dokumenttyp If LogErrorsOnly = False Then ClassLogger.Add(" ...Objekttyp wird gesetzt", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" ...Objekttyp war bereits gesetzt", False) End If Try WMObject.Save() Catch ex As Exception ' wenn es einen Unexpected error inm 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 WMObject.unlock() Catch ex As Exception ' wenn das entsperren nicht geklappt hat, dann war die Datei auch nicht gesperrt End Try If LogErrorsOnly = False Then ClassLogger.Add(" ...Datei wurde gespeichert / Unlock wurde durchgeführt", False) ' wenn bis hierher alles geklappt hat wurde ein Dokumenttyp übergeben If LogErrorsOnly = False Then ClassLogger.Add(" ...Objekttyp: " & _WDObjekttyp, False) ' wenn keine Werte vorhanden sind, soll wenigstens der Dokumenttyp eingetragen werden Dim indexe As String = "" If LogErrorsOnly = False Then ClassLogger.Add(" ...Indexname: '" & _Indexname & "'", False) Dim werte = New ArrayList If (GetTypeOfIndexAsIntByName(_Indexname) = WMObjectVariableValueTypeVector) Or GetTypeOfIndexAsIntByName(_Indexname) = 4097 Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Es handelt sich um ein Vektor-Feld", False) 'Am 04.08.2014 aktualisiert: um zu verhindern das die vorangegangene Versionierung "Tilde-Werte" schreibt If LogErrorsOnly = False Then ClassLogger.Add(" ...Wert vor Überprüfung: " & _Value, False) _Value = CheckIndexValue(_Value) 'Ausstieg da Fehler in der Überprüfung If _Value Is Nothing Then Return False End If If LogErrorsOnly = False Then ClassLogger.Add(" ...Value für Indexierung: " & _Value, False) werte.Add(_Value) If LogErrorsOnly = False Then ClassLogger.Add(" ...Werte zu Array hinzugefügt!", False) Else 'Am 04.08.2014 aktualisiert: um zu verhindern das die vorangegangene Versionierung "Tilde-Werte" schreibt If LogErrorsOnly = False Then ClassLogger.Add(" ...Value vor Überprüfung: " & _Value, False) _Value = CheckIndexValue(_Value) 'Ausstieg da Fehler in der Überprüfung If _Value Is Nothing Then Return False End If If LogErrorsOnly = False Then ClassLogger.Add(" ...Value für Indexierung: " & _Value, False) werte.Add(_Value) End If 'indexe &= indexname & " = " & werte & vbNewLine 'Der Indexierungsvorgang ' Dim indexErgebnis As ArrayList = Indexiere(filenameZiel, _Indexname, werte) 'Me.singleInfoNode.Insert(0, Me.singleInfoNode(1)) 'Me.singleInfoNode.Insert(0, Me.singleInfoNode(0)) Dim arrIndex() As String = Nothing Dim arrValue() As String = Nothing ReDim Preserve arrIndex(0) ReDim Preserve arrValue(0) arrIndex(0) = _Indexname arrValue(0) = _Value Return RunIndexing(WMObject, arrIndex, arrValue) 'MsgBox(arr(0) & vbNewLine & indexe) Catch ex As Exception ClassLogger.Add("Hinweis: Die Datei " & WD_File & " konnte nicht indexiert werden.") ClassLogger.Add("Fehler: " & ex.Message) ' Me.TreeNodeInfos.Add(temp) Return False End Try End Function Private Shared Function RunIndexing(ByVal oDocument As WMObject, ByVal Indizes() As String, ByVal aValues() As Object) Dim vektInsState As Integer = 1 Try If Indizes IsNot Nothing And aValues IsNot Nothing Then If Not oDocument.aLocked Then oDocument.lock() Dim i As Integer = 0 Dim indexname As String If aValues.Length = 1 And aValues(0) = "" Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Indexwert ist leer/Nothing - Keine Nachindexierung", False) End If ' wenn der Datei noch kein Dokumenttyp zugewiesen wurde If oDocument.aObjectType.aName <> _WDObjekttyp Then ' ihr den entsprechenden Dokumenttyp zuweisen oDocument.aObjectType = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, _WDObjekttyp) ' WMObject.aObjectType = Me.selectedProfile.Dokumenttyp If LogErrorsOnly = False Then ClassLogger.Add(" ...Objekttyp '" & oDocument.aObjectType.aName & "' wurde in '" & _WDObjekttyp & "' geändert.", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" ...Objekttyp war bereits gesetzt", False) End If Try oDocument.Save() Catch ex As Exception ' wenn es einen Unexpected error inm 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 LogErrorsOnly = False Then ClassLogger.Add(" ", False) ClassLogger.Add(" >> Indexierung von Index '" & indexname & "'", False) End If ' das entsprechende Attribut aus windream auslesen Dim oAttribute = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, Indizes(i)) ' den Variablentyp (String, Integer, ...) auslesen Dim vType = oAttribute.getVariableValue("dwAttrType") ' wenn in aValues an Position i ein Wert steht If IsNotEmpty(aValues(i)) Then Dim _int As Boolean = False Dim _date As Boolean = False Dim _dbl As Boolean = False Dim _bool As Boolean = False '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 LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeString", False) convertValue = CStr(value) Case WMObjectVariableValueTypeInteger If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeInteger", False) value = value.ToString.Replace(" ", "") If IsNumeric(value) = False Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Achtung: Value '" & value & "' kann nicht in Zahl konvertiert werden!", False) End If value = value.ToString.Replace(" ", "") convertValue = CInt(value) _int = True Case WMObjectVariableValueTypeFloat If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeFloat", False) value = value.ToString.Replace(" ", "") convertValue = CDbl(value) Case WMObjectVariableValueTypeFixedPoint If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeFixedPoint", False) value = value.ToString.Replace(" ", "") convertValue = CDbl(value) _dbl = True Case WMObjectVariableValueTypeBoolean If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeBoolean", False) convertValue = CBool(value) _bool = True Case WMObjectVariableValueTypeDate If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeDate", False) _date = True 'Dim _date As Date = value convertValue = value Case WMObjectVariableValueTypeTimeStamp If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeTimeStamp", False) convertValue = value Case WMObjectVariableValueTypeCurrency If LogErrorsOnly = False Then ClassLogger.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 LogErrorsOnly = False Then ClassLogger.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 LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeFloat", False) convertValue = CStr(value) Case WMObjectVariableValueTypeVariant If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeVariant", False) convertValue = CStr(value) Case WMObjectVariableValueTypeFulltext If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: WMObjectVariableValueTypeFulltext", False) convertValue = CStr(value) Case 4097 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 4097 Vektor alphanumerisch", False) 'Vektor alphanumerisch convertValue = CStr(value) Case 4098 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 4098 Vektor Numerisch", False) 'Vektor Numerisch convertValue = CStr(value) Case 4099 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 4099 Vektor Kommazahl", False) 'Vektor Kommazahl convertValue = CStr(value) Case 4101 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 4101 Vektor Date", False) 'Vektor Kommazahl convertValue = CStr(value) Case 4103 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 4103 Vektor DateTime", False) 'Vektor DateTime convertValue = CStr(value) Case 4107 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 4107 Integer 64bit", False) convertValue = CStr(value) Case 36865 vektor = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes: 36865 Vektor alphanumerisch", False) 'Vektor Kommazahl convertValue = CStr(value) Case Else If LogErrorsOnly = False Then ClassLogger.Add(" ...Typ des windream-Indexes konnte nicht bestimmt werden!", False) If LogErrorsOnly = False Then ClassLogger.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 LogErrorsOnly = False Then ClassLogger.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 LogErrorsOnly = False Then ClassLogger.Add(" ...Versuch dem Dok einen Index zuzuweisen: oDocument.SetVariableValue(" & aName & ", " & convertValue & ")", False) 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() If LogErrorsOnly = False Then ClassLogger.Add(" ...Index '" & aName & "' wurde geschrieben", False) ClassLogger.Add("", False) End If Else ClassLogger.Add(" >> Kein Indexwert vorhanden", False) End If Else 'VEKTORFELDER, ALSO ÜBERPRÜFEN OB ERGEBNIS-ARRAY GEFÜLLT IST If LogErrorsOnly = False Then ClassLogger.Add(" >> VEKTORFELD: Vorbereiten des Arrays", False) Dim myArray() 'For Each row As DataRow In DT.Rows 'MsgBox(aName & vbNewLine & row.Item("Indexname") & vbNewLine & CStr(row.Item("Wert"))) 'Next Dim Anzahl As Integer = aValues.Length 'Vektorfeld wird mit EINEM Wert gefüllt If Anzahl = 1 Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Vektorfeld wird mit EINEM Wert gefüllt ", False) ReDim myArray(0) Select Case vType Case 36865 'Umwandeln in String myArray(0) = CStr(value) Case 4097 'Umwandeln in String myArray(0) = CStr(value) Case 4098 'Umwandeln in Integer value = value.ToString.Replace(" ", "") myArray(0) = CInt(value) Case 4099 Dim Str As String = value Str = Str.ToString.Replace(" ", "") 'Umwandeln in Double myArray(0) = CDbl(Str.Replace(".", ",")) Case 4101 'Umwandeln in Date myArray(0) = CDate(value) Case 4107 myArray(0) = Convert.ToInt64(value) Case 4103 'Umwandeln in Datum Uhrzeit myArray(0) = value Case Else 'Umwandeln in String myArray(0) = CStr(value) End Select 'Jetzt überprüfen ob Werte in Vektorfeld angefügt oder überschrieben werden sollen If LogErrorsOnly = False Then ClassLogger.Add(" >> Konvertierter Wert: " & myArray(0).ToString, False) Dim VektorArray() 'Immer anfügen If LogErrorsOnly = False Then ClassLogger.Add(" >> Check Existing Vektorvalues", False) VektorArray = Return_VektorArray(oDocument, aName, myArray) If VektorArray Is Nothing = False Then ReDim myArray(VektorArray.Length - 1) Array.Copy(VektorArray, myArray, VektorArray.Length) 'Jetzt die Nachindexierung für Vektor-Felder oDocument.SetVariableValue(aName, myArray) 'myArray) If LogErrorsOnly = False Then ClassLogger.Add(" >> 'SetVariableValue' für VEKTOR mit einem Wert erfolgreich", False) 'Die Änderungen festsschreiben/speichern oDocument.Save() End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Vektorfeld wird mit MEHREREN Werten gefüllt ", False) ' das ausgewählte Profil in _selectedProfile laden '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 obj In myArray myArray(i1) = CStr(obj) If LogErrorsOnly = False Then ClassLogger.Add(" >> Wert (" & i1 & ") aus Datatable: '" & myArray(i1).ToString & "'", False) i1 = i1 + 1 Next If LogErrorsOnly = False Then ClassLogger.Add(" >> Array wurde erfolgreich erzeugt", False) Dim VektorArray() VektorArray = Return_VektorArray(oDocument, aName, myArray) If VektorArray Is Nothing = False Then 'Das Array wieder anpassen ReDim myArray(VektorArray.Length - 1) 'Array.Copy(VektorArray, myArray, VektorArray.Length) i1 = 0 For Each _value As Object In VektorArray Select Case vType Case 36865 myArray(i1) = CStr(_value) Case 4097 myArray(i1) = CStr(_value) Case 4098 Dim v As String = _value.ToString.Replace(" ", "") myArray(i1) = CInt(v) Case 4099 'Vektroryp Double Dim Str As String = _value Str = Str.ToString.Replace(" ", "") myArray(i1) = CDbl(Str.Replace(".", ",")) Case 4101 'Vektortyp DATE Dim dat As String = _value myArray(i1) = CDate(dat.Replace(".", ",")) Case 4107 myArray(i1) = Convert.ToInt64(_value) Case Else 'Vektortyp ALPHANUMERISCH 'Die Größe des Arrays festlegen myArray(i1) = CStr(myArray(0)) End Select If LogErrorsOnly = False Then ClassLogger.Add(" >> Konvertierter Wert (" & i1 & ") : '" & myArray(i1).ToString & "'", False) i1 += 1 Next 'Jetzt die Nachindexierung für Vektor-Felder Try oDocument.SetVariableValue(aName, myArray) Catch ex As Exception ClassLogger.Add("RunIndexing -Unexpected error in indexing Vectorfield: " & ex.Message, True) oDocument.Save() oDocument.unlock() Return False End Try If LogErrorsOnly = False Then ClassLogger.Add(" >> 'SetVariableValue' für VEKTOR erfolgreich", False) ' oDocument.LockRights() 'Die Änderungen festsschreiben/speichern oDocument.Save() If LogErrorsOnly = False Then ClassLogger.Add(">> Indexierung erfolgreich beendet (Save ...", False) Else ClassLogger.Add(" - Achtung: VektorArray Is NOTHING", False) oDocument.Save() Return True End If End If End If End If i += 1 Next oDocument.unlock() If LogErrorsOnly = False Then ClassLogger.Add(">> ...und Unlock durchgeführt)", False) ClassLogger.Add("", False) End If Return True Else ClassLogger.Add(" >> Dokument ist gesperrt, Indexierung erst im nächsten Durchlauf!", False) 'oDocument.unlock() Return False End If End If Catch ex As Exception ClassLogger.Add("ClassNiWindream.RunIndexing: " & ex.Message) oDocument.Save() oDocument.unlock() Return False End Try End Function Private Shared Function Return_VektorArray(ByVal oDocument As WMObject, vktIndexName As String, NIIndexe 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 LogErrorsOnly = False Then ClassLogger.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) = 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 ValueArray.Contains(NewValue) = False Then 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 Else ClassLogger.Add(" >> Value '" & NewValue.ToString & "' bereits in Vektorfeld enthalten", False) End If End If Next End If Else If LogErrorsOnly = False Then ClassLogger.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 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) = NewValue.ToString Anzahl += 1 Else ClassLogger.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) = NewValue.ToString Anzahl += 1 End If End If Next End If Return ValueArray Catch ex As Exception ClassLogger.Add("Unexpected Error in ClassWindream.Return_VektorArray: " & ex.Message, True) End Try End Function Private Shared Function IsNotEmpty(ByVal aValue As Object) If aValue IsNot Nothing Then Dim itsType As Type = aValue.GetType If itsType Is GetType(String) Then If Not aValue = "" Then Return True End If Return False Else Return True End If Else Return False End If End Function ''' ''' Führt das eigendliche Indexieren aus ''' ''' Dateiname der zu indexierenden Datei ''' Name des zu indexierenden Indexfeldes ''' Der Wert/die Werte die dem Index zugewiesen werden sollen ''' Liefert True wenn das Indexieren erfolgreich war, sonst False ''' Private Shared Function Indexiere(ByVal filenameZiel As String, ByVal index As String, ByVal werte As Object) If LogErrorsOnly = False Then ClassLogger.Add(" - In Indexierungsvorgang für: " & filenameZiel, False) Try Dim WMObject As WINDREAMLib.WMObject = Nothing '= CreateObject("WINDREAMLib.WMObject") '= New WINDREAMLib.WMObject 'CreateObject("WINDREAMLib.WMObject") 'MsgBox("Indexiere: " & vbNewLine & filenameZiel) 'werte Is Nothing Or _ ' überprüfen ob alle notwendigen Informationen angegeben wurden (sonst abbrechen) If filenameZiel Is Nothing Or _ filenameZiel = "" Or _ index Is Nothing Or _ index = "" Or _ Not ExistIndexInObjekttyp(_WDObjekttyp, index) Then If LogErrorsOnly = False Then ClassLogger.Add("=> Hinweis: Die Datei wurde auf Grund eines Problems in der Initialisierung nicht vollständig indexiert.", False) Return False End If Dim fileExists As Boolean ' prüfen ob die zu indexierende Datei existiert fileExists = My.Computer.FileSystem.FileExists(vWLaufwerk & ":" & filenameZiel) '_windream.GetWindreamDriveLetter Dim an As Integer = 0 Do While My.Computer.FileSystem.FileExists(vWLaufwerk & ":" & filenameZiel) = False If an > 500 Then fileExists = False Exit Do Else If LogErrorsOnly = False Then ClassLogger.Add(" Achtung: Datei exisitiert noch nicht: " & My.Computer.Clock.LocalTime, True) End If an = an + 1 Loop ' wenn die Datei existiert If fileExists Then WMObject = oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, filenameZiel) ' eine Variable für den umgewandelten Indexwert anlegen (kein Typ, da noch unklar ist was reingeschrieben wird) 'Dim convertValue = Nothing ' den Typ des Zielindexes auslesen Dim TypDesIndexes As Integer Try ' ein windream-Objekt der Datei anlegen WMObject = oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, filenameZiel) If LogErrorsOnly = False Then ClassLogger.Add(" - windream-Objekt der Datei erzeugt", False) ClassLogger.Add(" - Ziel: W:\" & filenameZiel, False) End If 'Me.singleInfoNode.Add("Ziel: " & ClassDateiimportWindream.GetWindreamDriveLetter & filenameZiel) Try ' die Datei sperren WMObject.lock() 'WMObject.LockFor(WINDREAMLib.WMObjectEditMode.WMObjectEditModeObject) Catch ex As Exception End Try ' wenn der Datei noch kein Dokumenttyp zugewiesen wurde If WMObject.aObjectType.aName = "Standard" Then ' ihr den entsprechenden Dokumenttyp zuweisen WMObject.aObjectType = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityObjectType, _WDObjekttyp) ' WMObject.aObjectType = Me.selectedProfile.Dokumenttyp End If ' wenn keine Werte vorhanden sind, soll wenigstens der Dokumenttyp eingetragen werden If werte Is Nothing Then Try WMObject.Save() WMObject.unlock() Catch ex As Exception End Try Return Nothing End If ' den Typ des Zielindexes auslesen TypDesIndexes = GetTypeOfIndexAsIntByName(index) ' wenn es sich bei dem Index NICHT um ein Vektorfeld handelt If TypDesIndexes < WMObjectVariableValueTypeVector Then If LogErrorsOnly = False Then ClassLogger.Add(" - Bei dem Zielindex handelt es sich um einen Einzelindex.", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" Bei dem Zielindex handelt es sich um ein Vektorfeld.", False) ' ein Backup der Indexwerte anlegen Dim temp As Object = werte ' und die eigendliche Variable zurücksetzen werte = Nothing ' dann soll nur der letzte Wert des Arrays übernommen werden, damit nicht versucht wird ein ' Array in einen Einzelindex zu speichern werte = temp If LogErrorsOnly = False Then ClassLogger.Add(" - Array geleert und erneuert!", False) End If Catch ex As Exception ClassLogger.Add("Hinweis: Beim Initialisieren der Datei auf dem windream-Laufwerk ist ein Fehler aufgetreten.", False) Return False End Try 'Try ' den Typ des Zielindexes If LogErrorsOnly = False Then ClassLogger.Add(" - Typ des Indexes: " & TypDesIndexes.ToString, False) Select Case (TypDesIndexes) Case WMObjectVariableValueTypeUndefined ' zu klären !!!! 'convertValue = vbEmpty Case WMObjectVariableValueTypeString ''Führende Nullen Entfernen 'If werte.ToString.StartsWith("0") Then ' Dim wert As String = CStr(CInt(werte.ToString)) ' convertValue = wert ' ClassLogger.Add(" - Führende Nullen wurden entfernt", False) 'Else ' Dim wert As String = CStr(CInt(werte.ToString)) ' convertValue = wert 'End If 'If convertValue.ToString.Contains("~1") Then ' convertValue = convertValue.ToString.Replace("~1", "") 'End If 'If convertValue.ToString.Contains("~2") Then ' convertValue = convertValue.ToString.Replace("~2", "") 'End If 'If convertValue.ToString.Contains("~3") Then ' convertValue = convertValue.ToString.Replace("~3", "") 'End If 'If convertValue.ToString.Contains("~4") Then ' convertValue = convertValue.ToString.Replace("~4", "") 'End If Case WMObjectVariableValueTypeInteger ' convertValue = CInt(werte) Case WMObjectVariableValueTypeFloat werte = werte.ToString.Replace(".", ",") 'convertValue = CDbl(werte) Case WMObjectVariableValueTypeBoolean Try ' convertValue = CBool(werte) Catch ex As Exception ' Nothing zuweisen damit SetVariableValue nicht ausgeführt wird 'convertValue = Nothing End Try Case WMObjectVariableValueTypeDate If (IsDate(werte)) Then ' convertValue = CDate(werte) Else ' convertValue = vbEmpty End If Case WMObjectVariableValueTypeFixedPoint werte = werte.ToString.Replace(".", ",") ' convertValue = CDbl(werte) Case WMObjectVariableValueTypeTimeStamp Dim timestamp As Integer = GetTimestamp(werte) If timestamp > 0 Then ' convertValue = timestamp Else ' convertValue = vbEmpty End If Case WMObjectVariableValueTypeCurrency Dim aValue As System.Runtime.InteropServices.CurrencyWrapper = New System.Runtime.InteropServices.CurrencyWrapper(werte) ' convertValue = aValue Case WMObjectVariableValueTypeTime If (IsDate(werte)) Then ' convertValue = CDate(werte) ' ggf. aber nur die Zeit Else ' convertValue = vbEmpty End If Case WMObjectVariableValueTypeVariant ' convertValue = werte Case WMObjectVariableValueTypeMask ' zu klären !!!! ' convertValue = vbEmpty Case WMObjectVariableValueFlagMask ' zu klären !!!! ' convertValue = vbEmpty Case WMObjectVariableValueTypeFulltext 'convertValue = CStr(werte) Case WMObjectVariableValueTypeDefaultValue ' zu klären !!!! ' convertValue = vbEmpty Case Else ' wenn es sich um einen TypVektorIndex handelt If TypDesIndexes >= 4096 And TypDesIndexes < 8192 Then If LogErrorsOnly = False Then ClassLogger.Add("- Es handelt sich um einen Vektorindex", False) Dim temp_arr As New ArrayList Select Case (TypDesIndexes - WMObjectVariableValueTypeVector) 'VektorIndex vom Typ String 64' Case 1 If LogErrorsOnly = False Then ClassLogger.Add("- VektorIndex vom Typ String 1", False) For Each wert As Object In werte 'Führende Nullen Entfernen If werte.ToString.StartsWith("0") Then Dim werteString As String = CStr(CInt(wert.ToString)) wert = werteString temp_arr.Add(CStr(wert)) ClassLogger.Add("- Führende Nullen wurden entfernt", False) Else temp_arr.Add(CStr(wert)) End If If LogErrorsOnly = False Then ClassLogger.Add("- Wert " & CStr(wert) & " konvertiert", False) Next Case WMObjectVariableValueTypeUndefined ' convertValue = "" Case WMObjectVariableValueTypeString If LogErrorsOnly = False Then ClassLogger.Add("- VektorIndex vom Typ String 2", False) For Each wert As Object In werte 'Führende Nullen Entfernen If werte.ToString.StartsWith("0") Then wert = CInt(wert) temp_arr.Add(CStr(wert)) ClassLogger.Add("- Führende Nullen wurden entfernt", False) Else temp_arr.Add(CStr(wert)) End If If LogErrorsOnly = False Then ClassLogger.Add("- Wert " & CStr(wert) & " konvertiert", False) Next Case WMObjectVariableValueTypeInteger If LogErrorsOnly = False Then ClassLogger.Add("- VektorIndex vom Typ Integer", False) For Each wert As Object In werte temp_arr.Add(CInt(wert)) Next Case WMObjectVariableValueTypeFloat For Each wert As Object In werte wert = wert.ToString.Replace(".", ",") temp_arr.Add(CDbl(wert)) Next Case WMObjectVariableValueTypeBoolean For Each wert As Object In werte Try temp_arr.Add(CBool(wert)) Catch ex As Exception ' Nothing zuweisen damit SetVariableValue nicht ausgeführt wird temp_arr = Nothing End Try Next Case WMObjectVariableValueTypeDate For Each wert As Object In werte 'wert = temp_arr.Add(CDate(wert)) Next Case WMObjectVariableValueTypeFixedPoint For Each wert As Object In werte temp_arr.Add(CDbl(wert)) Next Case WMObjectVariableValueTypeTimeStamp For Each wert As Object In werte temp_arr.Add(CInt(wert)) Next Case WMObjectVariableValueTypeCurrency For Each wert As Object In werte Dim aValue As System.Runtime.InteropServices.CurrencyWrapper = New System.Runtime.InteropServices.CurrencyWrapper(werte) temp_arr.Add(aValue) Next Case WMObjectVariableValueTypeTime For Each wert As Object In werte temp_arr.Add(CDate(wert)) Next Case WMObjectVariableValueTypeVariant ' dann bleiben alle Werte wie sie sind End Select If temp_arr.Count > 0 Then If LogErrorsOnly = False Then ClassLogger.Add("- Einträge in temp_arr also Speichern des Arrays in convertValue", False) ' convertValue = Nothing ' convertValue = temp_arr.ToArray Else ' convertValue = vbEmpty End If If LogErrorsOnly = False Then ClassLogger.Add("- Werte erfolgreich konvertiert", False) Else ' convertValue = vbEmpty End If End Select 'Catch ex As Exception ' ' einen Hinweis über einen aufgetretenen Fehler an das Array für den TreeView-Log anhängen ' ClassLogger.Add("Unexpected error in Auswerten/Konvertieren des Typs!", ex.Message) ' ' die Indexierungsinformationen für den TreeView-Log zurückgeben ' Return False 'End Try ' Try ' ***** Anmerkung: das Nachindexieren mit vbEmpty ist möglich (siehe oben) jedoch nicht ***** ' ***** das Indexieren mit einem Nothing-Wert !!! ***** ' wenn das Konvertieren soweit gut gelaufen ist (also kein Nothing-Wert zugewiesen wurde) ' If (convertValue Is Nothing) = False Then ' den konvertierten Indexwert dem entsprechenden Index zuweisen WMObject.SetVariableValue(index, werte) If LogErrorsOnly = False Then ClassLogger.Add(" - den konvertierten Indexwert dem entsprechenden Index zuweisen", False) ClassLogger.Add(" - Indexname: " & index.ToString, False) ClassLogger.Add(" - Indexwert: " & werte.ToString, False) End If 'End If ' die Indexinformationen des Dokuments speichern WMObject.Save() If LogErrorsOnly = False Then ClassLogger.Add(" - die Indexinformationen des Dokuments speichern", False) ' Unlock in einem unbehandelten Try-Block um Fehler abzufangen, ' wenn eine Datei nicht gesperrt ist Try ' die Sperrung des Dokuments aufheben WMObject.unlock() If LogErrorsOnly = False Then ClassLogger.Add(" - die Sperrung des Dokuments aufheben", False) Catch ex As Exception ' nichts tun (Datei war nicht gesperrt) End Try 'Catch ex As Exception ' ' auch wenn ein Fehler aufgetreten ist muss das Dokument gespeichert werden, um den Dokumenttypen zu speichern ' WMObject.Save() ' ' Unlock in einem unbehandelten Try-Block um Fehler abzufangen, ' ' wenn eine Datei nicht gelocked ist ' Try ' WMObject.unlock() ' Catch ex2 As Exception ' ' nichts tun (Datei war nicht gesperrt) ' End Try ' ' Nachricht für den TreeView-Log ' indexBeschreibung &= "konnte nicht indexiert werden" ' ClassLogger.Add(" DATEI konnte nicht indexiert werden", True) 'End Try ' die Indexierungsinformationen für den TreeView-Log zurückgeben Return True Else ' die Indexierungsinformationen für den TreeView-Log zurückgeben ClassLogger.Add(" Hinweis: Die Datei hat zum Zeitpunkt der Indexierung noch nicht auf dem windream-Laufwerk existiert.", False) End If Catch ex As Exception ClassLogger.Add(" Hinweis: Unbekannter Unexpected error inm Indexieren der Datei.") ClassLogger.Add(ex.Message) End Try Return True End Function ''' ''' Diese Funktion überprüft ob eine Variable ein Array ist, oder nicht. ''' ''' Variable die überprüft werden soll ''' Liefert True wenn es sich um ein Array handelt, sonst False ''' Private Shared Function IsArray(ByVal arrayOrNot As Object) Dim arrayType As String = UCase(arrayOrNot.GetType.ToString) ' überprüft an welcher Stelle sich ein '['-Zeichen befindet Dim position = InStr(arrayType, "[") ' existiert ein '['-Zeichen, so handelt es sich um ein Array (GetType wäre System.Object[]) If Not position = 0 Then Return True Else Return False End If End Function ''' ''' Diese Funktion überprüft ob eine Variable eine ArrayList ist, oder nicht. ''' ''' Variable die überprüft werden soll ''' Liefert True wenn es sich um eine ArrayList handelt, sonst False ''' Private Shared Function IsArrayList(ByVal arrayOrNot As Object) Dim arrayType As String = UCase(arrayOrNot.GetType.ToString) ' überprüft an welcher Stelle sich ein '['-Zeichen befindet Dim position = InStr(arrayType, "[") ' existiert ein '['-Zeichen, so handelt es sich um ein Array (GetType wäre System.Object[]) If arrayOrNot.GetType.ToString = "System.Collections.ArrayList" Then Return True Else Return False End If End Function ''' ''' Diese Funktion errechnet aus einem Datum den Unix-Timestamp ''' ''' Datum, für das der Timestamp errechnet werden soll ''' Liefert den Timestamp als Integer ''' Private Shared Function GetTimestamp(ByVal FromDateTime As DateTime) As Integer If IsDate(FromDateTime) Then Dim Startdate As DateTime = #1/1/1970# Dim Spanne As TimeSpan ' vom Datum das Datum des "Beginns der Zeitrechnung" abziehen Spanne = FromDateTime.Subtract(Startdate) ' die Zeitspanne in einen Integer umwandeln Return CType(Math.Abs(Spanne.TotalSeconds()), Integer) Else Return 0 End If End Function ''' ''' Liefert den Typen eines Indexes als Integer. ''' ''' Name des zu überprüfenden Indexfeldes ''' Liefert eine Zahl, die einen Typen beschreibt ''' Public Shared Function GetTypeOfIndexAsIntByName(ByVal indexname As String) As Integer Try Dim oAttribute = oSession.GetWMObjectByName(WINDREAMLib.WMEntity.WMEntityAttribute, indexname) Dim vType = oAttribute.getVariableValue("dwAttrType") Return vType Catch ex As Exception Return Nothing End Try End Function Private Shared Function CheckIndexValue(ByVal input) Try 'Ersetzt die Versionierungen Tilde(~) und Klammern ((1)) For i As Integer = 1 To 20 If input.ToString.EndsWith("~" & i.ToString) Then input = input.ToString.Replace("~" & i.ToString, "") ElseIf input.ToString.EndsWith("(" & i.ToString & ")") Then input = input.ToString.Replace("(" & i.ToString & ")", "") End If Next Return input Catch ex As Exception ClassLogger.Add("Fehler in CheckIndexValue: " & ex.Message) Return Nothing End Try End Function End Class