home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Updated__G337261172001.psc / FileSystem.bas < prev    next >
Encoding:
BASIC Source File  |  2001-06-04  |  2.8 KB  |  136 lines
  1. Attribute VB_Name = "FileSystem"
  2. Option Explicit
  3.  
  4. 'API for the createpath function
  5. Declare Function MakeSureDirectoryPathExists Lib "IMAGEHLP.DLL" (ByVal DirPath As String) As Long
  6.  
  7. 'API for the findfile function
  8. Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" (ByVal lpRootPath As String, _
  9.     ByVal lpInputName As String, ByVal lpOutputName As String) As Long
  10.     
  11. Public Const MAX_PATH = 260
  12.  
  13. 'Global iError As Integer
  14. Public fs As Object, a
  15. Private iError As Integer
  16.  
  17. Public Sub CreateFile(fPath As String, Optional WriteLine As String)
  18. '
  19. On Error GoTo CreateError
  20.   '
  21.   Set fs = CreateObject("Scripting.FileSystemObject")
  22.   Set a = fs.CreateTextFile(fPath, True)
  23.   a.WriteLine (WriteLine)
  24.   a.Close
  25.   iError = 0
  26.   Exit Sub
  27.   '
  28. CreateError:
  29.   iError = 1
  30.   '
  31. End Sub
  32.  
  33. Public Function FileExists(Path As String) As Boolean
  34. '
  35. On Error GoTo CreateError
  36.   '
  37.   Set fs = CreateObject("Scripting.FileSystemObject")
  38.   FileExists = fs.FileExists(Path)
  39.   iError = 0
  40.   '
  41.   Exit Function
  42.   '
  43. CreateError:
  44.   '
  45.   iError = 1
  46.   '
  47. End Function
  48.  
  49. Public Function FolderExists(Path As String) As Boolean
  50. '
  51. On Error GoTo CreateError
  52.   '
  53.   Set fs = CreateObject("Scripting.FileSystemObject")
  54.   FolderExists = fs.FolderExists(Path)
  55.   iError = 0
  56.   Exit Function
  57.   '
  58. CreateError:
  59.   iError = 1
  60.   '
  61. End Function
  62.  
  63. Public Sub CreateFolder(Path As String)
  64. '
  65. On Error GoTo CreateError
  66.   '
  67.   Set fs = CreateObject("Scripting.FileSystemObject")
  68.   fs.CreateFolder (Path)
  69.   iError = 0
  70.   Exit Sub
  71.   '
  72. CreateError:
  73.   iError = 1
  74.   '
  75. End Sub
  76.  
  77. Public Sub FileCopy(CopyFrom As String, CopyTo As String, Optional OverWrite As Boolean = False)
  78.  
  79.   Set fs = CreateObject("Scripting.FileSystemObject")
  80.   fs.CopyFile CopyFrom, CopyTo, OverWrite
  81.  
  82. End Sub
  83.  
  84. Public Function CreatePath(NewPath) As Boolean
  85.  
  86.   'Add a trailing slash if none
  87.   If Right(NewPath, 1) <> "\" Then
  88.     NewPath = NewPath & "\"
  89.   End If
  90.   
  91.   'Call API
  92.   If MakeSureDirectoryPathExists(NewPath) <> 0 Then
  93.     'No errors, return True
  94.     CreatePath = True
  95.   Else
  96.     CreatePath = False
  97.     End If
  98.  
  99. End Function
  100.  
  101. Public Function FindFile(RootPath As String, FileName As String) As String
  102.     
  103. Dim lNullPos As Long
  104. Dim lResult As Long
  105. Dim sBuffer As String
  106.   
  107.   On Error GoTo FileFind_Error
  108.   
  109.   'Allocate buffer
  110.   sBuffer = Space(MAX_PATH * 2)
  111.   
  112.   'Find the file
  113.   lResult = SearchTreeForFile(RootPath, FileName, sBuffer)
  114.   
  115.   'Trim null, if exists
  116.   If lResult Then
  117.     lNullPos = InStr(sBuffer, vbNullChar)
  118.     If Not lNullPos Then
  119.       sBuffer = Left(sBuffer, lNullPos - 1)
  120.     End If
  121.     'Return filename
  122.     FindFile = sBuffer
  123.   Else
  124.     'Nothing found
  125.     FindFile = vbNullString
  126.   End If
  127.   
  128.   Exit Function
  129.   
  130. FileFind_Error:
  131.  
  132.   FindFile = vbNullString
  133.     
  134. End Function
  135.  
  136.