Attribute VB_Name = "FileTools"
Option Explicit

Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long

Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, _
ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long

'File Helper Consts
Private Const PathSeprator As String = "\"
Private Const DriveSeparator As String = ":"
Private Const ExtensionSeparator As String = "."
'API Const helpers
Private Const MAX_PATH = 256
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Public Function AppPath() As String
    'Return app current app path.
    AppPath = AppendBackSlash(App.Path)
End Function

Public Function AppExeName() As String
    'Return current exe filename.
    AppExeName = App.EXEName & ".exe"
End Function

Public Function AppFullFilename() As String
    'Return full path of exe filename.
    AppFullFilename = AppPath & AppExeName
End Function

Public Function AddLeadingPathDelimiter(Source As String) As String
    'Add leading lash to front of path eg \c:\
    If Left$(Source, 1) <> PathSeprator Then
        AddLeadingPathDelimiter = PathSeprator & Source
    Else
        AddLeadingPathDelimiter = Source
    End If
End Function

Public Function AppendBackSlash(Source As String) As String
    'Append a back slash to a given path.
    If Right$(Source, 1) = PathSeprator Then
        AppendBackSlash = Source
    Else
        AppendBackSlash = Source & PathSeprator
    End If
End Function

Public Function ChangeFileExt(Source As String, FileExt As String) As String
Dim X As Long
Dim Ret As String

    'Change file ext
    For X = Len(Source) To 1 Step -1
        If Mid$(Source, X, 1) = ExtensionSeparator Then
            Ret = Left$(Source, X - 1)
            Exit For
        End If
    Next X
    
    ChangeFileExt = Ret & FileExt
    'Clear up
    Ret = vbNullString
End Function

Public Function DirectoryExists(Source As String) As String
Dim Attr As Long
    'Return true or false if folder is found.
    Attr = GetFileAttributes(Source)
    
    If Attr <> &HFFFFFFFF Then
        DirectoryExists = (Attr And FILE_ATTRIBUTE_DIRECTORY) > 0
    Else
        DirectoryExists = False
    End If
End Function

Public Function ExpandFileName(Source As String) As String
Dim Ret As Long
Dim Buff As String

    'Expand Filename.
    Buff = Space$(MAX_PATH)
    Ret = GetFullPathName(Source, MAX_PATH, Buff, vbNullString)
    
    If (Ret > 0) Then
        ExpandFileName = Left$(Buff, Ret)
    End If
    
    Buff = vbNullString
    
End Function

Public Function ExtractFileName(Source As String) As String
Dim X As Integer

    'Extract File Path name.
    For X = Len(Source) To 1 Step -1
        If Mid$(Source, X, 1) = PathSeprator Then
            ExtractFileName = Mid$(Source, X + 1)
            Exit For
        End If
    Next X
    
End Function

Public Function ExtractFileDrive(Source As String) As String
Dim X As Integer

    'Extract File Path name.
    For X = 1 To Len(Source)
        If Mid$(Source, X, 1) = DriveSeparator Then
            ExtractFileDrive = Mid$(Source, 1, X)
            Exit For
        End If
    Next X
        
End Function

Public Function ExtractFilePath(Source As String) As String
Dim X As Integer

    'Extract File Path name.
    For X = Len(Source) To 1 Step -1
        If Mid$(Source, X, 1) = PathSeprator Then
            ExtractFilePath = Mid$(Source, 1, X)
            Exit For
        End If
    Next X
    
End Function

Public Function ExtractFileTitle(Source As String) As String
    'Extract filename title eg file.exe file.
    ExtractFileTitle = RemoveChangeFileExt(ExtractFileName(Source))
End Function

Public Function ExtractShortPathName(Source As String) As String
Dim Ret As Long
Dim Buff As String
    
    'Get short path.
    Buff = Space$(MAX_PATH)
    Ret = GetShortPathName(Source, Buff, MAX_PATH)
    
    If (Ret > 0) Then
        ExtractShortPathName = Mid$(Buff, 1, Ret)
    End If
    
    Buff = vbNullString
End Function

Public Function ExtractFileExt(Source As String) As String
Dim X As Integer

    'Extract File ext.
    For X = Len(Source) To 1 Step -1
        If Mid$(Source, X, 1) = ExtensionSeparator Then
            ExtractFileExt = Mid$(Source, X)
            Exit For
        End If
    Next X
