Visual Basic Win32 Shell Routines
Undocumented Windows: Path Functions
Shell32 Path Functions
     
Posted:   Wednesday August 6, 1997
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   Brad Martinez
     

Related:  

SHChangeNotifyRegister: Receive Shell Change Notifications
Undocumented Windows: Overview
Undocumented Windows: Shell Dialogs
Undocumented Windows: Format Disk Dialog
Undocumented Windows: Change Icon Dialog
       
 Prerequisites
None.

The final undocumented installment shows a few of the many undocumented Path functions.

As undocumented APIs, they're not supported by Microsoft. More so than any of the others, these APIs may cause a GPF if care is not exercised ... most use the CopyMemory API to return pointers. And unlike most of the others demonstrated, these require several support functions to convert from Unicode to ANSI, and perform other housekeeping tasks. But the base routines are easily incorporated into a standalone BAS module for dropping into any project needing these treats.

The two illustrations once again show the demo form both it appears in final and development modes, where the control names have been substituted for the captions. Note that the Drive, File and Directory list boxes have are named (Drive1, File1 and Dir1), and the pixbox is shown with a border to facilitate placement in the frame. Finally, again the arrangement makes no difference, and the control and form names indicated match the code below.

Note: Many of the functions detailed here are now documented - see the FileApi listings under 'Paths'.

 BAS Module Code
Once the form has been designed and saved, paste the following into the general declarations area of a file you name UndocSHPaths.bas:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'------------------------------------------------------
'Set to True if the current OS is WinNT.  
Public bIsWinNT As Boolean

Public Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (lpVersionInformation As OSVERSIONINFO) As Long
                                     
Public Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128  
End Type
   
Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2

Public Declare Function IsTextUnicode Lib "advapi32" _
  (lpBuffer As Any, _
   ByVal cb As Long, _
   lpi As Long) As Long
                               
Public Const IS_TEXT_UNICODE_ASCII16 = &H1
Public Const IS_TEXT_UNICODE_REVERSE_ASCII16 = &H10
Public Const IS_TEXT_UNICODE_STATISTICS = &H2
Public Const IS_TEXT_UNICODE_REVERSE_STATISTICS = &H20
Public Const IS_TEXT_UNICODE_CONTROLS = &H4
Public Const IS_TEXT_UNICODE_REVERSE_CONTROLS = &H40
Public Const IS_TEXT_UNICODE_SIGNATURE = &H8
Public Const IS_TEXT_UNICODE_REVERSE_SIGNATURE = &H80
Public Const IS_TEXT_UNICODE_ILLEGAL_CHARS = &H100
Public Const IS_TEXT_UNICODE_ODD_LENGTH = &H200
Public Const IS_TEXT_UNICODE_DBCS_LEADBYTE = &H400
Public Const IS_TEXT_UNICODE_NULL_BYTES = &H1000
Public Const IS_TEXT_UNICODE_UNICODE_MASK = &HF
Public Const IS_TEXT_UNICODE_REVERSE_MASK = &HF0
Public Const IS_TEXT_UNICODE_NOT_UNICODE_MASK = &HF00
Public Const IS_TEXT_UNICODE_NOT_ASCII_MASK = &HF000

Public Const MAX_PATH As Long = 260

'------------------------------------------------------
'Handles overlapped source and destination blocks  
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal ByteLen As Long)
   
Public Declare Function GetWindowsDirectory Lib "kernel32" _
   Alias "GetWindowsDirectoryA" _
  (ByVal lpBuffer As String, _
   ByVal nSize As Long) As Long
  
'------------------------------------------------------
'Path functions (sorted by ordinal):
'------------------------------------------------------  
'Rtns pointer to the last dot in szPath and the 
'string following it (includes the dot with the extension).
'Rtns 0 if szPath contains no dot.
'For the function to succeed, szPath should be 
'null terminated and be allocated to MAX_PATH bytes (260).
'Does not check szPath for validity.
'(could be called "GetStrAtLastDot")  
Public Declare Function SHGetExtension Lib "shell32" _
   Alias "#31" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Inserts a backslash before the first null char in szPath.
'szPath is unchanged if it already contains a backslash
'before the first null char or contains no null char at all.
'Rtn pointer to?
'Does not check szPath for validity.
'(the name almost fits...)  
Public Declare Function SHAddBackslash Lib "shell32" _
   Alias "#32" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Rtn a pointer to the string in szPath after the last backslash.
'Rtns 0 if szPath contains no backslash or no char follows the 
'last backslash. For the function to succeed, szPath should 
'be null terminated and be allocated to MAX_PATH bytes (260).
'Does not check szPath for validity.
'(could be called "GetStrAfterLastBackslash")  
Public Declare Function SHGetFileName Lib "shell32" _
   Alias "#34" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Fills szPath w/ the path portion of the passed path & filename.
