Find That Long Pathname

 
Option Explicit
'~modGetLongPath.bas;
'Return the longpath of a shortpath specification
'**************************************************************************
' modGetLongPath - The GetLongPath() function returns the longpath version 
of a
'                  filepath or dirpath that is formatted in the 8.3 
shortpath
'                  format.
'EXAMPLE:
'  Debug.Print GetLongPath("C:Progra~1Common~1micros~1webser~1")
''' This will print:
''' C:Program FilesCommon FilesMicrosoft SharedWeb Server Extensions
'
'NOTE: This module requires a reference to Microsoft Scripting Runtime 
(Scrrun.dll)
'**************************************************************************

 
Private Declare Function GetLongPathName Lib "kernel32" Alias 
"GetLongPathNameA" _
       (ByVal lpszLongPath As String, _
        ByVal lpszLongPath As String, _
        ByVal cchBuffer As Long) As Long
 
Public Function GetLongPath(InPath As String) As String
  Dim fso As FileSystemObject, fold As Folder, fil As File
  Dim S As String, I As Integer, j As Integer, drv As String, tmp As String
  Dim SS As String
  
  S = Trim$(InPath)                                 'get the trimmed form 
of path
  drv = String(260, 0)                              'receiving buffer
  On Error Resume Next
  I = GetLongPathName(S, drv, 260)                  'get buffer to drv, len 
to I
  If Err.Number = 0 Then                            'not win98/ME/2000
    GetLongPath = Left$(drv, I)                     'return path if no 
error
    Exit Function
  End If
  On Error GoTo 0
'
' win Nt4.0/95 or below, so do it with an FSO
'
  drv = ""                                          'blank in case not 
existing
  If Len(Dir(S)) Or Len(Dir(S, vbDirectory)) Then   'file/dir exists
    drv = S                                         'init to full path
'
' check for short stuff existing
'
    If InStr(1, S, "~") Then                        'short stuff in there?
      drv = ""                                      'yes, so yank sort path
      Set fso = New FileSystemObject                'set up pathing object
      If Left$(S, 2) = "" Then                    'UNC path?
        I = InStr(3, S, "")                        'yes, skip device name
        If I Then
          j = InStr(I + 1, S, "")                  'then skip drive name
          If j Then I = j
        End If
      Else
        I = InStr(3, S, "")                        'else just skip drive
      End If
      If I Then                                     'drivepath specified?
        drv = Left$(S, I)                           'get drive
        S = Mid$(S, I + 1)                          'get stuff after
      End If
'
' step through directory data
'
      I = InStr(I + 1, S, "")                      'a subdir path?
      Do While I
        tmp = LCase$(Left$(S, I - 1))               'yes, get subdir name
        j = InStr(tmp, "~")                         'short name?
        If j Then                                   'yes, find full name
          SS = Dir(drv & Left$(tmp, j - 1) & "*", vbDirectory)
          Do While Len(SS)
            Set fold = fso.GetFolder(drv & SS)      'get folder for long 
path
            If LCase$(fold.ShortName) = tmp Then Exit Do  'found short 
version
            SS = Dir()                              'else get next
          Loop
        Else
          SS = tmp                                  'not short, so keep 
full name
        End If
        drv = drv & SS & ""                        'set new base path
        S = Mid$(S, I + 1)                          'trimp off prev dir
        I = InStr(1, S, "")                        'check for another
      Loop
'
' handle stuff left over
'
      If Len(S) Then
        j = InStr(1, S, "~")                        'last item short?
        If j Then                                   'yes
          SS = Dir(drv & Left$(S, j - 1) & "*", vbDirectory)
          If Len(SS) Then                           'was a directory
            Do While Len(SS)                        'get full path
              Set fold = fso.GetFolder(drv & SS)
              If LCase$(fold.ShortName) = S Then Exit Do
              SS = Dir()                            'never blank unless 
it's a file
            Loop
          End If
          If Len(SS) = 0 Then                       'file?
            SS = Dir(drv & Left$(S, j - 1) & "*")   'yes, check matching 
files
            Do While Len(SS)
              Set fil = fso.GetFile(drv & SS)       'check for matching 
shortname
              If LCase$(fil.ShortName) = S Then Exit Do
              SS = Dir()                            'else check next
            Loop
          End If
        Else
          SS = S                                    'keep full name if noth 
short
        End If
      End If
      If Len(SS) Then drv = drv & SS                'build full long path
      Set fso = Nothing                             'remove object
    End If
  End If
  GetLongPath = drv                                 'return result
End Function

Thanks, David. As a token of our appreciation, we will be sending you a SearchVB denim shirt.

David Goben is lead developer for Merry Mechanization, Inc.'s Advanced Development Group. He have been programming since 1978, first in Assembler, then Fortran, C, Forth, Pascal, and finally BASIC. He has used VB since Version 1.0.