VCS_Dir.bas 1.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. Attribute VB_Name = "VCS_Dir"
  2. Option Compare Database
  3. Option Private Module
  4. Option Explicit
  5. ' Path/Directory of the current database file.
  6. Public Function ProjectPath() As String
  7. ProjectPath = CurrentProject.Path
  8. If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
  9. End Function
  10. ' Path/Directory for source files
  11. Public Function SourcePath() As String
  12. SourcePath = ProjectPath & CurrentProject.name & ".src\"
  13. End Function
  14. ' Create folder `Path`. Silently do nothing if it already exists.
  15. Public Sub MkDirIfNotExist(ByVal Path As String)
  16. On Error GoTo MkDirIfNotexist_noop
  17. MkDir Path
  18. MkDirIfNotexist_noop:
  19. On Error GoTo 0
  20. End Sub
  21. ' Delete a file if it exists.
  22. Public Sub DelIfExist(ByVal Path As String)
  23. On Error GoTo DelIfNotExist_Noop
  24. Kill Path
  25. DelIfNotExist_Noop:
  26. On Error GoTo 0
  27. End Sub
  28. ' Erase all *.`ext` files in `Path`.
  29. Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String)
  30. Dim FSO As Object
  31. Set FSO = CreateObject("Scripting.FileSystemObject")
  32. If Not FSO.FolderExists(Path) Then Exit Sub
  33. On Error GoTo ClearTextFilesFromDir_noop
  34. If Dir$(Path & "*." & Ext) <> vbNullString Then
  35. FSO.DeleteFile Path & "*." & Ext
  36. End If
  37. ClearTextFilesFromDir_noop:
  38. On Error GoTo 0
  39. End Sub
  40. Public Function DirExists(ByVal strPath As String) As Boolean
  41. On Error Resume Next
  42. DirExists = False
  43. DirExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
  44. End Function
  45. Public Function FileExists(ByVal strPath As String) As Boolean
  46. On Error Resume Next
  47. FileExists = False
  48. FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)
  49. End Function