openaccess/source/modules/OA_Path.bas

Option Compare Database
Option Private Module
Option Explicit

'operations on directories and path


Public Function norm_path(ByVal path As String) As String

    path = Replace(path, "/", "\")
    Do Until path = Replace(path, "\\", "\")
        path = Replace(path, "\\", "\")
    Loop
    norm_path = path
    
End Function

Public Function norm_dir_path(ByVal dir_path As String) As String
    
    dir_path = norm_path(dir_path)
    If Right(dir_path, 1) <> "\" Then dir_path = dir_path & "\"
    norm_dir_path = dir_path

End Function

Public Sub mktree(ByVal dirpath As String)
'recursively create the directory if it does not exist
    On Error GoTo err
    Dim path_part, current_path As String
    current_path = ""
    dirpath = norm_dir_path(dirpath)
    
    If dir(dirpath, vbDirectory) <> "" Then Exit Sub
    
    For Each path_part In Split(dirpath, "\")
        If Len(path_part) > 0 Then
            current_path = current_path & path_part & "\"
            If dir(current_path, vbDirectory) = "" Then
                MkDir current_path
            End If
        End If
    Next path_part
    
    logger "MkDirIfNotExist", "INFO", "New dir created: " & dirpath
    Exit Sub
err:
    If err.Number = 75 Then
        'dir already exist
    Else
        logger "MkDirIfNotExist", "ERROR", "Unable to create directory " & dirpath & " : " & err.Description
    End If
End Sub


Public Function parent_dir(path As String) As String
    'parent_dir = Left(path, InStrRev(path, "\", Len(path) - 1))
    parent_dir = CreateObject("Scripting.FileSystemObject").GetParentFolderName(path)
End Function

Public Function joinpaths(ByVal path1 As String, ByVal path2 As String) As String

    path1 = norm_path(path1)
    path2 = norm_path(path2)
    If Not Right(path1, 1) = "\" Or Left(path2, 1) = "\" Then
        path1 = path1 & "\"
    End If
    joinpaths = path1 & path2

End Function

Public Function to_filename(ByVal object_name As String) As String
    ' return a file name for the object's name
    ' 1- access does not accept brackets for object's names
    ' 2- file's names can not contain those caracters:
    ' \ [92]
    ' / [47]
    ' : [58]
    ' * [42]
    ' ? [63]
    ' " [34]
    ' < [60]
    ' > [62]
    ' | [124]
    '
    ' this function replaces caracters which are not allowed for file names by [x],
    'where x is the ascii code of the character
    ' test: "test_\_/_:_*_?_""_<_>_|" should become test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]
    ' to convert back the string, use to_accessname
    
    Dim result As String
    Dim ascii_code As Variant
    
    result = object_name
    
    For Each ascii_code In Split(ForbiddenCars, ",")
        result = Replace(result, Chr(CInt(ascii_code)), "[" & ascii_code & "]")
    Next

    If result <> object_name Then
        logger "to_filename", "DEBUG", "> Object's name " & object_name & " transformed to " & result
    End If

    to_filename = result
    Exit Function
err:
    Call logger("to_filename", "ERROR", "Unable to convert object's name " & object_name & " to file's name")
    to_filename = object_name
End Function

Public Function to_accessname(ByVal file_name As String) As String
    On Error GoTo err
    ' return an object name from a file's name
    ' see function 'to_filename' for more informations
    ' test: "test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]" should become test_\_/_:_*_?_"_<_>_|

    Dim result As String
    Dim ascii_code As Variant
    
    result = file_name
    
    For Each ascii_code In Split(ForbiddenCars, ",")
        result = Replace(result, "[" & ascii_code & "]", Chr(CInt(ascii_code)))
    Next

    If result <> file_name Then
        logger "to_accessname", "DEBUG", "> File's name " & file_name & " transformed to " & result
    End If

    to_accessname = result
    Exit Function
err:
    Call logger("to_accessname", "ERROR", "Unable to convert file's name " & file_name & " to access object's name")
    to_accessname = file_name
End Function

Public Sub del_if_exist(ByVal path As String)
'delete a file if it exists
    If dir(path) <> "" Then
        Kill path
    End If
End Sub

Public Function list_files_in(ByVal dirpath As String, Optional ByVal filter As String = "")
    Dim filename As String
    list_files_in = ""
    
    dirpath = norm_dir_path(dirpath)
    
    filename = dir$(dirpath & filter)
    
    Do Until Len(filename) = 0
        If Len(list_files_in) > 0 Then list_files_in = list_files_in & "|"
        
        list_files_in = list_files_in & filename
        
        filename = dir$()
    Loop
    
End Function