'szPath must be a valid absolute path.
'For the function to work correctly, szPath should be 
'null terminated and be allocated to MAX_PATH bytes (260).
'(could be called "GetStrBeforeLastBackslash")  
Public Declare Function SHGetPath Lib "shell32" _
   Alias "#35" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Rtns non-zero if szPath does not evaluate to a UNC path.
'(if either the first char is not a backslash "\" 
'or the 2nd char is not a colon ":")
'Does not check szPath for validity.
'(the name almost fits...)  
Public Declare Function SHPathIsRelative Lib "shell32" _
   Alias "#40" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Rtns non-zero if szPath has an executable extension.
'(if last 4 char are either ".exe", ".com", 
'".bat" or ".pif")
'Does not check szPath for validity.
'(could be called "HasExeExtension")  
Public Declare Function SHPathIsExe Lib "shell32" _
   Alias "#43" _
  (ByVal szPath As String) As Long
  
  '------------------------------------------------------
'Rtns non-zero if szPath is valid absolute UNC path.
'Accepts file, folder or network paths.
'Rtns True for a relative path only if it exists 
'in the curdir. (the name actually fits...)  
Public Declare Function SHFileExists Lib "shell32" _
   Alias "#45" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Rtns a pointer to the string after first space in szPath.
'Rtns null pointer if szPath contains no space or no char
'following the first space.
'For the function to succeed, szPath should be 
'null terminated and be allocated to MAX_PATH bytes (260).
'Does not check szPath for validity.
'(could be called "GetStrAfterFirstSpace")  
Public Declare Function SHGetPathArgs Lib "shell32" _
   Alias "#52" _
  (ByVal szPath As String) As Long
  
  '------------------------------------------------------
'Rtns a pointer to the string after first space in szPath.
'Rtns null pointer if szPath contains no space or no char
'following the first space.
'For the function to succeed, szPath should be 
'null terminated and be allocated to MAX_PATH bytes (260).
'Does not check szPath for validity.
'(could be called "AddQuotesIfPathHasASpace")  
Public Declare Function SHAddPathQuotes Lib "shell32" _
   Alias "#55" _
  (ByVal szPath As String) As Long
  
  '------------------------------------------------------
'Rtns a pointer to the string after first space in szPath.
'Rtns null pointer if szPath contains no space or no char
'following the first space.
'For the function to succeed, szPath should be null terminated
'and be allocated to MAX_PATH bytes (260).
'Does not check szPath for validity.
'(could be called "RemoveQuotesIfPathHasASpace")  
Public Declare Function SHRemovePathQuotes Lib "shell32" _
   Alias "#56" _
  (ByVal szPath As String) As Long
  
'------------------------------------------------------
'Fills szPath w/its DOS (8.3) file system string.
'If successful, rtns non-zero (sometimes is a 
'pointer to szPath, sometimes not!). Rtns zero 
'if path is invalid. szPath must be a valid absolute 
'path. Rtns non-zero for a relative path only if 
'it exists in the curdir. For the function to work 
'correctly, szPath should be null terminated
'and be allocated to MAX_PATH bytes (260).
'(the name definitely fits...)  
Public Declare Function SHGetShortPathName Lib "shell32" _
   Alias "#92" _
  (ByVal szPath As String) As Long


'--------------------------
'Wrappers for Path functions (see respective 
'API description above):
'--------------------------
Public Function FileExists(sPath As String) As Boolean
  
  'convert to Unicode if required  
   sPath = CheckString(sPath)
  
  'call the API  
   FileExists = SHFileExists(sPath)
   
End Function


Public Function GetFileName(sPathIn As String) As String
  
   Dim sPathOut As String
  
  'pad the string with nulls  
   sPathOut = MakeMaxPath(sPathIn)
  
  'convert to Unicode if required  
   sPathOut = CheckString(sPathOut)
  
   GetFileName = GetStrFromPtr(SHGetFileName(sPathOut), MAX_PATH)
   
End Function


Public Function GetArgs(sPathIn As String) As String

   Dim sPathOut As String
  
   sPathOut = MakeMaxPath(sPathIn)
   sPathOut = CheckString(sPathOut)

  'return the passed arguments
   GetArgs = GetStrFromPtr(SHGetPathArgs(sPathOut), Len(sPathOut))
  
End Function


