Attribute VB_Name = "modNameFix"
Option Explicit

Public Const gstrSEP_DIR$ = "\"                         ' Directory separator character
Public Const gstrQUOTE$ = """"

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

Public Function GetShortName(ByVal sLongFileName As String) As String
    Dim lRetVal As Long, sShortPathName As String, iLen As Integer
    'Set up buffer area for API function call return
    sShortPathName = Space(255)
    iLen = Len(sShortPathName)

    'Call the function
    lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
    'Strip away unwanted characters.
    GetShortName = Left(sShortPathName, lRetVal)
End Function

Public Function GetLongFilename _
    (ByVal sShortName As String) _
    As String
    
    Dim sLongName As String
    Dim sTemp As String
    Dim iSlashPos As Integer
    
    'Add \ to short name to prevent Instr from failing
    sShortName = sShortName & "\"
    
    'Start from 4 to ignore the "[Drive Letter]:\" characters
    iSlashPos = InStr(4, sShortName, "\")
    
    'Pull out each string between \ character for conversion
    While iSlashPos
      sTemp = Dir(Left$(sShortName, iSlashPos - 1), _
        vbNormal + vbHidden + vbSystem + vbDirectory)
      If sTemp = "" Then
        'Error 52 - Bad File Name or Number
        GetLongFilename = ""
        Exit Function
      End If
      sLongName = sLongName & "\" & sTemp
      iSlashPos = InStr(iSlashPos + 1, sShortName, "\")
    Wend
    
    'Prefix with the drive letter
    GetLongFilename = Left$(sShortName, 2) & sLongName

End Function

Public Function GetFilenameFromPath(strPath As String)
    Dim i As Integer
    
    GetFilenameFromPath = ""
    If (Len(strPath) = 0) Then Exit Function
    If (Right(strPath, 1) = "\") Then Exit Function
    For i = Len(strPath) To 1 Step -1
        If Mid(strPath, i, 1) = "\" Then
            GetFilenameFromPath = Mid(strPath, i + 1)
            Exit For
        End If
    Next
End Function

Public Function NameTests(strShortPath As String, strLongPath As String) As Byte
    Dim strA As String
    Dim strB As String
    Dim strShort As String
    Dim strLong As String
    
    strShort = GetFilenameFromPath(strShortPath)
    strLong = GetFilenameFromPath(strLongPath)
    
    NameTests = 0
    
    'test for space at left character (short fail 0000 0001) (long fail  0000 0010)
    If Left(strShort, 1) = " " Then NameTests = NameTests + 1
    If Left(strLong, 1) = " " Then NameTests = NameTests + 2
    
    'test if same as long filename 0000 0100
    If CBool(StrComp(strShort, strLong, vbTextCompare)) Then NameTests = NameTests + 4
    
    'test filename conversion 0000 1000
    strA = GetFilenameFromPath(GetLongFilename(strShortPath))
    strB = GetFilenameFromPath(GetShortName(strLongPath))
    If (CBool(StrComp(strA, strLong, vbTextCompare)) Or _
        CBool(StrComp(strB, strShort, vbTextCompare))) _
            Then NameTests = NameTests + 8
    
End Function

Public Function GetPathWOFilename(strPath As String)
    Dim i As Integer
    
    GetPathWOFilename = strPath
    If (Len(strPath) = 0) Then Exit Function
    If (Right(strPath, 1) = "\") Then Exit Function
    For i = Len(strPath) To 1 Step -1
        If Mid(strPath, i, 1) = "\" Then
            GetPathWOFilename = Left(strPath, i)
            Exit For
        End If
    Next
End Function

Public Function FixFilename(strPath As String)
    Dim strA As String
    Dim strB As String
    
    FixFilename = strPath
    strA = GetPathWOFilename(strPath)
    strB = GetFilenameFromPath(strPath)
    FixFilename = strA & Trim(strB)
End Function

'-----------------------------------------------------------
' FUNCTION: FileExists
' Determines whether the specified file exists
'
' IN: [strPathName] - file to check for
'
' Returns: True if file exists, False otherwise
'-----------------------------------------------------------
'
Function FileExists(ByVal strPathName As String) As Integer
    Dim intFileNum As Integer

    On Error Resume Next

    '
    ' If the string is quoted, remove the quotes.
    '
    strPathName = strUnQuoteString(strPathName)
    '
    'Remove any trailing directory separator character
    '
    If Right$(strPathName, 1) = gstrSEP_DIR Then
        strPathName = Left$(strPathName, Len(strPathName) - 1)
    End If

    '
    'Attempt to open the file, return value of this function is False
    'if an error occurs on open, True otherwise
    '
    intFileNum = FreeFile
    Open strPathName For Input As intFileNum

    FileExists = IIf(Err = 0, True, False)

    Close intFileNum

    Err = 0
End Function

Public Function strUnQuoteString(ByVal strQuotedString As String)
'
' This routine tests to see if strQuotedString is wrapped in quotation
' marks, and, if so, remove them.
'
    strQuotedString = Trim(strQuotedString)

    If Mid$(strQuotedString, 1, 1) = gstrQUOTE And Right$(strQuotedString, 1) = gstrQUOTE Then
        '
        ' It's quoted.  Get rid of the quotes.
        '
        strQuotedString = Mid$(strQuotedString, 2, Len(strQuotedString) - 2)
    End If
    strUnQuoteString = strQuotedString
End Function


