APIs: Obtenir le nom abrégé ou le nom long d'un fichier	Author(s) Dev Ashish

Obtenir le nom abrégé ou le nom long d'un fichier

Les fonctions reproduites ci-après peuvent être utiles pour vous aider à obtenir le nom long ou le nom court (DOS) d'un fichier.

'************ Code Start **********
Private Const MAX_PATH& = 260
Private Const INVALID_HANDLE_VALUE = -1

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA  '  318  Bytes
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved¯ As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Declare Function apiFindFirstFile Lib "kernel32" _
    Alias "FindFirstFileA" _
    (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) _
    As Long

Private Declare Function apiFindClose Lib "kernel32" _
    Alias "FindClose" _
    (ByVal hFindFile As Long) _
    As Long

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

Function fGetShortName(ByVal stLongPath As String) As String
'[ opposite of fGetLongName() ]
'Usage Examples:
'?fGetShortName("D:\Internet Explorer 4.0 Setup\This folder is safe to delete.txt")
'D:\INTERN~1.0SE\THISFO~1.TXT
'
'?fGetShortName(currentdb.Name)
'C:\PROGRA~1\MICROS~2\Office\Samples\SOLUTI~1.MDB
'
    Dim stShortPath As String
    Dim lngBuffer As Long, lngRet As Long
    stShortPath = String$(MAX_PATH, 0)
    lngBuffer = Len(stShortPath)
    lngRet = apiGetShortPathName(stLongPath, stShortPath, lngBuffer)
    fGetShortName = Left(stShortPath, lngRet)
End Function
'
Function fGetLongName(ByVal strFileName As String) As String
'
'Exemples d'utilisation:
'?fGetLongName("D:\INTERN~1.0SE\THISFO~1.TXT")
'D:\Internet Explorer 4.0 Setup\This folder is safe to delete.txt
'
'?fGetLongName(currentdb.Name)
'C:\Program Files\Microsoft Office\Office\Samples\Solutions.mdb
'
'?fGetLongName("C:\PROGRA~1\MICROS~2\Office\Samples\Northwind.mdb")
'C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb
'
    Dim lpFindFileData As WIN32_FIND_DATA
    Dim strPath As String, lngRet As Long
    Dim strFile As String, lngX As Long, lngY As Long
    Dim strTmp As String

    strTmp = ""
    Do While Not lngRet = INVALID_HANDLE_VALUE
        lngRet = apiFindFirstFile(strFileName, lpFindFileData)

        strFile = Left$(lpFindFileData.cFileName, _
                    InStr(lpFindFileData.cFileName, _
                    vbNullChar) - 1)
        If Len(strFileName) > 2 Then
            strTmp = strFile & "\" & strTmp
            strFileName = fParseDir(strFileName)
        Else
            strTmp = strFileName & "\" & strTmp
            Exit Do
        End If
    Loop
    fGetLongName = Left$(strTmp, Len(strTmp) - 1)
    lngY = apiFindClose(lngRet)
End Function

Private Function fParseDir(strInFile As String) As String
Dim intLen As Long, boolFound As Boolean
Dim i As Integer, f As String, strDir As String

    intLen = Len(strInFile)
    If intLen > 0 Then
        boolFound = False
        For i = intLen To 1 Step -1
            If Mid$(strInFile, i, 1) = "\" Then
                f = Mid$(strInFile, i + 1)
                strDir = Left$(strInFile, i - 1)
                boolFound = True
                Exit For
            End If
        Next i
        End If
    If boolFound Then
        fParseDir = strDir
    Else
        fParseDir = strInFile
    End If
End Function
'************ Code End **********