Attribute VB_Name = "modFile"
'*******************************************************************************
'*******************************************************************************
'** Module:         modFile
'**
'** Purpose:        This module has a number of useful functions for working
'**                 with files and folders.
'**
'** Created By:     Clint Olsen
'** Last Modified:  05/08/2003
'**
'** CONTENTS
'** ********
'** FileExists()        - Determines if a file exists
'** DirectoryExists()   - Determines if a directory exists
'** PathAndFile()       - Concatenates a path and a filename
'** CopyFiles()         - Copies files from a source to a destination directory
'** CopyFile()          - Copies a file from a source to a destination directory
'** MoveFile()          - Moves a file from a source to a destination path
'** DeleteFile()        - Deletes the specified file
'** CompareFiles()      - Checks if two files are the same (checks size and dates)
'** CreateFile()        - Creates a file (for output) and returns the file number
'** OpenFile()          - Opens an existing file (for input) and returns the file number
'** CloseFile()         - Closes a file by file number
'** GetFileTitle()      - Returns the file title for a given path (eg. testfile)
'** GetFileName()       - Returns the file name for a given path (ex. testfile.txt)
'** GetFilePath()       - Returns the location of the file in the given path (ex. C:\Temp\)
'** WriteArrayToFile()  - Writes an array of strings to the specified file
'** ReadArrayFromFile() - Reads a file and returns the contents as an array of strings
'** MoveToRecycleBin()  - Moves a file to the recycling bin
'*******************************************************************************
'*******************************************************************************


Option Explicit


'*******************************************************************************
'** MODULE DECLARATIONS
'*******************************************************************************
Public Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As Long
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" _
    Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40


'*******************************************************************************
'** Function:   FileExists
'** Parameters:
'**     FilePath (String) - the full path of a file
'** Returns: True if the file exists, false otherwise
'*******************************************************************************
Public Function FileExists(FilePath As String) As Boolean
    If Len(FilePath) = 0 Then
        FileExists = False
    Else
        If Len(Dir$(FilePath)) > 0 Then
            FileExists = True
        Else
            FileExists = False
        End If
    End If
End Function


'*******************************************************************************
'** Function:   DirectoryExists
'** Parameters:
'**     DirectoryPath (String) - the full path of a directory
'** Returns: True if the directory exists, false otherwise
'*******************************************************************************
Public Function DirectoryExists(DirectoryPath As String) As Boolean
    If Len(DirectoryPath) = 0 Then
        DirectoryExists = False
    Else
        If Len(Dir$(DirectoryPath, vbDirectory)) > 0 Then
            DirectoryExists = True
        Else
            DirectoryExists = False
        End If
    End If
End Function


'*******************************************************************************
'** Function:   PathAndFile
'** Parameters:
'**     DirectoryPath (String) - the full path of a directory
'**     FileName (String) - a file name
'** Returns: The full file path and file name
'*******************************************************************************
Public Function PathAndFile(DirectoryPath As String, FileName As String) As String
    If Right$(DirectoryPath, 1) = "\" Then
        PathAndFile = DirectoryPath & FileName
    Else
        PathAndFile = DirectoryPath & "\" & FileName
    End If
End Function


