openaccess/source/modules/VCS_Dir.bas

Option Compare Database

Option Private Module
Option Explicit


' Path/Directory of the current database file.
Public Function ProjectPath() As String
    ProjectPath = CurrentProject.path
    If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
End Function

' Path/Directory for source files
Public Function SourcePath() As String
    SourcePath = ProjectPath & CurrentProject.name & ".src\"
End Function

' Create folder `Path`. Silently do nothing if it already exists.
Public Sub MkDirIfNotExist(ByVal path As String)
    On Error GoTo MkDirIfNotexist_noop
    MkDir path
    logger "MkDirIfNotExist", "INFO", "New dir created: " & path
MkDirIfNotexist_noop:
    On Error GoTo 0
End Sub

' Delete a file if it exists.
Public Sub DelIfExist(ByVal path As String)
    On Error GoTo DelIfNotExist_Noop
    Kill path
    logger "DelIfExist", "INFO", "Killed: " & path
DelIfNotExist_Noop:
    On Error GoTo 0
End Sub

' Erase all *.`ext` files in `Path`.
Public Sub ClearTextFilesFromDir(ByVal path As String, ByVal Ext As String, Optional ByVal force As Boolean = False)
    
    '### 13/10/2016: add optimizer
    ' we don't want to clear the text files of the objects which will not be exported
    'BUT we still want to clear obsolete files: see CleanDirs in optimizer
    If optimizer_activated() And Not force Then
        logger "ClearTextFilesFromDir", "INFO", "Optimizer on: sub aborted"
        Exit Sub
    End If
    '###
    
    logger "ClearTextFilesFromDir", "DEBUG", "Clear dir: " & path & "*." & Ext

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(path) Then Exit Sub

    On Error GoTo ClearTextFilesFromDir_noop
    If dir$(path & "*." & Ext) <> vbNullString Then
        fso.DeleteFile path & "*." & Ext
    End If
    
ClearTextFilesFromDir_noop:
    On Error GoTo 0
End Sub

Public Function DirExists(ByVal strPath As String) As Boolean
    On Error Resume Next
    DirExists = False
    DirExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function

Public Function FileExists(ByVal strPath As String) As Boolean
    On Error Resume Next
    FileExists = False
    FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)
End Function