End Function

Public Function FileExists(Source As String) As Boolean
Dim Attr As Long
    'Return true or false if filename is found.
    Attr = GetFileAttributes(Source)
    
    If Attr <> &HFFFFFFFF Then
        FileExists = (Attr And FILE_ATTRIBUTE_DIRECTORY) = 0
    Else
        FileExists = False
    End If
    
End Function

Public Function FileIsReadOnly(Source As String) As Boolean
    'Return true or false if a filename is readonly.
    FileIsReadOnly = (GetFileAttributes(Source) And vbReadOnly And FileExists(Source) <> 0) <> 0
End Function

Public Function FixDirSeparators(Source As String) As String
Dim X As Long
Dim c As String * 1
Dim Bytes() As Byte
    
    'Convert / to \
    If Len(Source) Then
        'Convert string to bytes
        Bytes = StrConv(Source, vbFromUnicode)
    
        For X = 0 To UBound(Bytes)
            'Replace / with \
            If Bytes(X) = 47 Then Bytes(X) = 92
        Next X
    
        FixDirSeparators = StrConv(Bytes, vbUnicode)
    End If
    'Clear up
    Erase Bytes
End Function

Public Sub ForceDirectories(Source As String)
Dim X As Integer
Dim DirName As String
Dim First As Boolean
On Error Resume Next

    'Creates one or more sub folders.
    
    'Append back slash if needed.
    Source = AppendBackSlash(Source)
    
    'Check if foldser is found.
    If DirectoryExists(Source) Then
        Exit Sub
    End If

    For X = 1 To Len(Source)
        DirName = DirName & Mid(Source, X, 1)
        
        If Mid$(Source, X, 1) = PathSeprator Then
            'Is it the first backslash
            If (Not First) Then
                First = True
            Else
                DirName = Left$(Source, X)
                'Check if directory exists
                If DirectoryExists(DirName) = False Then
                    'Create the folder
                   Call MkDir(DirName)
                End If
            End If
        End If
       DirName = vbNullString
    Next X
End Sub

Public Function GetDirs(Source As String) As String()
Dim Ret As String
Dim X As Integer

    'Return an string array of folders.
    For X = 1 To Len(Source)
        If Mid$(Source, X, 1) = PathSeprator Then
            Ret = Mid$(Source, X + 1)
            Exit For
        End If
    Next X

    Ret = RemoveBackSlash(Ret)
    'Return folders.
    GetDirs = Split(Ret, PathSeprator)
    
    'Clear up
    Ret = vbNullString
    
End Function

Public Function IsPathDelimiter(Source As String, Index As Integer) As Boolean
Dim idx As Long

    'Check if a char in a string is a path delimiter.
    idx = Index
    
    If (idx <= 0) Then
        idx = 1
    ElseIf (idx > Len(Source)) Then
        idx = Len(Source)
    Else
        idx = Index
    End If
    
    IsPathDelimiter = Mid$(Source, idx, 1) = PathSeprator
End Function

Public Function RemoveLeadingPathDelimiter(Source As String) As String
    'Remove leading path delimiter.
    If Left$(Source, 1) = PathSeprator Then
        RemoveLeadingPathDelimiter = Mid$(Source, 2)
    Else
        RemoveLeadingPathDelimiter = Source
    End If
End Function

Public Function RemoveBackSlash(Source As String) As String
    'Remove backslash from path.
    If Right$(Source, 1) = PathSeprator Then
        RemoveBackSlash = Mid$(Source, 1, Len(Source) - 1)
    Else
        RemoveBackSlash = Source
    End If
End Function

Public Function RemoveFileExt(Source As String) As String
Dim X As Long
Dim idx As Integer

    'Remove file ext.
    For X = Len(Source) To 1 Step -1
        If Mid$(Source, X, 1) = ExtensionSeparator Then
            Exit For
        End If
    Next X
    
    'Get index.
    idx = (X - 1)
    'Fix index
    If (idx <= 0) Then idx = 1
    
    RemoveFileExt = Mid$(Source, 1, idx)
End Function

Public Function SameFileName(File1 As String, File2 As String) As Boolean
    'Return true or false if a File1 is the same as File2
    SameFileName = StrComp(File1, File2, vbTextCompare) = 0
End Function