'*******************************************************************************
'** Function:   CopyFiles
'** Parameters:
'**     SourceDirectory (String) - the path of the source directory
'**     DestinationDirectory (String) - the path of the destination directory
'**     OverWrite (Optional Boolean) - indicates if we want to overwrite
'**                                       any existing files if they exist
'**     FileExtension (Optional String) - the file extension of the files to copy
'** Returns: True if the copy procedure was successful, false otherwise
'*******************************************************************************
Public Function CopyFiles(SourceDirectory As String, DestinationDirectory As String, Optional OverWrite As Boolean = True, Optional FileExtension As String = "") As Boolean
    On Error GoTo CopyFilesError
      
    Dim strFileName As String

    If Len(FileExtension) > 0 Then
        'We are only copying files that contain the given file extension
        strFileName = Dir$(PathAndFile(SourceDirectory, "") & "*." & FileExtension)
        Do While Len(strFileName) > 0
            If OverWrite = True Then
                'Copy the file to the destination directory
                Call FileCopy(PathAndFile(SourceDirectory, strFileName), PathAndFile(DestinationDirectory, strFileName))
            Else
                'Only copy the file if it doesn't already exist
                If Len(Dir$(PathAndFile(DestinationDirectory, strFileName))) = 0 Then
                    Call FileCopy(PathAndFile(SourceDirectory, strFileName), PathAndFile(DestinationDirectory, strFileName))
                End If
            End If
            
            'Get the next file
            strFileName = Dir$
        Loop
    Else
        'We are copying all files
        strFileName = Dir$(PathAndFile(SourceDirectory, ""))
        Do While Len(strFileName) > 0
            If OverWrite = True Then
                'Copy the file to the destination directory
                Call FileCopy(PathAndFile(SourceDirectory, strFileName), PathAndFile(DestinationDirectory, strFileName))
            Else
                'Only copy the file if it doesn't already exist
                If Len(Dir$(PathAndFile(DestinationDirectory, strFileName))) = 0 Then
                    Call FileCopy(PathAndFile(SourceDirectory, strFileName), PathAndFile(DestinationDirectory, strFileName))
                End If
            End If
            
            'Get the next file
            strFileName = Dir$
        Loop
    End If
    
    CopyFiles = True
    
    Exit Function
    
CopyFilesError:

    CopyFiles = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    
End Function


'*******************************************************************************
'** Function:   CopyFile
'** Parameters:
'**     Source (String) - the path of the source file
'**     Destination (String) - the path of the destination file
'**     OverWrite (Optional Boolean) - indicates if we want to overwrite
'**                                    the file if it already exists
'** Returns: True if the copy procedure was successful, false otherwise
'*******************************************************************************
Public Function CopyFile(Source As String, Destination As String, Optional OverWrite As Boolean = True) As Boolean
    On Error GoTo CopyFileError
    
    If OverWrite = True Then
        Call FileCopy(Source, Destination)
        CopyFile = True
    Else
        If Len(Dir$(Destination)) = 0 Then
            Call FileCopy(Source, Destination)
            CopyFile = True
        Else
            CopyFile = False
        End If
    End If
    
    Exit Function
        
CopyFileError:
    
    CopyFile = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    
End Function


'*******************************************************************************
'** Function:   MoveFile
'** Parameters:
'**     Source (String) - the path of the source file
'**     Destination (String) - the path of the destination file
'**     OverWrite (Optional Boolean) - indicates if we want to overwrite
'**                                    the file if it already exists
'** Returns: True if the move procedure was successful, false otherwise
'*******************************************************************************
Public Function MoveFile(Source As String, Destination As String, Optional OverWrite As Boolean = False) As Boolean
    On Error GoTo MoveFileError
    
    If OverWrite = True Then
        If Len(Dir$(Destination)) > 0 Then
            Kill Destination
        End If
        Name Source As Destination
    Else
        If Len(Dir$(Destination)) = 0 Then
            Name Source As Destination
        Else
            MoveFile = False
            Exit Function
        End If
    End If
            
        
    MoveFile = True
        
    Exit Function
    
MoveFileError:
    
    MoveFile = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description, vbExclamation, "Error Moving File"
    
End Function


'*******************************************************************************
'** Function:   CompareFiles (Quick and dirty comparing of files)
'** Parameters:
'**     FilePath1 (String) - the full path of the first file
'**     FilePath2 (String) - the full path of the second file
'** Returns: True if the files are exactly the same, false otherwise
'*******************************************************************************
Public Function CompareFiles(FilePath1 As String, FilePath2 As String)
    If Len(Dir$(FilePath1)) = 0 Or Len(Dir$(FilePath2)) = 0 Then
        CompareFiles = False
    Else
        Dim fileNumOne As Long
        Dim fileNumTwo As Long
        
        'Compare the sizes of the files
        fileNumOne = FreeFile
        Open FilePath1 For Input As #fileNumOne
        
        fileNumTwo = FreeFile
        Open FilePath2 For Input As #fileNumTwo
        
        If LOF(fileNumOne) = LOF(fileNumTwo) Then
            CompareFiles = True
        Else
            CompareFiles = False
            Exit Function
        End If
        
        CloseFile (fileNumOne)
        CloseFile (fileNumTwo)
        
        'Compare the file dates
        If FileDateTime(FilePath1) = FileDateTime(FilePath2) Then
            CompareFiles = True
        Else
            CompareFiles = False
            Exit Function
        End If
        
        'We are assuming that if the file sizes and creation dates are exactly
        'the same, the files are exactly the same.
        'If you need to add more checks, you can.
    End If
End Function


'*******************************************************************************
'** Function:   CreateFile
'** Parameters:
'**     FilePath (String) - the full path of the file to be created
'**     OverWrite (Optional Boolean) - determines if we want to overwrite
'**                                       the file if it already exists
'** Returns: The file number of the file, -1 if the file already exists and
'**          OverWrite is false, -2 if any other error
'*******************************************************************************
Public Function CreateFile(FilePath As String, Optional OverWrite As Boolean = True) As Long
    On Error GoTo CreateFileError
    
    If OverWrite = False Then
        If Len(Dir$(FilePath)) <> 0 Then
            CreateFile = -1
            Exit Function
        End If
    End If
    CreateFile = FreeFile
    Open FilePath For Output As #CreateFile
    
    Exit Function
    
CreateFileError:
    
    CreateFile = -2
         
End Function


'*******************************************************************************
'** Function:   OpenFile
'** Parameters:
'**     FilePath (String) - the full path of the file to be created
'** Returns: The file number of the file, -1 if it already exists,
'**          -2 if any other error
'*******************************************************************************
Public Function OpenFile(FilePath As String) As Long
    On Error GoTo OpenFileError
    
    If Len(Dir$(FilePath)) = 0 Then
        OpenFile = -1
        Exit Function
    End If
    
    OpenFile = FreeFile
    Open FilePath For Input As #OpenFile
        
    Exit Function
    
OpenFileError:

    OpenFile = -2
        
End Function


'*******************************************************************************
'** Function:   CloseFile
'** Parameters:
'**     FileNumber (Long) - the file number of the file to be closed
'** Returns: True if the file was closed successfully, false otherwise
'*******************************************************************************
Public Function CloseFile(FileNumber As Long) As Boolean
    On Error GoTo CloseFileError
    
    Close #FileNumber
    CloseFile = True
    
    Exit Function

CloseFileError:

    CloseFile = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    
End Function


'*******************************************************************************
'** Function:   DeleteFile
'** Parameters:
'**     FilePath (String) - the full file path of the file to be deleted
'** Returns: True if the file was deleted successfully, false otherwise
'*******************************************************************************
Public Function DeleteFile(FilePath As String) As Boolean
    On Error GoTo DeleteFileError
    
    If Len(Dir$(FilePath)) = 0 Then
        'The file does not exist
        DeleteFile = False
    Else
        Kill (FilePath)
    End If
    
    DeleteFile = True
    
    Exit Function

DeleteFileError:
    
    DeleteFile = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    
End Function


'*******************************************************************************
'** Function:   GetFileTitle
'** Parameters:
'**     FilePath (String) - the full file path of the file to be deleted
'** Returns: The file title for the given file path
'*******************************************************************************
Public Function GetFileTitle(FilePath As String) As String
    On Error GoTo GetFileTitleError

    Dim slashLocation As Integer
    Dim dotLocation As Integer
    
    If Len(FilePath) = 0 Then
        GetFileTitle = ""
        Exit Function
    End If
    
    'Find the last \ in the path
    slashLocation = InStrRev(FilePath, "\")
    
    'Retrieve the . location
    dotLocation = InStrRev(FilePath, ".")
    If dotLocation = 0 Then dotLocation = Len(FilePath) + 1
        
    GetFileTitle = Mid$(FilePath, slashLocation + 1, dotLocation - slashLocation - 1)
    
    Exit Function
    
GetFileTitleError:
    
    GetFileTitle = ""
    MsgBox "Error #" & Err.numer & vbCrLf & Err.Description, vbExclamation, "Error"
    
End Function


'*******************************************************************************
'** Function:   GetFileName
'** Parameters:
'**     FilePath (String) - the full file path of the file
'** Returns: The file name of for the given file path
'*******************************************************************************
Public Function GetFileName(FilePath As String) As String
    On Error GoTo GetFileNameError
    
    Dim slashLocation As Integer
    
    If Len(FilePath) = 0 Then
        GetFileName = ""
        Exit Function
    End If
        
    'Find the last \ in the path
    slashLocation = InStrRev(FilePath, "\")
    
    GetFileName = Mid$(FilePath, slashLocation + 1, Len(FilePath) + 1 - slashLocation)
        
    Exit Function

GetFileNameError:
    
    GetFileName = ""
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    
End Function


'*******************************************************************************
'** Function:   GetFilePath
'** Parameters:
'**     FilePath (String) - the full file path of the file
'** Returns: The path of the file in the given file path
'*******************************************************************************
Public Function GetFilePath(FilePath As String) As String
    On Error GoTo GetFilePathError
    
    Dim slashLocation As Integer
    
    If Len(FilePath) = 0 Then
        GetFilePath = ""
        Exit Function
    End If
    
    'Find the last \ in the path
    slashLocation = InStrRev(FilePath, "\")
    
    If slashLocation = 0 Then
        GetFilePath = ""
    Else
        GetFilePath = Mid$(FilePath, 1, slashLocation)
    End If
    
    Exit Function

GetFilePathError:
    
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    
End Function


'*******************************************************************************
'** Function:   WriteArrayToFile
'** Parameters:
'**     strArray (String) - an array of strings to write to the file
'**     FilePath (String) - the path of the file to write to
'** Returns: True if writing the array to file was successful, false otherwise
'*******************************************************************************
Public Function WriteArrayToFile(strArray() As String, FilePath As String) As Boolean
    On Error GoTo WriteArrayToFileError
     
    Dim minItem As Long, maxItem As Long
    Dim i As Integer
    
    Dim fileNum As Long
    fileNum = CreateFile(FilePath)
    
    minItem = LBound(strArray)
    maxItem = UBound(strArray)
    
    For i = minItem To maxItem
        Print #fileNum, strArray(i)
    Next i
    
    CloseFile (fileNum)
    
    WriteArrayToFile = True
    
    Exit Function

WriteArrayToFileError:
    
    WriteArrayToFile = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    
End Function


'*******************************************************************************
'** Function:   ReadArrayFromFile
'** Parameters:
'**     FilePath (String) - the file path of the file to read the array from
'** Returns: An array of strings
'*******************************************************************************
Public Function ReadArrayFromFile(FilePath As String) As String()
    Dim strArray() As String
    Dim itemCount As Long
    Dim fileNum As Long
    
    itemCount = -1
    
    fileNum = OpenFile(FilePath)
    
    If fileNum = -2 Then
        Exit Function
    End If
    
    Do While Not EOF(fileNum)
        itemCount = itemCount + 1
        ReDim Preserve strArray(itemCount)
        Input #fileNum, strArray(itemCount)
    Loop
    
    CloseFile (fileNum)
    
    ReadArrayFromFile = strArray
    
    Exit Function

ReadArrayFromFileError:

    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    
End Function


'*******************************************************************************
'** Function:   MoveToRecycleBin
'** Parameters:
'**     FilePath (String) - the file path of the file to read the array from
'** Returns: An array of strings
'*******************************************************************************
Public Function MoveToRecycleBin(FilePath As String)
    On Error GoTo MoveToRecycleBinError

    'strfile is the full path of the file you want to put in the recycle bin
    Dim SHop As SHFILEOPSTRUCT
    With SHop
        .wFunc = FO_DELETE
        .pFrom = FilePath
        .fFlags = FOF_ALLOWUNDO
    End With
    SHFileOperation SHop
    
    MoveToRecycleBin = True
    
    Exit Function

MoveToRecycleBinError:
    
    MoveToRecycleBin = False
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    
End Function