Public Function GetShortPath(sPathIn As String) As String
  
   Dim sPathOut As String
  
   sPathOut = MakeMaxPath(sPathIn)
   sPathOut = CheckString(sPathOut)
  
   SHGetShortPathName sPathOut
   GetShortPath = GetStrFromBuffer(sPathOut)
  
End Function


Public Function IsPathRelative(sPath As String) As Boolean
  
   sPath = CheckString(sPath)
  
  'return true or false  
   IsPathRelative = SHPathIsRelative(sPath)
  
End Function


Public Function QualifyPath(sPath As String) As String
  
  'check the string type (ANSI or Unicode),
  'converting as required.  
  
  'Check with If .. Then for a slash; if it's
  'needed, add a trailing null string after the
  'Checked string, as SHAddBackslash inserts a
  'backslash before the first null char in szPath.  
   sPath = CheckString(sPath)
   
   If Right$(sPath, 1) <> "\" Then
     
     'do what is says  
      sPath = sPath & vbNullChar
      SHAddBackslash sPath
      
   End If
   
  'and return the string  
   QualifyPath = sPath
  
End Function


Public Function MakeMaxPath(ByVal sPath As String) As String
   
  'Terminates sPath w/ null chars making
  'the return string MAX_PATH chars long.  
   MakeMaxPath = sPath & String$(MAX_PATH - Len(sPath), 0)

End Function


Public Function IsPathExe(sPath As String) As Boolean
  
   sPath = CheckString(sPath)
  
  'return true or false  
   IsPathExe = SHPathIsExe(sPath)
  
End Function


Public Function GetExtension(sPathIn) As String

   Dim sPathOut As String
  
   sPathOut = MakeMaxPath(sPathIn)
   sPathOut = CheckString(sPathOut)
  
  'Does not fill sPathOut w/ extention, just
  'returns the pointer to the extention  
   GetExtension = GetStrFromPtr(SHGetExtension(sPathOut), Len(sPathOut))
   
End Function


Public Function StripFileName(sPathIn)

   Dim sPathOut As String
  
   sPathOut = MakeMaxPath(sPathIn)
   sPathOut = CheckString(sPathOut)
  
   SHGetPath sPathOut
   StripFileName = GetStrFromBuffer(sPathOut)
   
End Function


Public Function PathAddQuotes(sPathIn) As String

   Dim sPathOut As String
  
   sPathOut = MakeMaxPath(sPathIn)
   sPathOut = CheckString(sPathOut)
  
   SHAddPathQuotes sPathOut
   PathAddQuotes = GetStrFromBuffer(sPathOut)
   
End Function


Public Function PathRemoveQuotes(sPathIn) As String

   Dim sPathOut As String
  
   sPathOut = MakeMaxPath(sPathIn)
   sPathOut = CheckString(sPathOut)
  
   SHRemovePathQuotes sPathOut
   PathRemoveQuotes = GetStrFromBuffer(sPathOut)
   
End Function


Public Function IsWinNT() As Boolean
  
  'Returns True if the current operating system is WinNT  
   Dim osvi As OSVERSIONINFO
   osvi.dwOSVersionInfoSize = Len(osvi)
   GetVersionEx osvi
   IsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)
   
End Function


Public Function CheckString(msg As String) As String

   If bIsWinNT Then
      CheckString = StrConv(msg, vbUnicode)
   Else
      CheckString = msg
   End If
   
End Function


Public Function GetStrFromPtr(lpszStr As Long, nBytes As Integer) As String
  
  'Returns string before first null char 
  'encountered (if any) from a string pointer.
  'lpszStr = memory address of first byte in string
  'nBytes = number of bytes to copy.
  'StrConv used for both ANSII and Unicode strings
  'BE CAREFUL!  
   ReDim ab(nBytes) As Byte   'zero-based (nBytes + 1 elements)
   
   CopyMemory ab(0), ByVal lpszStr, nBytes
   GetStrFromPtr = GetStrFromBuffer(StrConv(ab(), vbUnicode))
  
End Function


Public Function GetStrFromBuffer(szStr As String) As String
   
  'Returns string before first null 
  'char encountered (if any) from either an ANSII or 
  'Unicode string buffer.  
   If IsUnicodeStr(szStr) Then szStr = StrConv(szStr, vbFromUnicode)
   
   If InStr(szStr, vbNullChar) Then
      GetStrFromBuffer = Left$(szStr, InStr(szStr, vbNullChar) - 1)
   Else
      GetStrFromBuffer = szStr
   End If

End Function


Public Function IsUnicodeStr(sBuffer As String) As Boolean
  
  'Returns True if sBuffer evaluates to 
  'a Unicode string  
   Dim dwRtnFlags As Long
   dwRtnFlags = IS_TEXT_UNICODE_UNICODE_MASK
   IsUnicodeStr = IsTextUnicode(ByVal sBuffer, Len(sBuffer), dwRtnFlags)

