Code: Expanded Class for File Functions

Yesterday I blogged about a simple class to parse file names, and that inspired me to improve it and add some functionality, which will actually come in handy for a project at work shortly.

The class is pretty self-explanatory, there is really nothing complicated in the code.
When the class is initialized, if a path to a directory (i.e. ending with \) is passed to the constructor the directory is created if it does not exist. If the directory exist, there are functions to copy or move both single files or all files in the directory. Directories can also be deleted using the RemoveDir method.
In addition, there are properties to get the path, file name, extension and file size (in bytes) of the file (if the class was initialized with a file name).

Here is an agent with some examples of how to call the class:

Option Public
Option Declare
Use "Class.FileFunctions"

Sub Initialize
  Dim file As FileObject
  Dim cnt As Integer
  Dim success As Boolean 

  '*** Create new file object
  Set file = New FileObject("D:\Downloads\Downloads\MERP\Assassins of Dol Amroth.pdf")

  '*** Copy the file to another (new) directory
  Call file.CopyTo("D:\Downloads\MERP1\", file.FileName)

  '*** Move the file to a new location and replace space with + in file name
  Call file.MoveTo("D:\Downloads\MERP2\", Replace(file.FileName," ","+"))

  '*** Create a new directory if it does not exist
  Set file = New FileObject("D:\Downloads\MERP3\Test\")

  '*** Copy all files in specified directory to another directory
  Set file = New FileObject("D:\Downloads\Downloads\MERP\")
  cnt = file.CopyAllTo("D:\Downloads\MERP\Backup\")
  MsgBox "Copied " & cnt & " files."

  '*** Move all files in the previously specified directory to another location
  cnt = file.MoveAllTo("D:\Downloads\Middle-Earth Role Playing Game\")
  MsgBox "Moved " & cnt & " files."

  '*** Remove D:\Downloads\Downloads\MERP\
  Call file.RemoveDir("")

  '*** Remove D:\Downloads\MERP3\ and Test directory that we created earlier
  success = file.RemoveDir("D:\Downloads\MERP3\Test\")
  If success = True Then
    success = file.RemoveDir("D:\Downloads\MERP3\")
    If success = False Then
      MsgBox "Failed to delete D:\Downloads\MERP3\"
    End If
  Else
    MsgBox "Failed to delete D:\Downloads\MERP3\Test\"
  End If
End Sub

 

Below is the class itself, I put it in a script library called Class.FileFunctions.

%REM
  Copyright (c) Karl-Henry Martinsson 2012.
  Some code copyright Andre Guirard (see below).
  You are free to use and modify my code, as long as you keep
  all copyright info intact. If you improve the code, please
  consider sharing it back to the community.
%END REM

Option Public
Option Declare

Type FileDetails
  path As String
  filename As String  
  extension As String
  filesize As Long
End Type

Class FileObject
  Private file As FileDetails
  Public silent As Boolean
  
  Public Sub New(filepathname As String)
    silent = False
    FullPathName = filepathname
    If file.FileName = "" Then
      If file.Path <> "" Then
        On Error 76 GoTo parentDoesNotExist 
        'No filename but path, then we create that directory (if missing)
        If Dir$(file.Path,16)="" Then
createDirectory:  
          Call MakeDir(file.Path)
        End If
      End If
      file.FileSize = 0 
    Else
      file.FileSize = FileLen(filepathname)
    End If
    Exit Sub
parentDoesNotExist:          
    Resume createDirectory  
  End Sub
  
  
  Public Property Set FileName As String
    file.FileName = FileName
    file.Extension = StrRightBack(FileName,".")
  End Property
  
  Public Property Get FileName As String
    FileName = file.FileName  
  End Property
  
  
  Public Property Get Extension As String
    Extension = file.Extension  
  End Property
  
  Public Property Set Extension As String
    file.Extension = Extension   
  End Property
  
  
  Public Property Set FilePath As String
    file.Path = FilePath  
    If Right(file.Path,1)<>"\" Then
      file.Path = file.Path & "\"
    End If
  End Property
  
  Public Property Get FilePath As String
    FilePath = file.Path  
  End Property
  
  
  Public Property Set FullPathName As String
    Me.FilePath = StrLeftBack(FullPathName,"\")
    Me.FileName = StrRightBack(FullPathName,"\")
  End Property
  
  Public Property Get FullPathName As String
    FullPathName = file.Path & file.FileName  
  End Property
  
  
  Public Function CopyTo(ByVal newpath As String, ByVal newname As String) As Boolean
    '*** Check if both arguments are blank, then exit
    If FullTrim(newpath) = "" Then
      If FullTrim(newpath) = "" Then
        CopyTo = False
        Exit Function
      End If   
    End If
    If FullTrim(newpath) = "" Then
      newpath = file.Path
    End If  
    If FullTrim(newname) = "" Then
      newname = file.FileName 
    End If  
    Call MakeDir(newpath)
    On Error GoTo errHandlerCopyTo
    FileCopy me.FullPathName, newpath + newname
    If silent = False Then
      Print "Copied " & filename & " from " & file.Path & " to " & newpath
    End If
    CopyTo = True
exitFunctionCopyTo:
    Exit Function
errHandlerCopyTo:
    CopyTo = False
    Resume exitFunctionCopyTo
  End Function
  
  
  Public Function MoveTo(ByVal newpath As String, ByVal newname As String) As Boolean
    '*** Check if both arguments are blank, then exit
    If FullTrim(newpath) = "" Then
      If FullTrim(newpath) = "" Then
        MoveTo = False
        Exit Function
      End If   
    End If
    If FullTrim(newpath) = "" Then
      newpath = file.Path
    End If  
    If FullTrim(newname) = "" Then
      newname = file.FileName 
    End If
    Call MakeDir(newpath)
    On Error GoTo errHandlerMoveTo
    FileCopy me.FullPathName, newpath + newname
    Kill me.FullPathName
    If silent = False Then
      Print "Moved " & filename & " from " & file.Path & " to " & newpath
    End If
    
    MoveTo = True
exitFunctionMoveTo:
    Exit Function
errHandlerMoveTo:
    MoveTo = False
    Resume exitFunctionMoveTo
  End Function


  Public Function CopyAllTo(ByVal newpath As String) As Integer
    Dim filename As String
    Dim filecount As Integer
    '*** Check if both arguments are blank, then exit
    If FullTrim(newpath) = "" Then
      If FullTrim(newpath) = "" Then
        CopyAllTo = 0
        Exit Function
      End If   
    End If
    If FullTrim(newpath) = "" Then
      newpath = file.Path
    End If  
    Call MakeDir(newpath)
    On Error GoTo errHandlerCopyAllTo
    filename = Dir$(file.Path,2)  ' Include hidden files
    Do until filename=""
      FileCopy file.Path + filename, newpath + filename
      If silent = False Then
        Print "Copying " & filename & " from " & file.Path & " to " & newpath
      End If
      filecount = filecount + 1
      filename = Dir$()
    Loop
    CopyAllTo = filecount
exitFunctionCopyAllTo:
    Print "Copied " & filecount & " files"
    Exit Function
errHandlerCopyAllTo:
    CopyAllTo = filecount
    Resume exitFunctionCopyAllTo
  End Function

  Public Function MoveAllTo(ByVal newpath As String) As Integer
    Dim filename As String
    Dim filecount As Integer
    Dim deletelist List As String
    '*** Check if both arguments are blank, then exit
    If FullTrim(newpath) = "" Then
      If FullTrim(newpath) = "" Then
        MoveAllTo = 0
        Exit Function
      End If   
    End If
    If FullTrim(newpath) = "" Then
      newpath = file.Path
    End If  
    Call MakeDir(newpath)
    On Error GoTo errHandlerMoveAllTo
    filename = Dir$(file.Path,2)  ' Include hidden files
    Do Until filename=""
      FileCopy file.Path + filename, newpath + filename
      If silent = False Then
        Print "Moving " & filename & " from " & file.Path & " to " & newpath
      End If
      deletelist(filename) = file.Path + filename
      filecount = filecount + 1
      filename = Dir$()
    Loop
    Print "Cleaning up..."
    ForAll f In deletelist
      Kill f  
    End ForAll
    MoveAllTo = filecount
exitFunctionMoveAllTo:
    Print "Moved " & filecount & " files"
    Exit Function
errHandlerMoveAllTo:
    MoveAllTo = filecount
    Resume exitFunctionMoveAllTo
  End Function

  Public Function RemoveDir(ByVal dirpath As String) As Boolean
    '*** If blank, use the path in object
    If FullTrim(dirpath) = "" Then
      dirpath = file.path
    End If
    On Error GoTo errHandlerRemoveDir
    RmDir dirpath
    RemoveDir = True
exitRemoveDir:        
    Exit Function
errHandlerRemoveDir:
    RemoveDir = False
    Resume exitRemoveDir
  End Function
  

  ' ===== Private Supporting Functions =====  
  
  Private Sub MakeDir(Byval strWhere As String)
    ' *** This code by Andre Guirard @ IBM
    ' *** http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/recursive-mkdir-vs.-iteration
    ' *** Using an iterative method instead of recursive due to stack issues (see link above)
    On Error 76 Goto parentDoesNotExist 
    Dim stack$ 
    Const NL = { 
} 
    Do 
      Mkdir strWhere 
      On Error Goto 0 ' first success, stop trapping errors; avoid infinite loop. 
      strWhere = Strleft(stack, NL) ' "pop" a path for next iteration 
      stack = Mid$(stack, Len(strWhere)+2) 
failed: 
    Loop Until strWhere = "" 
    Exit Sub 
parentDoesNotExist: 
       ' This error code can indicate other problems, but assume missing parent. 
       ' If not, we get a different error (75) later when trying to create the parent. 
    Dim fpath$, fname$ 
    SplitFilepath strWhere, fpath, fname 
    If fpath = "" Then Error 76, "Invalid path: '" & strWhere & "'" 
    stack = strWhere & NL & stack ' "push" onto stack to retry later. 
    strWhere = fpath ' try a path one step shorter. 
    Resume failed 
  End Sub 

  
  Private Sub SplitFilePath(Byval fullpath$, dirpath$, filename$) 
    ' *** This subroutine by Andre Guirard @ IBM
    ' *** http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/recursive-mkdir-vs.-iteration
    ' *** Called from MakeDir()    
    Const DELIMS = {/\:} 
    While Instr(DELIMS, Right$(fullPath, 1)) ' discard final delimiter character... 
      fullpath = Left$(fullpath, Len(fullpath)-1) 
    Wend 
    Dim candidate$, i% 
    filename = Strtoken(fullpath, Left$(DELIMS, 1), -1) 
    For i = 2 To Len(DELIMS) 
      candidate = Strtoken(fullpath, Mid$(DELIMS, i, 1), -1) 
      If Len(candidate) < Len(filename) Then 
        filename = candidate 
      End If 
    Next 
    Dim fplen% 
    fplen = Len(fullpath)-Len(filename) 
    If fplen > 0 Then fplen = fplen - 1 
    dirpath = Left$(fullpath, fplen) 
  End Sub
  
End Class

 
Enjoy!
 

Leave a Reply