AppStd/FileFlow
8
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix autoindexing not replacing new placeholders, fix skipping, fix damaged datatable, correct default value of nameconvention

Browse Source
This commit is contained in:
Jonathan Jenne 2020-04-01 13:49:55 +02:00
parent 825cc03f66
commit 92757c55d4
3 changed files with 307 additions and 445 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

563
Global_Indexer/ClassWindream.vb
View File

@ -18,6 +18,8 @@ Public Class ClassWindream
Const VARIABLEN = 2 Const VARIABLEN = 2
Const WMObjectStreamOpenModeReadWrite = 2 Const WMObjectStreamOpenModeReadWrite = 2
Const STREAM_BinaryObject = "BinaryObject"
Public Const WMObjectVariableValueTypeUndefined = 0 Public Const WMObjectVariableValueTypeUndefined = 0
Public Const WMObjectVariableValueTypeString = 1 Public Const WMObjectVariableValueTypeString = 1
Public Const WMObjectVariableValueTypeInteger = 2 Public Const WMObjectVariableValueTypeInteger = 2
@ -295,69 +297,7 @@ Public Class ClassWindream
End Try End Try
End Function End Function
''' <summary>
''' Liefert alle Objekttypen des aktuellen Servers als Array aus Strings.
''' </summary>
''' <returns>Array mit allen Objekttypen als Strings</returns>
''' <remarks></remarks>
Public Function GetObjecttypesAsStrings() As String()
Try
Dim objektTypenStr(_DocumentTypes.Count) As String
For i As Integer = 0 To _DocumentTypes.Count
objektTypenStr(i) = _DocumentTypes.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 = _session.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 = _session.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 = _session.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
''' <summary> ''' <summary>
''' Liefert alle Indexe eines Objekttypen. ''' Liefert alle Indexe eines Objekttypen.
''' </summary> ''' </summary>
@ -406,31 +346,6 @@ Public Class ClassWindream
Return Nothing Return Nothing
End Try End Try
End Function End Function
''' <summary>
''' Liefert einen Objekttyp als WMObject an Hand dessen Name.
''' </summary>
''' <param name="objekttypName">Name des Objekttyps</param>
''' <returns>Objekttyp als WMObject</returns>
''' <remarks></remarks>
Public Function GetObjecttypeByName(ByVal objekttypName As String) As WMObject
Try
' alle Objekttypen auslesen
Dim oObjectTypes As WMObjects = _session.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
''' <summary> ''' <summary>
''' Überprüft ob der angegebene Index im Objekttyp existiert ''' Überprüft ob der angegebene Index im Objekttyp existiert
@ -490,186 +405,135 @@ Public Class ClassWindream
Return "" Return ""
End Function End Function
''' <summary>
''' Liefert das Windream-Laufwerk des windream-Servers, in Form '[Laufwerksbuchstabe]:'. (z.B. 'W:')
''' </summary>
''' <returns>Laufwerksbuchstabe mit Doppelpunkt als String</returns>
''' <remarks></remarks>
'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
''' <summary>
''' Liefert den Typen eines Indexes als Integer.
''' </summary>
''' <param name="indexname">Name des zu überprüfenden Indexfeldes</param>
''' <returns>Liefert eine Zahl, die einen Typen beschreibt</returns>
''' <remarks></remarks>
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 = _session.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 #End Region
Public Shared Function Stream_File(ByVal SourceFilePath As String, ByVal NewFileName As String) Public Shared Function Stream_File(ByVal SourceFilePath As String, ByVal NewFileName As String)
On Error Resume Next
_currentWMObject = Nothing _currentWMObject = Nothing
Dim oDestination As String = Path.GetDirectoryName(NewFileName)
Dim oWindreamFilename As String = NewFileName
Dim oFileName As String = NewFileName
If NewFileName.StartsWith("W:") Then
oFileName = NewFileName.Replace("W:", vWLaufwerk)
oWindreamFilename = NewFileName.Replace("W:", String.Empty)
Else
oWindreamFilename = NewFileName.Replace(vWLaufwerk, String.Empty)
End If
Dim oSourceFilename As String = Path.GetFileName(SourceFilePath)
Dim oDestination As String = Path.GetDirectoryName(oFileName)
If My.Computer.FileSystem.DirectoryExists(oDestination) = False Then If My.Computer.FileSystem.DirectoryExists(oDestination) = False Then
My.Computer.FileSystem.CreateDirectory(oDestination) My.Computer.FileSystem.CreateDirectory(oDestination)
LOGGER.Info(" - Zielverzeichnis neu erzeugt!") LOGGER.Info(" - Zielverzeichnis neu erzeugt!")
End If End If
Const STREAM_BinaryObject = "BinaryObject"
LOGGER.Info(" ...Stream_File wurde gestartet") LOGGER.Info(" ...Stream_File wurde gestartet")
Dim oWindreamFilename As String = ""
' Objekt für Datei und Zielverzeichnis anlegen ' Objekt für Datei und Zielverzeichnis anlegen
Dim oSourceFilename As String = Path.GetFileName(SourceFilePath)
LOGGER.Info(" ...Quelldatei gelesen") LOGGER.Info(" ...Quelldatei gelesen")
'"Version-KZ entfernen
NewFileName = NewFileName.Replace("\\", "\") 'If oWindreamFilename.Contains("[%Version]") Then
oWindreamFilename = NewFileName.Substring(2) ' oWindreamFilename = oWindreamFilename.Replace("[%Version]", "")
If oWindreamFilename.Contains("[%Version]") Then ' NewFileName = oWindreamFilename
oWindreamFilename = oWindreamFilename.Replace("[%Version]", "") 'End If
NewFileName = oWindreamFilename
End If 'If NewFileName.StartsWith("W:") Then
' NewFileName = NewFileName.Replace("W:", vWLaufwerk)
' oWindreamFilename = NewFileName.Replace(vWLaufwerk, String.Empty)
'End If
If My.Computer.FileSystem.DirectoryExists(oDestination) Then If My.Computer.FileSystem.DirectoryExists(oDestination) Then
LOGGER.Info(" ...targetPath existiert") LOGGER.Info(" ...targetPath existiert")
' Überprüfen ob der zu Kopieren notwendige Speicherplatz auf Ziellaufwerk vorhanden ist ' Überprüfen ob der zu Kopieren notwendige Speicherplatz auf Ziellaufwerk vorhanden ist
Dim oDriveInfo As New DriveInfo(vWLaufwerk & ":")
Dim oFreeSpace = oDriveInfo.TotalFreeSpace
Dim oFileInfo As New FileInfo(SourceFilePath) Dim oFileInfo As New FileInfo(SourceFilePath)
' Get length of the file.
Dim oFileLength As Long = oFileInfo.Length Dim oFileLength As Long = oFileInfo.Length
If oFreeSpace < oFileLength 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 'If vWLaufwerk.Count = 1 Then
End If ' Dim oDriveInfo As New DriveInfo(vWLaufwerk & ":")
' Dim oFreeSpace = oDriveInfo.TotalFreeSpace
LOGGER.Info(" ...Datei kopieren von '" & SourceFilePath & "' nach '" & NewFileName & "'.") ' If oFreeSpace < oFileLength Then
Dim Connect ' If USER_LANGUAGE = "de-DE" Then
Dim Session ' MsgBox("Auf dem Zielverzeichnis ist nicht genug Speicherplatz zum Übertragen frei.", MsgBoxStyle.Exclamation, "Nicht genug Speicherplatz")
Dim WMObject ' Else
Dim aFileIO ' MsgBox("Not enough diskspace in Target-Directory.", MsgBoxStyle.Exclamation, "Not enough diskspace")
Dim aWMStream ' End If
Dim wmbrwsr
Dim dmsServer As String ' Return -10
LOGGER.Info(" ...Connect definieren: CreateObject('Windream.WMConnect')") ' End If
Connect = CreateObject("Windream.WMConnect")
aFileIO = New WMOTOOLLib.WMFileIO
'If My.Settings.DLL_WMOTOOL = "" Then
' aFileIO = New WMOTOOLLib.WMFileIO
' LOGGER.Info(" ...Direkter Verweis auf New WMOTOOLLib.WMFileIO")
'Else
' aFileIO = CreateObject(My.Settings.DLL_WMOTOOL) 'WMOTool.WMFileIO oder WMOTOOLLib.WMFileIO
' LOGGER.Info(" ...Verwendeter Verweis aus Anwendungsstring: '" & My.Settings.DLL_WMOTOOL & "'")
'End If 'End If
wmbrwsr = CreateObject("WMOBrws.ServerBrowser") LOGGER.Info(" ...Datei kopieren von '" & SourceFilePath & "' nach '" & NewFileName & "'.")
'================================================================== Dim Connect
' get the current DMS-server to log in Dim Session
'================================================================== Dim WMObject
dmsServer = wmbrwsr.GetCurrentServer Dim aFileIO
'================================================================== Dim aWMStream
' create a session Dim wmbrwsr
'================================================================== Dim dmsServer As String
Session = CreateObject("Windream.WMSession", dmsServer) LOGGER.Info(" ...Connect definieren: CreateObject('Windream.WMConnect')")
'================================================================== Connect = CreateObject("Windream.WMConnect")
' login session aFileIO = New WMOTOOLLib.WMFileIO
'================================================================== 'If My.Settings.DLL_WMOTOOL = "" Then
Connect.LoginSession(Session) ' aFileIO = New WMOTOOLLib.WMFileIO
Dim LoggedIn = Session.aLoggedin ' LOGGER.Info(" ...Direkter Verweis auf New WMOTOOLLib.WMFileIO")
If LoggedIn Then 'Else
LOGGER.Info(" ...Login ok. You are logged in as '" & Connect.UserName & "' on Server '" & dmsServer) ' aFileIO = CreateObject(My.Settings.DLL_WMOTOOL) 'WMOTool.WMFileIO oder WMOTOOLLib.WMFileIO
'MsgBox("Login ok. You are logged in as '" + Connect.UserName + "' on Server '" + dmsServer + "'") ' LOGGER.Info(" ...Verwendeter Verweis aus Anwendungsstring: '" & My.Settings.DLL_WMOTOOL & "'")
Else 'End If
LOGGER.Info(" >> Login on dms-Server failed")
' MsgBox("Login failed. ")
End If
_session = Session
Const WMCOMEventWMSessionNeedIndex = 1
'windream Objekte erstellen ohne Indexierungs-Event
Session.SwitchEvents(WMCOMEventWMSessionNeedIndex, False)
'==================================================================
' check if files exist
'==================================================================
LOGGER.Info(" ...ÜBERPRÜFTER DATEINAME => " & oWindreamFilename)
Dim wdFilexists As Boolean
LOGGER.Info(" ...Versuch auf die Datei in W: zuzugreifen und zu sperren...")
wdFilexists = Session.WMObjectExists(WMEntityDocument, oWindreamFilename, 0, 0)
Err.Clear()
If wdFilexists = False Then
LOGGER.Info(" ...Datei ist NICHT vorhanden, kann also einfach neu angelegt werden")
wmbrwsr = CreateObject("WMOBrws.ServerBrowser")
'================================================================== '==================================================================
' create an object ' get the current DMS-server to log in
'================================================================== '==================================================================
WMObject = Session.GetNewWMObjectFS(WMEntityDocument, oWindreamFilename, WMObjectEditModeObject) 'WMEntityDocument, windreamFilename, WMObjectEditModeObject dmsServer = wmbrwsr.GetCurrentServer
If Err.Number > 0 Then '==================================================================
LOGGER.Info(" FEHLER: WMObject konnte nicht erzeugt werden - Error: '" & Err.Description & "'") ' create a session
'MsgBox(Err.Description) '==================================================================
Session = CreateObject("Windream.WMSession", dmsServer)
'==================================================================
' login session
'==================================================================
Connect.LoginSession(Session)
Dim LoggedIn = Session.aLoggedin
If LoggedIn Then
LOGGER.Info(" ...Login ok. You are logged in as '" & Connect.UserName & "' on Server '" & dmsServer)
'MsgBox("Login ok. You are logged in as '" + Connect.UserName + "' on Server '" + dmsServer + "'")
Else
LOGGER.Info(" >> Login on dms-Server failed")
' MsgBox("Login failed. ")
End If End If
' MsgBox("Created file: " + windreamFilename) _session = Session
Else Const WMCOMEventWMSessionNeedIndex = 1
' wenn auf die Datei zugeriffen werden konnte ist sie bereits vorhanden -> Datum anhängen
LOGGER.Info(" ...Es konnte zugegriffen werden -> DATEI IST BEREITS VORHANDEN") 'windream Objekte erstellen ohne Indexierungs-Event
Session.SwitchEvents(WMCOMEventWMSessionNeedIndex, False)
'==================================================================
' check if files exist
'==================================================================
LOGGER.Info(" ...ÜBERPRÜFTER DATEINAME => " & oWindreamFilename)
Dim wdFilexists As Boolean
LOGGER.Info(" ...Versuch auf die Datei in W: zuzugreifen und zu sperren...")
wdFilexists = Session.WMObjectExists(WMEntityDocument, oWindreamFilename, 0, 0)
Err.Clear()
If wdFilexists = False Then
LOGGER.Info(" ...Datei ist NICHT vorhanden, kann also einfach neu angelegt werden")
'==================================================================
' create an object
'==================================================================
WMObject = Session.GetNewWMObjectFS(WMEntityDocument, oWindreamFilename, WMObjectEditModeObject) 'WMEntityDocument, windreamFilename, WMObjectEditModeObject
If Err.Number > 0 Then
LOGGER.Info(" 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
LOGGER.Info(" ...Es konnte zugegriffen werden -> DATEI IST BEREITS VORHANDEN")
Select Case CURRENT_DOKART_DUPLICATE_HANDLING Select Case CURRENT_DOKART_DUPLICATE_HANDLING
Case "New version" Case "New version"
@ -696,141 +560,126 @@ Public Class ClassWindream
End If End If
End Select End Select
'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, oWindreamFilename, 31) 'WMEntityDocument, windreamFilename, WMObjectEditModeObject WMObject = Session.GetNewWMObjectFS(1, oWindreamFilename, 31) 'WMEntityDocument, windreamFilename, WMObjectEditModeObject
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" FEHLER: Neues WMObject (Kopie) konnte nicht erzeugt werden - Error: '" & Err.Description & "'") LOGGER.Info(" FEHLER: Neues WMObject (Kopie) konnte nicht erzeugt werden - Error: '" & Err.Description & "'")
'MsgBox(Err.Description) 'MsgBox(Err.Description)
End If
LOGGER.Info(" ...WMObject zugewiesen")
End If End If
LOGGER.Info(" ...WMObject zugewiesen") LOGGER.Info(" ...ENDGÜLTIGER DATEINAME => " & oWindreamFilename)
End If If WMObject IsNot Nothing Then
LOGGER.Info(" ...ENDGÜLTIGER DATEINAME => " & oWindreamFilename) 'NewFileName = vWLaufwerk & ":" & oWindreamFilename
If WMObject IsNot Nothing Then
NewFileName = vWLaufwerk & ":" & oWindreamFilename
' lock object for file system access (to change the file itself) ' lock object for file system access (to change the file itself)
WMObject.lock() WMObject.lock()
' set fileIO the local source file ' set fileIO the local source file
aFileIO.bstrOriginalFileName = SourceFilePath aFileIO.bstrOriginalFileName = SourceFilePath
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" FEHLER: fileIO konnte nicht gesetzt werden - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" FEHLER: fileIO konnte nicht gesetzt werden - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
LOGGER.Info(" HINWEIS: Überprüfen Sie den Verweis auf die Bibliotheken 'WMOTool.WMFileIO' UND 'WMOTOOLLib.WMFileIO' und ändern diese in den Anwendungseinstellungen (DLL_WMOTOOL)'") LOGGER.Info(" HINWEIS: Überprüfen Sie den Verweis auf die Bibliotheken 'WMOTool.WMFileIO' UND 'WMOTOOLLib.WMFileIO' und ändern diese in den Anwendungseinstellungen (DLL_WMOTOOL)'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
' MsgBox(Err.Description) ' MsgBox(Err.Description)
End If End If
' open the windream object's file stream for writing ' open the windream object's file stream for writing
aWMStream = WMObject.OpenStream(STREAM_BinaryObject, WMObjectStreamOpenModeReadWrite) aWMStream = WMObject.OpenStream(STREAM_BinaryObject, WMObjectStreamOpenModeReadWrite)
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" Unexpected error in OpenStream - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" Unexpected error in OpenStream - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
'MsgBox(Err.Description) 'MsgBox(Err.Description)
End If End If
LOGGER.Info(" ...oWMStream erzeugt") LOGGER.Info(" ...oWMStream erzeugt")
' give fileIO helper object the windream stream ' give fileIO helper object the windream stream
aFileIO.aWMStream = aWMStream aFileIO.aWMStream = aWMStream
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" Unexpected error in Zuweisen aWMStream zu aFileIO - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" Unexpected error in Zuweisen aWMStream zu aFileIO - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
'MsgBox(Err.Description) 'MsgBox(Err.Description)
End If End If
' let fileIO object import the original file into windream ' let fileIO object import the original file into windream
aFileIO.ImportOriginal(True) aFileIO.ImportOriginal(True)
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" Unexpected error in FileIO.ImportOriginal(True) - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" Unexpected error in FileIO.ImportOriginal(True) - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
' MsgBox(Err.Description) ' MsgBox(Err.Description)
End If End If
LOGGER.Info(" ...Inhalt der Datei konnte übertragen werden") LOGGER.Info(" ...Inhalt der Datei konnte übertragen werden")
' close the windream file stream ' close the windream file stream
aWMStream.Close() aWMStream.Close()
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" Unexpected error in aWMStream.Close() - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" Unexpected error in aWMStream.Close() - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
'MsgBox(Err.Description) 'MsgBox(Err.Description)
End If End If
' save new windream object ' save new windream object
WMObject.save() WMObject.save()
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" Unexpected error in WMObject.save - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" Unexpected error in WMObject.save - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
'MsgBox(Err.Description) 'MsgBox(Err.Description)
End If End If
LOGGER.Info(" ...Datei konnte gespeichert werden") LOGGER.Info(" ...Datei konnte gespeichert werden")
' unlock the windream object ' unlock the windream object
WMObject.unlock() WMObject.unlock()
If Err.Number > 0 Then If Err.Number > 0 Then
LOGGER.Info(" Unexpected error in WMObject.unlock - Datei wird wieder gelöscht - Error: '" & Err.Description & "'") LOGGER.Info(" Unexpected error in WMObject.unlock - Datei wird wieder gelöscht - Error: '" & Err.Description & "'")
WMObject.Unlock() WMObject.Unlock()
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Return False Return False
'MsgBox(Err.Description) 'MsgBox(Err.Description)
End If End If
'DATEI GRÖSSE ERMITTELN - MANCHMAL KOMMT ES VOR DAS DATEIGRÖße 0 ist 'DATEI GRÖSSE ERMITTELN - MANCHMAL KOMMT ES VOR DAS DATEIGRÖße 0 ist
Dim info2 As New FileInfo(NewFileName) Dim info2 As New FileInfo(oFileName)
Dim length1 As Long = info2.Length Dim length1 As Long = info2.Length
LOGGER.Info(" ...Length der Zieldatei: " & length1.ToString) LOGGER.Info(" ...Length der Zieldatei: " & length1.ToString)
If oFileLength > 0 And Err.Number = 0 Then If oFileLength > 0 And Err.Number = 0 Then
Dim p As String
If oWindreamFilename.StartsWith("\") Then 'Dim p As String
If oWindreamFilename.StartsWith("\\") Then 'If oWindreamFilename.StartsWith("\") Then
p = oWindreamFilename.Replace("\\", "\") ' If oWindreamFilename.StartsWith("\\") Then
Else ' p = oWindreamFilename.Replace("\\", "\")
p = oWindreamFilename ' Else
End If ' p = oWindreamFilename
Else ' End If
p = "\" & oWindreamFilename 'Else
End If ' p = "\" & oWindreamFilename
CURRENT_NEWFILENAME = vWLaufwerk & ":" & p 'End If
'CURRENT_NEWFILENAME = vWLaufwerk & ":" & p
CURRENT_NEWFILENAME = oFileName
LOGGER.Info(" >> Datei '" & CURRENT_NEWFILENAME & "' wurde erfolgreich importiert!") LOGGER.Info(" >> Datei '" & CURRENT_NEWFILENAME & "' wurde erfolgreich importiert!")
_currentWMObject = WMObject _currentWMObject = WMObject
Return True Return True
Else Else
Delete_WDFile(oWindreamFilename) Delete_WDFile(oWindreamFilename)
Console.WriteLine(Err.Number.ToString) LOGGER.Info("Error Number: [{0}]", Err.Number)
LOGGER.Info(" Unexpected error in Datei-Übertragen - FileLength ist 0, Übertragene Datei wurde gelöscht") LOGGER.Info(" Unexpected error in Datei-Übertragen - FileLength ist 0, Übertragene Datei wurde gelöscht")
Return False Return False
End If
Else
LOGGER.Info(" Could not create a WMObject for file:'" & oWindreamFilename)
If Not Err() Is Nothing Then
If Not Err.Description Is Nothing Then
LOGGER.Info(Err.Description)
End If
End If
Return False
End If End If
Else Else
LOGGER.Info(" Could not create a WMObject for file:'" & oWindreamFilename) LOGGER.Info("...targetPath existiert NICHT")
If Not Err() Is Nothing Then
If Not Err.Description Is Nothing Then
LOGGER.Info(Err.Description)
End If
End If
Return False
End If
Else
LOGGER.Info("...targetPath existiert NICHT")
Return False Return False
End If End If

8
Global_Indexer/frmAdministration.vb
View File

@ -272,7 +272,7 @@ Public Class frmAdministration
MyDataset.TBDD_DOKUMENTART.ERSTELLTWERColumn.DefaultValue = Environment.UserName MyDataset.TBDD_DOKUMENTART.ERSTELLTWERColumn.DefaultValue = Environment.UserName
MyDataset.TBDD_DOKUMENTART.OBJEKTTYPColumn.DefaultValue = "" MyDataset.TBDD_DOKUMENTART.OBJEKTTYPColumn.DefaultValue = ""
MyDataset.TBDD_DOKUMENTART.NAMENKONVENTIONColumn.DefaultValue = "[%vOFilename]-[%vYY_MM_DD]-[%Version]" MyDataset.TBDD_DOKUMENTART.NAMENKONVENTIONColumn.DefaultValue = "[%vOFilename]-[%vYY_MM_DD]"
MyDataset.TBDD_DOKUMENTART.DUPLICATE_HANDLINGColumn.DefaultValue = "New version" MyDataset.TBDD_DOKUMENTART.DUPLICATE_HANDLINGColumn.DefaultValue = "New version"
IsInsert = True IsInsert = True
End Sub End Sub
@ -674,9 +674,9 @@ Public Class frmAdministration
lbFileparameter.Visible = True lbFileparameter.Visible = True
btnAddWindowsVariable.Visible = True btnAddWindowsVariable.Visible = True
End If End If
If IsInsert = False Then 'If IsInsert = False Then
Save_IndexAuto() ' Save_IndexAuto()
End If 'End If
End If End If
End Sub End Sub

181
Global_Indexer/frmIndex.vb
View File

@ -28,6 +28,8 @@ Public Class frmIndex
Private NewFileString As String Private NewFileString As String
Private CancelAttempts As Integer = 0 Private CancelAttempts As Integer = 0
Private Const MaxCancelAttempts = 2
Private Property ViewerString As String Private Property ViewerString As String
#End Region #End Region
@ -234,7 +236,7 @@ Public Class frmIndex
End Try End Try
End Function End Function
Function GetAutomaticIndexSQLValue(vsqlstatement As String, vconnectionID As Integer, vProvider As String) As String Function GetAutomaticIndexSQLValue(SQLCommand As String, vconnectionID As Integer, vProvider As String) As String
Try Try
Dim oConnectionString As String Dim oConnectionString As String
oConnectionString = ClassFormFunctions.GetConnectionString(vconnectionID) oConnectionString = ClassFormFunctions.GetConnectionString(vconnectionID)
@ -243,9 +245,9 @@ Public Class frmIndex
Dim oErgebnis Dim oErgebnis
'Welcher Provider? 'Welcher Provider?
If vProvider.ToLower = "oracle" Then If vProvider.ToLower = "oracle" Then
oErgebnis = ClassDatabase.OracleExecute_Scalar(vsqlstatement, oConnectionString) oErgebnis = ClassDatabase.OracleExecute_Scalar(SQLCommand, oConnectionString)
Else 'im Moment nur SQL-Server Else 'im Moment nur SQL-Server
oErgebnis = ClassDatabase.Execute_Scalar(vsqlstatement, oConnectionString) oErgebnis = ClassDatabase.Execute_Scalar(SQLCommand, oConnectionString)
End If End If
If LogErrorsOnly = False Then If LogErrorsOnly = False Then
@ -768,8 +770,6 @@ Public Class frmIndex
Return False Return False
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
LOGGER.Info("Unvorhergesehener Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message) LOGGER.Info("Unvorhergesehener Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message)
LOGGER.Error(ex.Message) LOGGER.Error(ex.Message)
@ -1356,88 +1356,97 @@ Public Class frmIndex
'TODO: Load License from DB 'TODO: Load License from DB
DocumentViewer1.Init(LOGCONFIG, VIEWER_LICENSE) DocumentViewer1.Init(LOGCONFIG, VIEWER_LICENSE)
CURRENT_DROPTYPE = DropType.Replace("|", "") If DropType Is Nothing Then
If DropType = "|DROPFROMFSYSTEM|" Then LOGGER.Warn("File with Id [{0}] was not found in TBGI_FILES_USER. Exiting.")
checkItemDeleteSource.Enabled = True CancelAttempts = MaxCancelAttempts
checkItemDeleteSource.Checked = CURR_DELETE_ORIGIN Close()
'chkdelete_origin.Visible = True
'chkdelete_origin.Checked = CURR_DELETE_ORIGIN
If USER_LANGUAGE <> "de-DE" Then
Me.Text = "Indexing of dropped file"
Else
Me.Text = "Indexierung der gedroppten Datei"
End If
ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then
Select Case DropType
Case "|FW_MSGONLY|"
LOGGER.Info(" >> .msg-file from folderwatch")
If USER_LANGUAGE <> "de-DE" Then
Me.Text = "Indexing of msg-File (without Attachments) - from Folderwatch"
Else
Me.Text = "Indexierung der msg-Datei (ohne Anhang) - aus Folderwatch"
End If
Case "|OUTLOOK_MESSAGE|"
LOGGER.Info(" >> .msg-file through dragdrop")
If USER_LANGUAGE <> "de-DE" Then
Me.Text = "Indexing of msg-File (without Attachments)"
Else
Me.Text = "Indexierung der msg-Datei (ohne Anhang)"
End If
End Select
ElseIf DropType = "|MSGONLY|" Then
If USER_LANGUAGE = "de-DE" Then
Me.Text = "Indexierung der msg-Datei (ohne Anhang)"
Else
Me.Text = "Indexing of msg-File (without Attachments)"
End If
ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
CURRENT_ISATTACHMENT = True
If USER_LANGUAGE = "de-DE" Then
Me.Text = "Indexierung eines Email-Attachments"
Else
Me.Text = "Indexing of email-Attachment"
End If
ElseIf DropType = "|FW_SIMPLEINDEXER|" Then
If USER_LANGUAGE = "de-DE" Then
Me.Text = "Indexierung einer Folderwatch-Datei"
Else
Me.Text = "Indexing of Folderwatch-File"
End If
End If
BarCheckItem1.Checked = TopMost
labelFilePath.Caption = CURRENT_WORKFILE
ClassWindowLocation.LoadFormLocationSize(Me)
SetFilePreview(CONFIG.Config.FilePreview)
SplitContainer1.SplitterDistance = CONFIG.Config.SplitterDistanceViewer
Load_String()
MULTIFILES = ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')", MyConnectionString, True)
MULTIINDEXING_ACTIVE = False
If MULTIFILES > 0 Then
If USER_LANGUAGE = "de-DE" Then
checkMultiindex.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren"
Else
checkMultiindex.Text = "Multi-Indexing - All following files (" & MULTIFILES & ") will be indexed identically"
End If
checkMultiindex.Checked = False
checkMultiindex.Visible = True
BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
Else Else
checkMultiindex.Visible = False CURRENT_DROPTYPE = DropType.Replace("|", "")
BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Never If DropType = "|DROPFROMFSYSTEM|" Then
checkItemDeleteSource.Enabled = True
checkItemDeleteSource.Checked = CURR_DELETE_ORIGIN
'chkdelete_origin.Visible = True
'chkdelete_origin.Checked = CURR_DELETE_ORIGIN
If USER_LANGUAGE <> "de-DE" Then
Me.Text = "Indexing of dropped file"
Else
Me.Text = "Indexierung der gedroppten Datei"
End If
ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then
Select Case DropType
Case "|FW_MSGONLY|"
LOGGER.Info(" >> .msg-file from folderwatch")
If USER_LANGUAGE <> "de-DE" Then
Me.Text = "Indexing of msg-File (without Attachments) - from Folderwatch"
Else
Me.Text = "Indexierung der msg-Datei (ohne Anhang) - aus Folderwatch"
End If
Case "|OUTLOOK_MESSAGE|"
LOGGER.Info(" >> .msg-file through dragdrop")
If USER_LANGUAGE <> "de-DE" Then
Me.Text = "Indexing of msg-File (without Attachments)"
Else
Me.Text = "Indexierung der msg-Datei (ohne Anhang)"
End If
End Select
ElseIf DropType = "|MSGONLY|" Then
If USER_LANGUAGE = "de-DE" Then
Me.Text = "Indexierung der msg-Datei (ohne Anhang)"
Else
Me.Text = "Indexing of msg-File (without Attachments)"
End If
ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
CURRENT_ISATTACHMENT = True
If USER_LANGUAGE = "de-DE" Then
Me.Text = "Indexierung eines Email-Attachments"
Else
Me.Text = "Indexing of email-Attachment"
End If
ElseIf DropType = "|FW_SIMPLEINDEXER|" Then
If USER_LANGUAGE = "de-DE" Then
Me.Text = "Indexierung einer Folderwatch-Datei"
Else
Me.Text = "Indexing of Folderwatch-File"
End If
End If
BarCheckItem1.Checked = TopMost
labelFilePath.Caption = CURRENT_WORKFILE
ClassWindowLocation.LoadFormLocationSize(Me)
SetFilePreview(CONFIG.Config.FilePreview)
SplitContainer1.SplitterDistance = CONFIG.Config.SplitterDistanceViewer
Load_String()
MULTIFILES = ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')", MyConnectionString, True)
MULTIINDEXING_ACTIVE = False
If MULTIFILES > 0 Then
If USER_LANGUAGE = "de-DE" Then
checkMultiindex.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren"
Else
checkMultiindex.Text = "Multi-Indexing - All following files (" & MULTIFILES & ") will be indexed identically"
End If
checkMultiindex.Checked = False
checkMultiindex.Visible = True
BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
Else
checkMultiindex.Visible = False
BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
End If
End If End If
Catch ex As Exception Catch ex As Exception
LOGGER.Info(" - Unexpected error in Öffnen des Formulares - Fehler: " & vbNewLine & ex.Message) LOGGER.Info(" - Unexpected error in Öffnen des Formulares - Fehler: " & vbNewLine & ex.Message)
LOGGER.Error(ex.Message) LOGGER.Error(ex.Message)
@ -1785,6 +1794,10 @@ Public Class frmIndex
LOGGER.Info(" oSqlResult afrer first Replace: " & oSqlResult) LOGGER.Info(" oSqlResult afrer first Replace: " & oSqlResult)
End If End If
'TODO: Replace Windream Patterns?
oSqlResult = ClassPatterns.ReplaceControlValues(oSqlResult, pnlIndex)
oSqlResult = ClassPatterns.ReplaceInternalValues(oSqlResult)
' Ergebnis: Es wurden alle einfachen Platzhalter ersetzt, jetzt haben wir einen SQL Befehl, ' Ergebnis: Es wurden alle einfachen Platzhalter ersetzt, jetzt haben wir einen SQL Befehl,
' der nur noch vektorfelder-platzhalter enthält ' der nur noch vektorfelder-platzhalter enthält