End Function
 Form Code
Add a new form containing a picture box (Picture1), a Dir list (Dir1), File list (File1) and Drive list (Drive1), along with a textbox (Text1) and command button Command1). Add the following code:

Option Explicit
         
Private sInitDirectory As String
Private sInitDrive As String

         
Private Sub Command1_Click()

   Unload Me
   
End Sub


Private Sub Dir1_Change()
    
    Dir1.Path = Drive1.Drive
    File1 = Dir1.Path
    Text1.Text = Dir1.Path

End Sub


Private Sub Drive1_Change()

    Dir1.Path = Drive1.Drive
  
End Sub


Private Sub File1_Click()

   Text1.Text = QualifyPath(File1.Path) & LCase$(File1.FileName)
   Call DoPathFunctions

End Sub


Private Sub Form_Load()

   Dim r As Long
   Dim sDirBuff As String
  
  'We'll need this flag to determine if
  'strings should be converted to Unicode
   bIsWinNT = IsWinNT
   
   Move (Screen.Width - Width) * 0.5, (Screen.Height - Height) * 0.5
   
  'we'll be moving around a bit, so save
  'the current directory into a variable
  'for reseting on exit.   
   sInitDirectory = CurDir
   sInitDrive = Left$(sInitDirectory, 1)
   
   sDirBuff = Space$(MAX_PATH)
   r = GetWindowsDirectory(sDirBuff, MAX_PATH)
   
   If r > 0 Then
      Drive1.Drive = LCase$(Left$(sDirBuff, 3))     'ie "c:\"
      Dir1.Path = LCase$(GetStrFromBuffer(sDirBuff))'ie "c:\windows"
   End If
    
End Sub


Private Sub DoPathFunctions()

   Dim sTx As String
   Dim sOut As String
  
  'covers any invalid path selection  
   On Error GoTo DoPathFunctions_Error
  
  'Make the displayed path the current drive and
  'dir so that FileExists evaluates relative paths
   ChDrive Drive1
   ChDir Dir1
   
   On Error GoTo 0
   
   sTx = Text1.Text

   sOut = "VB CurDir:     " & vbTab & Dir1 & vbCrLf
   sOut = sOut & "SHGetPath:" & vbTab & StripFileName(sTx) & vbCrLf & vbCrLf
   
   sOut = sOut & "FileExists:" & vbTab & FileExists(sTx) & vbCrLf
   
   sOut = sOut & "GetExtension:" & vbTab & GetExtension(sTx) & vbCrLf
   sOut = sOut & "GetFileName:" & vbTab & GetFileName(sTx) & vbCrLf
   
   sOut = sOut & "IsPathRelative:" & vbTab & IsPathRelative(sTx) & vbCrLf
   sOut = sOut & "IsPathExe:" & vbTab & IsPathExe(sTx) & vbCrLf

   sOut = sOut & "GetArgs:   " & vbTab & GetArgs(sTx) & vbCrLf
   sOut = sOut & "GetShortPath:" & vbTab & GetShortPath(sTx) & vbCrLf
   
   sOut = sOut & "PQSpaces:" & vbTab & PathAddQuotes(sTx) & vbCrLf
   sOut = sOut & "PUQSpaces:" & vbTab & PathRemoveQuotes(sTx)
   
   picPaths.AutoRedraw = True
   picPaths.Cls
   picPaths.Print sOut
   picPaths.AutoRedraw = False
   
   
DoPathFunctions_Error:

  If Err Then MsgBox Err.Description
  
End Sub


Private Sub Form_Unload(Cancel As Integer)
  
 'Restore the initial startup drive & 
 'directory (cached at app start)  
  Dim sCurrDirectory As String
  Dim sCurrDrive As String
  
  sCurrDirectory = CurDir
  sCurrDrive = Left$(sInitDirectory, 1)

  If sCurrDrive <> sInitDrive Then ChDrive sInitDrive
  If sCurrDirectory <> sInitDirectory Then ChDir sInitDirectory
    
End Sub
 Comments
Save the project before running. Navigate around clicking files, noting how each API reacts.

To test the GetArgs function, try entering a path/filename with command line arguments (i.e. c:\win\someapp.exe /b /s /-r test.text") & vbCrLf into the textbox, and then hit Execute. Notice that if the path or filename has a space, then the args begin after the space, even if this is in the middle of the path, not the space before the args themselves (see the demo illustration above. The file selected is _New Text.txt, but the API returns "Text.txt" as arguments because of the space.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter