DynamicFolder mittels AI optimiert

This commit is contained in:
Developer01
2026-07-02 17:48:57 +02:00
parent 378582650b
commit c54f750705
3 changed files with 164 additions and 91 deletions

View File

@@ -1783,104 +1783,177 @@ Public Class frmNIHauptseite
End Sub End Sub
Private Function FolderForIndex(oDynamicFolder As String, myWMDocument As WMObject) As String Private Function FolderForIndex(oDynamicFolder As String, myWMDocument As WMObject) As String
Try Try
'###### _Logger.Debug("Dynamic folder before cleaning: " & oDynamicFolder)
Dim oPRegex As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' 1. Platzhalter durch tatsächliche Werte ersetzen
' einen Regulären Ausdruck laden Dim resolvedFolder As String = ResolveFolderPlaceholders(oDynamicFolder, myWMDocument)
Dim regularExpression As Regex = New Regex(oPRegex) If String.IsNullOrEmpty(resolvedFolder) Then
' die Vorkommen im Folder-String auslesen Return String.Empty
Dim oElements As MatchCollection = regularExpression.Matches(oDynamicFolder)
'####
' alle Vorkommen innerhalb des Ordnerstrings durchlaufen
For Each oMatchElement As Match In oElements
_Logger.Debug("Elementname in oDynamicFolder: '" & oMatchElement.ToString & "'")
Select Case oMatchElement.Value.Substring(2, 1)
'Manueller Indexwert
Case "m"
Dim oWMIndexname = oMatchElement.Value.Substring(3, oMatchElement.Value.Length - 4)
_Logger.Debug("getting metavalue from '" & oWMIndexname & "'...")
Dim oWMIndexValue As String = myWMDocument.GetVariableValue(oWMIndexname)
_Logger.Debug("oWMIndexValue: '" & oWMIndexValue & "'", False)
If Not oWMIndexValue = String.Empty Then
If IsDate(oWMIndexValue) Then
oWMIndexValue = CDate(oWMIndexValue).ToString("yyyyMMdd")
End If
' oWMIndexValue = oWMIndexValue.Replace("\", "")
oDynamicFolder = oDynamicFolder.Replace(oMatchElement.ToString, oWMIndexValue)
_Logger.Debug(" FolderPattern: '" & oDynamicFolder & "'", False)
Else
_Logger.Warn($"[{myWMDocument.aName}] - Attention in 'FolderForIndex': the Index-Value [{oWMIndexname}] is empty! No Dynamic folder will be used!", True)
Return ""
End If
Case "v"
Dim oFolderTemp As String
Dim oMonth As String = My.Computer.Clock.LocalTime.Month
If oMonth.Length = 1 Then
oMonth = "0" & oMonth
End If
Dim oDay As String = My.Computer.Clock.LocalTime.Day
If oDay.Length = 1 Then
oDay = "0" & oDay
End If
Dim oType = oMatchElement.Value.Substring(3, oMatchElement.Value.Length - 4)
If oType.StartsWith("_") Then
oType = oType.Replace("_", "")
End If
Select Case oType
Case "YYYY/MM/DD"
oFolderTemp = My.Computer.Clock.LocalTime.Year & "\" & oMonth & "\" & oDay
Case "YYYY/MM"
oFolderTemp = My.Computer.Clock.LocalTime.Year & "\" & oMonth
Case "YYYY"
oFolderTemp = My.Computer.Clock.LocalTime.Year
Case "YYYY-MM"
oFolderTemp = My.Computer.Clock.LocalTime.Year & "-" & oMonth
Case "MM"
oFolderTemp = oMonth
Case "DD"
oFolderTemp = oDay
End Select
oDynamicFolder = oDynamicFolder.Replace(oMatchElement.ToString, oFolderTemp)
_Logger.Debug("FolderPatter after V-element: '" & oDynamicFolder & "'", False)
Case Else
_Logger.Info("Attention in DynamicFolderConvention an invalid element has been found: Elementname: " & oMatchElement.Value.ToUpper)
Return ""
End Select
Next
_Logger.Debug("Checking oDynamicFolder on illegal PathChars: " & oDynamicFolder, False)
Dim invalidPathChars() As Char = Path.GetInvalidPathChars()
Dim oPathSplit As String() = oDynamicFolder.Split("\")
For Each oFolder In oPathSplit
If oFolder = "" Then
Continue For
End If
Dim rgPattern = My.Settings.REGEX_INVALID_PATH '----Invalid Characters
Dim objRegEx As New Regex(rgPattern)
Dim oClearFolder = objRegEx.Replace(oFolder, "")
If oFolder <> oClearFolder Then
oDynamicFolder = oDynamicFolder.Replace(oFolder, oClearFolder)
End If End If
Next ' 2. Laufwerksbuchstaben separieren
Dim driveLetter As String = String.Empty
Dim pathWithoutDrive As String = resolvedFolder
If resolvedFolder.Length >= 2 AndAlso resolvedFolder.Chars(1) = ":"c Then
driveLetter = resolvedFolder.Substring(0, 2) ' z.B. "W:"
pathWithoutDrive = resolvedFolder.Substring(2) ' Rest des Pfads
End If
' 3. Ungültige Zeichen aus jedem Ordnernamen entfernen
pathWithoutDrive = CleanPathSegments(pathWithoutDrive)
' 4. Vollständigen Pfad zusammensetzen
Dim cleanedFolder As String = driveLetter & pathWithoutDrive
_Logger.Debug("Dynamic folder after cleaning: " & cleanedFolder)
' 5. Ordner erstellen falls nicht vorhanden
If Not Directory.Exists(cleanedFolder) Then
Directory.CreateDirectory(cleanedFolder)
_Logger.Debug($"Folder '{cleanedFolder}' has been created...")
End If
Return cleanedFolder
If Directory.Exists(oDynamicFolder) = False Then
Try
Directory.CreateDirectory(oDynamicFolder)
_Logger.Debug("Folder '" & oDynamicFolder & "' has been created...", False)
Catch ex As Exception Catch ex As Exception
_Logger.Error(ex) _Logger.Error(ex)
Return "" Return String.Empty
End Try
End If
Return oDynamicFolder
Catch ex As Exception
_Logger.Error(ex)
Return ""
End Try End Try
End Function End Function
''' <summary>
''' Ersetzt Platzhalter ([%m...], [%v...]) durch tatsächliche Werte
''' </summary>
Private Function ResolveFolderPlaceholders(folderPattern As String, wmDoc As WMObject) As String
Dim oPRegex As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
Dim regularExpression As New Regex(oPRegex)
Dim oElements As MatchCollection = regularExpression.Matches(folderPattern)
Dim result As String = folderPattern
For Each oMatchElement As Match In oElements
Dim replacement As String = ResolveSinglePlaceholder(oMatchElement.Value, wmDoc)
If String.IsNullOrEmpty(replacement) Then
_Logger.Warn($"[{wmDoc.aName}] - Attention: Placeholder '{oMatchElement.Value}' could not be resolved!")
Return String.Empty
End If
result = result.Replace(oMatchElement.Value, replacement)
_Logger.Debug($"Replaced '{oMatchElement.Value}' with '{replacement}'")
Next
Return result
End Function
''' <summary>
''' Löst einen einzelnen Platzhalter auf
''' </summary>
Private Function ResolveSinglePlaceholder(placeholder As String, wmDoc As WMObject) As String
' Präfix ermitteln (z.B. "m" oder "v")
Dim prefix As String = placeholder.Substring(2, 1).ToLower()
Dim content As String = placeholder.Substring(3, placeholder.Length - 4)
Select Case prefix
Case "m" ' Metadaten-Index
Return ResolveMetadataPlaceholder(content, wmDoc)
Case "v" ' Variable (Datum)
Return ResolveDatePlaceholder(content)
Case Else
_Logger.Info($"Invalid placeholder type: {placeholder}")
Return String.Empty
End Select
End Function
''' <summary>
''' Löst Metadaten-Platzhalter auf (z.B. [%mKundennummer])
''' </summary>
Private Function ResolveMetadataPlaceholder(indexName As String, wmDoc As WMObject) As String
Try
_Logger.Debug($"Getting metavalue from '{indexName}'...")
Dim indexValue As String = wmDoc.GetVariableValue(indexName)?.ToString()
If String.IsNullOrEmpty(indexValue) Then
Return String.Empty
End If
' Datum formatieren falls nötig
If IsDate(indexValue) Then
indexValue = CDate(indexValue).ToString("yyyyMMdd")
End If
_Logger.Debug($"Index value: '{indexValue}'")
Return indexValue
Catch ex As Exception
_Logger.Error(ex)
Return String.Empty
End Try
End Function
''' <summary>
''' Löst Datums-Platzhalter auf (z.B. [%vYYYY/MM/DD])
''' </summary>
Private Function ResolveDatePlaceholder(datePattern As String) As String
' Unterstrich am Anfang entfernen falls vorhanden
Dim pattern As String = If(datePattern.StartsWith("_"), datePattern.Substring(1), datePattern)
Dim currentDate As DateTime = My.Computer.Clock.LocalTime
Dim month As String = currentDate.Month.ToString("00")
Dim day As String = currentDate.Day.ToString("00")
Dim year As String = currentDate.Year.ToString()
Select Case pattern.ToUpper()
Case "YYYY/MM/DD"
Return $"{year}\{month}\{day}"
Case "YYYY/MM"
Return $"{year}\{month}"
Case "YYYY"
Return year
Case "YYYY-MM"
Return $"{year}-{month}"
Case "MM"
Return month
Case "DD"
Return day
Case Else
_Logger.Warn($"Unknown date pattern: {pattern}")
Return String.Empty
End Select
End Function
''' <summary>
''' Entfernt ungültige Zeichen aus Pfadsegmenten
''' </summary>
Private Function CleanPathSegments(path As String) As String
If String.IsNullOrEmpty(path) Then
Return String.Empty
End If
Dim rgPattern As String = My.Settings.REGEX_INVALID_PATH
Dim objRegEx As New Regex(rgPattern)
Dim pathSegments As String() = path.Split("\"c)
Dim cleanedSegments As New List(Of String)
For Each segment As String In pathSegments
If String.IsNullOrEmpty(segment) Then
Continue For
End If
Dim cleanedSegment As String = objRegEx.Replace(segment, String.Empty)
If segment <> cleanedSegment Then
_Logger.Debug($"Cleaned segment from '{segment}' to '{cleanedSegment}'")
End If
cleanedSegments.Add(cleanedSegment)
Next
Return String.Join("\", cleanedSegments)
End Function
Private Function FNMoveRename(myWMDocument As WMObject) As Boolean Private Function FNMoveRename(myWMDocument As WMObject) As Boolean
Try Try
Dim oReturnString As String Dim oReturnString As String