This article may contain URLs that were valid when originally published, but now link to sites or pages that no longer exist. To maintain the flow of the article, we've left these URLs in the text, but disabled the links.

VBA Hacker

The Powerful String and Path Functions in Shlwapi.dll

By Romke Soldaat

When the functions of the Windows API are discussed, the core libraries such as User32 and Kernel32 are usually mentioned. They've been around since the very first version of Windows, although the "32" suffix was only added when the operating system became 32-bit. Other libraries with interesting functions (Shell32, Comdlg32, etc.) didn't become available until Windows 95 was released. All of these libraries are part of the operating system, so you don't have to question their presence on any PC.

Things are less clear-cut with the library named Shlwapi. The first version (4.71) was shipped with Internet Explorer (IE) 4.0 and Windows 98/NT5. The next version (4.72) came only with the IE 4.01 upgrade. Version 5.00 was introduced with IE5, and also became part of Windows 2000.

This means you can be assured that everybody has the Shlwapi.dll file, except those who are still running Windows 95/NT4, and never installed IE4 or IE5. Since this is probably a small minority, it's worthwhile to look at this library, and see what its functions offer.

Shlwapi stands for Shell Lightweight API. As you'll find out, the word "lightweight" has nothing to do with the library's features, but more with its file size (although the file grew from a mere 90 KB to nearly 280 KB over the past few generations). The functions can be organized into three categories: string manipulation, path manipulation, and registry access. In this article, I'll focus on the first two. I may dedicate a future article to the registry access functions.

ANSI or Unicode? Pointers or Strings?

Unlike system libraries such as User32 and Kernel32, Shlwapi comes with both ANSI and Unicode support, even on Windows 95/98. ANSI functions have the drawback that they can only deal with 8-bit character sets (character values 0-255), while Unicode functions support virtually every character used on our planet (with room to spare for languages of any aliens that may invade us).

From that point of view, it's worthwhile using the Unicode versions of the Shlwapi functions. That way you can be sure your code will run on every PC and every recent version of Windows. In this article and the accompanying download file (see end of article for details), you'll see these functions declared as aliases of the "W" (wide = Unicode) versions.

Shlwapi functions that deal with strings accept two ways to process them. You can pass the strings as they are, or you can pass them as string pointers. The following declarations are both valid:

Declare Function PathAddBackslashByString Lib "Shlwapi" _
   Alias "PathAddBackslashW" _
   (ByVal lpszPath As String) As Long
  
Declare Function PathAddBackslashByPointer Lib "Shlwapi" _
   Alias "PathAddBackslashW" _
   (ByVal lpszPath As Long) As Long

You would expect that the first declaration works fine with strings of any origin because VBA uses Unicode internally, but this is not so. When VBA passes strings to external functions (even if they are Unicode functions), it converts them first to ANSI format, which means that any characters that don't belong to the active code page get lost. There are two ways to prevent this from happening: You can convert the strings to byte arrays, or you can send the string's pointer (its memory address) to the API function. In either case, you can rest assured that VBA leaves your strings alone. Since pointers are easier to use than byte arrays, I'll stick to them in this article.

Getting a string pointer. VBA comes with a number of undocumented (and unsupported) functions that return pointers: StrPtr, VarPtr, and ObjPtr. Of these functions, StrPtr returns a pointer to the internal Unicode string - exactly what we need when we want to call an API function that expects a Unicode string pointer. The following code (from Listing One) shows how:

Declare Function StrTrim Lib "Shlwapi" Alias "StrTrimW"   As Boolean
  
Public Function TrimAny As String
  
  Dim pAddr As Long: pAddr = StrPtr
  Call StrTrim(pAddr, StrPtr(CharList)) 
  TrimAny = StringFromAddr(pAddr) 
End Function

Getting a string back from a pointer. In the above code, the Shlwapi StrTrim function takes two string pointers. The pAddr variable points to the string to be trimmed. When the function returns, this variable holds the pointer to the trimmed string. To get at the string itself, we have to perform some memory juggling, which is done in the following Ptr2StrU function:

Public Function Ptr2StrU(ByVal pAddr As Long) As String
  Dim lAddr As Long: lAddr = lstrlenW(pAddr) 
  StringFromAddr = Space$(lAddr) 
  CopyMemory ByVal StrPtr(Ptr2StrU), ByVal pAddr, lAddr * 2
End Function

This function receives the Unicode string pointer as its argument. The Windows lstrlenW function tells us how long that string is, and the value is used to create a text buffer (using the Space$ function), which receives the actual string. Then the Windows CopyMemory function (an alias for the cryptic internal name RtlMoveMemory) copies the source string pointer (pAddr) to the destination string pointer (obtained with the StrPtr function). The third parameter specifies the number of bytes to be copied. lAddr is multiplied by 2, because of the Unicode strings, which use two bytes for every character. After this operation, Ptr2StrU contains the string we're looking for.

So much for the introduction - time for the real stuff!

String Functions

The Shlwapi string functions are primarily designed to give C programmers enhanced versions of what they already have in their C++ run-time libraries. FIGURE 1 lists them. Most of these functions are not very useful for Office programming, because VBA offers similar ones, or lets you imitate them with built-in functions. For example, the Shlwapi StrStr/StrStrI functions work exactly like the VBA Instr function, and the Shlwapi StrCmp/StrCmpI pair doesn't offer anything you can't do with VBA's StrComp. The third column in FIGURE 1 shows which VBA functions you can use to mimic their Shlwapi counterparts.

FIGURE 1: Common string functions in all versions of Shlwapi. Where function names appear in pairs, the version that ends with an uppercase "I" performs a non-case-sensitive operation; the other one processes case-sensitive strings.

Following is a brief discussion of the handful of functions let you do things in VBA that would otherwise require quite a bit of code.

Smart trimming. The VBA Trim$ function returns a string that contains a copy of a specified string from which leading and trailing spaces have been removed. The Shlwapi StrTrim function goes a step further, by letting you specify a list of characters you want to trim. Each character in the list is removed from the start and end of the string you specify. Listing One implements StrTrim in a TrimAny VBA function. The following example prints "Test" in the Debug window:

s1 = "...Test///" 
s2 = "/." 
Debug.Print TrimAny(s1, s2) 

Smart substring location. VBA's Instr function locates a substring inside another string. By using the appropriate compare argument, you can make the search binary (case sensitive) or textual (case insensitive). The Shlwapi StrCSpn and StrCSpnI functions differ in that they accept a list of characters you want to locate. The functions return the position of the first listed character they find. The InstrAny function in Listing One converts this into VBA-friendly code. You'll also find a ContainsAnyChar function that simply returns True if a string contains at least one of a series of characters.

The following example demonstrates how you can determine if a suggested file name holds invalid characters. In this case the ContainsAnyChar function returns True, because the ">" character in FileName is one of the characters in TabooChars:

FileName = "myfile>.txt" 
TabooChars = "\/:*?<>|" & Chr(34) 
Debug.Print ContainsAnyChar(FileName, TabooChars) ' True

Smart number formatting. VBA 2000 introduced a number of handy functions that convert numeric values into currency, date, and percentage strings. Thanks to the Shlwapi StrFormatByteSize and StrFromTimeInterval functions, you can now also create strings that convert bytes into KB, GB, and terabytes (TB), and convert milliseconds into a string that expresses a value as hours, minutes, and seconds. Listing One incorporates these Shlwapi functions in two VBA functions: FormatTimeInterval and FormatByteSize.

FormatTimeInterval takes two arguments: the number of milliseconds (a Long, so the maximum value is 2,147,483,647, equivalent to 596 hr 31 min 24 sec), and the output precision, expressed as a number from one to seven. If no output precision is specified, the function uses the maximum value of seven. The following list demonstrates how these values are interpreted (note that fractions of seconds are ignored):

Output precision 7:   596 hr 31 min 24 sec
Output precision 6:   596 hr 31 min 20 sec
Output precision 5:   596 hr 31 min
Output precision 4:   596 hr 30 min
Output precision 3:   596 hr
Output precision 2:   590 hr
Output precision 1:   500 hr

FormatByteSize converts a given number of bytes into a string that represents the value in bytes, MB, GB, or TB. The Unicode version of the Shlwapi StrFormatByteSize function is designed to accept a 64-bit (also called LongLong) value. The only VBA data type that comes close to a 64-bit integer is Currency, except that this type is scaled by 10,000 to give a fixed point number with 15 digits to the left of the decimal point and four digits to the right, which limits the range to a maximum integer value of 922,337,203,685,477. Since this amount of bytes is the equivalent of 838 TB (nearly 900 million MB), it'll be a while before you get an overflow error when you convert a file size with the FormatByteSize function.

Private Declare Function GetDiskFreeSpaceEx _
   Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
   (ByVal lpRootPathName As String, _
  lpFreeBytesAvailableToCaller As Currency, _
  lpTotalNumberOfBytes As Currency, _
  lpTotalNumberOfFreeBytes As Currency) As Long
Private Sub DiskInfo()
  Dim cuAvailable As Currency
  Dim cuTotal As Currency
  Dim cuFree As Currency
  
  Call GetDiskFreeSpaceEx("C:\", cuAvailable, _
                          cuTotal, cuFree) 
  Debug.Print "Disk space info" & vbCr & _
    "Available : "; _
    FormatByteSize(cuAvailable * 10000) & vbCr & _
    "Total     : "; _
    FormatByteSize(cuTotal * 10000) & vbCr & _
    "Free      : "; _
    FormatByteSize(cuFree * 10000) & vbCr & _
    "Used      : "; _
    FormatByteSize((cuTotal - cuFree) * 10000) 
End Sub

FIGURE 2: Using the Currency data type to manage huge integers (up to 922,337,203,685,477 bytes - 838 TB).

FIGURE 2 demonstrates its use. Note that the GetDiskFreeSpaceEx API function is called with the Currency data type for its numeric parameters, and that the DiskInfo routine multiplies the return values by 10,000 to compensate for the fact that this data type divides 64-bit values by the same amount. The result on my system is:

Disk space info
Available : 2.78 GB
Total     : 7.36 GB
Free      : 2.78 GB
Used      : 4.58 GB

Path Functions

Most likely, your function library contains a number of homegrown routines that determine whether a file or folder exists, and that extract file and directory names from path strings. If you have Shlwapi, you can now dump those routines and use lightning fast API calls instead.

FIGURE 3 lists most path functions in the Shlwapi library. (I've left out the ones I consider less useful in the context of VBA applications.) The third column contains the names of the associated VBA functions in Listing Two. All routines call the Unicode versions of the Shlwapi functions, so they also work with path names containing characters that would be invalid under Windows 95/98.

FIGURE 3: Common path functions in all versions of Shlwapi. This list is not comprehensive.

Most functions in Listing Two are self-explanatory. In the following section, I'll limit myself to comments and examples.

Extracting File Path Components

Use the GetFile, GetFolder, GetExtension, GetRoot, SkipRoot, and GetDriveNumber functions to extract individual components from a fully qualified path:

MyFile = "C:\My Documents\Test.doc" 
Debug.Print GetFile(MyFile)       ' Prints: "Test.doc" 
Debug.Print GetFolder(MyFile)     '  "C:\My Documents" 
Debug.Print GetExtension(MyFile) '  ".doc" 
Debug.Print GetRoot(MyFile)       '  "C:\" 
Debug.Print SkipRoot(MyFile)      '  "My Documents\Test.doc" 
Debug.Print GetDriveNumber(MyFile) ' 2

The GetCommonPath function compares two path strings and returns the path they have in common:

MyFile1 = "C:\My Documents\Docs\Stuff\Test.doc" 
MyFile2 = "C:\My Documents\Docs\Things\Dummy.doc" 
' The following prints "C:\My Documents\Docs" 
Debug.Print GetCommonPath(MyFile1, MyFile2) 

Testing the Validity of File and Folder Names

You can use FileExists to test the existence of both files and folders. FolderExists tests only the validity of a folder name. Folder names can be specified with or without a terminating backslash. You can use FolderExists in conjunction with the RootFromDriveNumber function to get a list of available drives on a system:

For i = 0 To 25
  d = RootFromDriveNumber(i) 
   If FolderExists(d) Then Debug.Print d
Next

The HasPath and HasExtension functions return True if a file name contains path information or an extension, respectively. Note that HasPath also returns True if the path information is relative, as in:

Debug.Print HasPath("..\debug.txt") ' True

HasPrefix lets you test whether a file name starts with a specified path component:

MyFile = "C:\My Documents\Stuff\Test.doc" 
' True
Debug.Print HasPrefix("C:\My Documents", MyFile)       
' True
Debug.Print HasPrefix("C:\My Documents\Stuff", MyFile) 
' False
Debug.Print HasPrefix("C:\My Documents\Demo", MyFile) 

IsRelative returns True if the file name is preceded with a fully qualified path indicator:

Debug.Print IsRelative("C:\debug.txt") ' False
Debug.Print IsRelative("..\debug.txt") ' True
Debug.Print IsRelative("debug.txt")     ' True

The IsRoot function returns True if the specified path is a drive root (e.g. "C:\") or a server root (e.g. "\\Office\Word\"). HaveSameRoot compares two paths to determine if they have a common root component.

Theoretically, Shlwapi offers you two ways to determine if a file name matches a specified file type. You can use MatchSpec to test a file name against a DOS wildcard match type. The IsContentType function (which calls the Shlwapi PathIsContentType function) doesn't seem to work, but this may have been fixed in later versions. Here's how you can use them:

MyFile = "C:\My Documents\Test.doc" 
Debug.Print MatchSpec(MyFile, "*.doc")   ' True
' The following should print True, but always
' seems to print False: 
Debug.Print IsContentType( _
  MyFile, "Microsoft Word Document") 

The QualifyPath function returns True if a given path is correctly formatted and fully qualified. If the path name doesn't contain folder info, the name of the active directory is used to create a qualified path.

IsValidUNC, IsValidUNCServer, IsValidUNCServerShare, and IsValidURL functions return True if the specified path has a valid format.

Formatting and Modifying File and Folder Strings

The AddBackslash and RemoveBackslash functions do exactly what their names suggest. AddRemoveBackslash combines the functionality of both. Of the following instructions, the first two add a backslash to MyDir if there isn't one, and the last one removes the terminating backslash if there is one:

Debug.Print AddRemoveBackslash(MyDir) 
Debug.Print AddRemoveBackslash(MyDir, True)
Debug.Print AddRemoveBackslash(MyDir, False)

Four functions let you manipulate file name extensions. AddExtension adds an extension if the file name doesn't have one. RenameExtension replaces an existing extension, or adds an extension if there isn't one. RemoveExtension removes any existing extension. The AddRemoveExtension function does all of the above, depending on how you use its parameters. Here are some examples:

MyFile = "Test.doc" 
' "Test.doc" 
Debug.Print AddRemoveExtension(MyFile, "txt", False) 
' "Test.txt" 
Debug.Print AddRemoveExtension(MyFile, "txt", True)
' "Test.txt" 
Debug.Print AddRemoveExtension(MyFile, "txt") 
' "Test" 
Debug.Print AddRemoveExtension(MyFile)               
' "Test" 
Debug.Print AddRemoveExtension(MyFile, vbNullString) 

Listing Two contains two functions with similar names: BuildPath and BuildPath2. They use different Shlwapi functions that appear to work in exactly the same way; each lets you join two given path components, and automatically insert a backslash between the two parts if necessary. The functions also cope well with relative paths, as shown here:

MyFolder = "C:\My Documents\Docs\Stuff" 
' This prints "C:\My Documents\Docs\Stuff\Test.doc" 
Debug.Print BuildPath(MyFolder,"Test.doc") 
' This prints "C:\My Documents\Test.doc" 
Debug.Print BuildPath(MyFolder,"..\..\Test.doc") 

Some Windows functions and applications can't cope with file names if they contain spaces. The solution is to enclose the name in quotation marks. QuoteSpaces does it for you, and UnquoteSpaces reverses the action. The AddRemoveQuotes function combines the two functions in a single routine.

Finally, Listing Two contains three functions that truncate a file path to fit within a given width by replacing path components with ellipses. CompactPathByPixels function fits the string within a given pixel width. This function requires a handle to a device context (hDC) used for font metrics, which limits its usability in regular VBA applications. CompactPathDlgCrl fits the string in a dialog box control. This function requires a handle to the dialog's window, and an ID number for the dialog box control, which doesn't make it useful in VBA forms. The most useful function therefore is CompactPathByChars, which fits the string within a certain number of characters. Here's how to use it:

MyFile = _
   "C:\My Documents\VBAHACKS\Lightweight API\Part One.doc" 
Debug.Print CompactPathByChars(MyFile, 20) 
Debug.Print CompactPathByChars(MyFile, 30) 
Debug.Print CompactPathByChars(MyFile, 40) 

These instructions print the following truncated file names:

C:\...\Part One.doc
C:\My Documen...\Part One.doc
C:\My Documents\VBAHACK...\Part One.doc

Conclusion

The purpose of this series is to demonstrate that there is a lot more to VBA programming than you may think. With a bit of hacking, you can greatly enhance your programming environment, and produce many useful functions that VBA doesn't offer. In this installment, you learned how to use the Shell Lightweight API to create powerful routines that deal with strings and path names. Watch this space for more VBA hacks!

Dutchman Romke Soldaat was hired by Microsoft in 1988 to co-found the Microsoft International Product Group in Dublin, Ireland. That same year he started working with the prototypes of WinWord, writing his first macros long before the rest of the world. In 1992 he left Microsoft, and created a number of successful add-ons for Office. Living in Italy, he divides his time between writing articles for this magazine, enjoying the Mediterranean climate, and steering his Land Rover through the world's most deserted areas. Romke can be contacted at romke@soldaat.com.

Begin Listing One - ShlWAPIString.bas

Option Explicit
  
Private nRet As Long
  
Private Declare Function lstrlenW Lib "kernel32" ( _
   ByVal lpString As Long) As Long
  
Private Declare Sub CopyMemory Lib "kernel32" Alias _
  "RtlMoveMemory" (dest As Any, source As Any, _
   ByVal Bytes As Long)
  
Private Declare Function StrCSpn Lib "Shlwapi" _
   Alias "StrCSpnW" (ByVal lpStr As Long, _
   ByVal lpSet As Long) As Long
  
Private Declare Function StrCSpnI Lib "Shlwapi" _
   Alias "StrCSpnW" (ByVal lpStr As Long, _
   ByVal lpSet As Long) As Long
  
Private Declare Function StrTrim Lib "Shlwapi" _
   Alias "StrTrimW" (ByVal pszSource As Long, _
   ByVal pszTrimChars As Long) As Boolean
  
Private Declare Function StrFormatByteSize Lib "Shlwapi" _
   Alias "StrFormatByteSizeW" (ByVal dw As Currency, _
   ByVal pszBuf As Long, ByVal cchBuf As Long) As Long
  
Private Declare Function StrFromTimeInterval _
   Lib "Shlwapi" Alias "StrFromTimeIntervalW" ( _
   ByVal pszOut As Long, ByVal cchMax As Long, _
   ByVal dwTimeMS As Long, ByVal digits As Long) As Long
  
Public Function InstrAny(SearchString As String, _
  CharList As String, _
   Optional CaseSensitive As Boolean = True) As Long
  
  ' Returns the position of the first occurrence of
  ' a character in CharList within SearchString. 
  If CaseSensitive Then
    nRet = StrCSpn(StrPtr(SearchString), StrPtr(CharList)) 
  Else
    nRet = StrCSpnI(StrPtr(SearchString), StrPtr(CharList)) 
  End If
  Select Case nRet
    Case 0, Len(SearchString) 
      InstrAny = 0
    Case Else
      InstrAny = nRet + 1
  End Select
End Function
  
Public Function ContainsAnyChar(
   ByVal SearchString As String, CharList As String, _
   Optional CaseSensitive As Boolean = True) As Boolean
  
  ' Returns True if SearchString contains any 
  ' character in CharList. 
  ContainsAnyChar = CBool(InstrAny(SearchString, _
    CharList, CaseSensitive)) 
End Function
  
Public Function TrimAny(ByVal SearchString As String, _
  CharList As String) As String
  
  ' Removes all characters in CharList from the start and
  ' end of SearchString. 
  Dim pAddr As Long: pAddr = StrPtr(SearchString) 
  Call StrTrim(pAddr, StrPtr(CharList)) 
  TrimAny = Ptr2StrU(pAddr) 
End Function
  
Public Function FormatByteSize(Bytes As Currency) As String
  ' Converts a bytes value into a bytes, MB, GB, 
  ' or TB string max Bytes = 922,337,203,685,477 (838 TB). 
  Dim strBuff As String * 256
  nRet = StrFormatByteSize(Bytes / 10000, _
                            StrPtr(strBuff), 256) 
  If nRet Then FormatByteSize = Ptr2StrU(nRet) 
End Function
  
Public Function FormatTimeInterval(Milliseconds As Long, _
   Optional OutputPrecision As Long = 7) As String
  ' Converts a milliseconds value into an hr min sec string
  ' max Milliseconds = 2,147,483,647 (596 hr 31 min 24 sec) 
  ' Pass zero values to obtain required buffer length. 
  nRet = StrFromTimeInterval(0, 0, Milliseconds, _
                              OutputPrecision) 
  ' Create buffer and get pointer. 
  Dim strBuff As String: strBuff = Space$(nRet) 
  Dim pAddr As Long: pAddr = StrPtr(strBuff) 
  ' Call function again. 
  Call StrFromTimeInterval(pAddr, nRet, Milliseconds, _
                            OutputPrecision) 
  FormatTimeInterval = Ptr2StrU(pAddr) 
End Function
  
Private Function Ptr2StrU(ByVal pAddr As Long) As String
  ' Retrieves the Unicode string from a given address. 
  Dim lAddr As Long: lAddr = lstrlenW(pAddr) 
  Ptr2StrU = Space$(lAddr) 
  CopyMemory ByVal StrPtr(Ptr2StrU), ByVal pAddr, LAddr * 2
End Function

End Listing One

Begin Listing Two - ShlWAPIPath.bas

Option Explicit
  
Const MAX_PATH As Long = 260
Private pAddr As Long
  
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" (dest As Any, source As Any, _
   ByVal Bytes As Long)
  
Private Declare Function lstrlenW Lib "kernel32" _
   (ByVal lpString As Long) As Long
  
' ===== DIRECTORY FUNCTIONS =====
Private Declare Function PathIsDirectory Lib "Shlwapi" _
   Alias "PathIsDirectoryW" _
   (ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathRemoveFileSpec Lib "Shlwapi" _
   Alias "PathRemoveFileSpecW" _
   (ByVal pszPath As Long) As Boolean
  
Private Declare Function PathAddBackslash Lib "Shlwapi" _
   Alias "PathAddBackslashW" _
   (ByVal lpszPath As Long) As Long
  
Private Declare Function PathRemoveBackslash _
   Lib "Shlwapi" Alias "PathRemoveBackslashW" _
   (ByVal lpszPath As Long) As Long
  
Private Declare Function PathIsPrefix Lib "Shlwapi" _
   Alias "PathIsPrefixW" (ByVal pszPrefix As Long, _
   ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathCommonPrefix Lib "Shlwapi" _
   Alias "PathCommonPrefixW" (ByVal pszFile1 As Long, _
   ByVal pszFile2 As Long, ByVal pszPath As Long) As Long
  
Private Declare Function PathIsRelative Lib "Shlwapi" _
   Alias "PathIsRelativeW" _
   (ByVal lpszPath As Long) As Boolean
  
' ======= FILE FUNCTIONS ========
Private Declare Function PathFileExists Lib "Shlwapi" _
   Alias "PathFileExistsW" _
   (ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathIsFileSpec Lib "Shlwapi" _
   Alias "PathIsFileSpecW" _
   (ByVal lpszPath As Long) As Boolean
  
Private Declare Sub PathStripPath Lib "Shlwapi" _
   Alias "PathStripPathW" (ByVal pszPath As Long)
  
Private Declare Function PathFindFileName Lib "Shlwapi" _
   Alias "PathFindFileNameW" (ByVal pPath As Long) As Long
  
' ===== EXTENSION FUNCTIONS =====
Private Declare Function PathAddExtension Lib "Shlwapi" _
   Alias "PathAddExtensionW" (ByVal lpszPath As Long, _
   ByVal pszExtension As Long) As Boolean
  
Private Declare Sub PathRemoveExtension Lib "Shlwapi" _
   Alias "PathRemoveExtensionW" (ByVal lpszPath As Long)
  
Private Declare Function PathFindExtension Lib "Shlwapi" _
   Alias "PathFindExtensionW" (ByVal pPath As Long) As Long
  
Private Declare Function PathRenameExtension _
   Lib "Shlwapi" Alias "PathRenameExtensionW" _
   (ByVal lpszPath As Long, _
   ByVal pszExtension As Long) As Boolean
  
Private Declare Function PathMatchSpec Lib "Shlwapi" _
   Alias "PathMatchSpecW" (ByVal pszFileParam As Long, _
   ByVal pszSpec As Long) As Boolean
  
Private Declare Function PathIsContentType Lib "Shlwapi" _
   Alias "PathIsContentTypeW" (ByVal pszPath As Long, _
   ByVal pszContentType As Long) As Boolean
  
' ===== UNC AND URL FUNCTIONS =====
Private Declare Function PathIsUNC Lib "Shlwapi" _
   Alias "PathIsUNCW" (ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathIsUNCServer Lib "Shlwapi" _
   Alias "PathIsUNCServerW" _
   (ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathIsUNCServerShare _
   Lib "Shlwapi" Alias "PathIsUNCServerShareW" _
   (ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathIsURL Lib "Shlwapi" _
   Alias "PathIsURLW" (ByVal lpszPath As Long) As Boolean
  
' ===== ROOT AND DRIVE FUNCTIONS =====
Private Declare Function PathIsRoot Lib "Shlwapi" _
   Alias "PathIsRootW" (ByVal lpszPath As Long) As Boolean
  
Private Declare Function PathIsSameRoot Lib "Shlwapi" _
   Alias "PathIsSameRootW" (ByVal lpszPath1 As Long, _
   ByVal lpszPath2 As Long) As Boolean
  
Private Declare Function PathStripToRoot Lib "Shlwapi" _
   Alias "PathStripToRootW" _
   (ByVal szRoot As Long) As Boolean
  
Private Declare Function PathSkipRoot Lib "Shlwapi" _
   Alias "PathSkipRootW" (ByVal pszPath As Long) As Long
  
Private Declare Function PathBuildRoot Lib "Shlwapi" _
   Alias "PathBuildRootW" (ByVal szRoot As Long, _
   ByVal iDrive As Integer) As Long
  
Private Declare Function PathGetDriveNumber Lib "Shlwapi" _
   Alias "PathGetDriveNumberW" _
   (ByVal pszPath As Long) As Long
  
' ==== BUILD PATH FUNCTIONS =====
Private Declare Function PathAppend Lib "Shlwapi" _
   Alias "PathAppendW" (ByVal pszPath As Long, _
   ByVal pszMore As Long) As Boolean
  
Private Declare Function PathCombine Lib "Shlwapi" _
   Alias "PathCombineW" (ByVal lpszDest As Long, _
   ByVal lpszDir As Long, ByVal lpszFile As Long) As Long
  
Private Declare Function PathSearchAndQualify _
   Lib "Shlwapi" Alias "PathSearchAndQualifyW" _
   (ByVal pcszPath As Long, _
   ByVal pszFullyQualifiedPath As Long, _
   ByVal cchFullyQualifiedPath As Integer) As Boolean
  
' ==== FORMATTING FUNCTIONS =====
Private Declare Sub PathQuoteSpaces Lib "Shlwapi" _
   Alias "PathQuoteSpacesW" (ByVal lpsz As Long)
  
Private Declare Sub PathUnquoteSpaces Lib "Shlwapi" _
   Alias "PathUnquoteSpacesW" (ByVal lpsz As Long)
  
' ==== COMPACTING FUNCTIONS ========
Private Declare Function PathCompactPath Lib "Shlwapi" _
   Alias "PathCompactPathW" (ByVal hDc As Long, _
   ByVal lpszPath As Long, ByVal dx As Integer) As Boolean
  
Private Declare Function PathCompactPathEx Lib "Shlwapi" _
   Alias "PathCompactPathExW" (ByVal pszOut As Long, _
   ByVal pszSrc As Long, ByVal cchMax As Integer, _
  dwFlags As Long) As Boolean
  
Private Declare Function PathSetDlgItemPath Lib "Shlwapi" _
   Alias "PathSetDlgItemPathW" (ByVal hDlg As Long, _
   ByVal id As Long, ByVal pszPath As Long) As Boolean
  
' ================================
' Extracting file path components. 
' ================================
Public Function GetFile(ByVal Path As String) As String
  ' Returns the file naGetFileme from a path name. 
  GetFile = Ptr2StrU(PathFindFileName(StrPtr(Path))) 
End Function
  
Public Function GetFolder(ByVal Path As String) As String
  ' Returns the folder name from a path name. 
  pAddr = StrPtr(Path) 
  Call PathRemoveFileSpec(pAddr) 
  GetFolder = Ptr2StrU(pAddr) 
End Function
  
Public Function GetExtension(ByVal Path As String) _
   As String
  
  ' Returns the extension name from a file name. 
  GetExtension = Ptr2StrU(PathFindExtension(StrPtr(Path))) 
End Function
  
Public Function GetRoot(ByVal Path As String) As String
  ' Returns the root name from a file name. 
  pAddr = StrPtr(Path) 
  Call PathStripToRoot(pAddr) 
  GetRoot = Ptr2StrU(pAddr) 
End Function
  
Public Function GetCommonPath(Path1 As String, _
  Path2 As String) As String
  ' Returns the common path component of two path names. 
  Dim strBuff As String * MAX_PATH
  pAddr = StrPtr(strBuff) 
  Call PathCommonPrefix(StrPtr(Path1), _
                         StrPtr(Path2), pAddr) 
  GetCommonPath = Ptr2StrU(pAddr) 
End Function
  
Public Function SkipRoot(ByVal Path As String) As String
  ' Returns the subpath that follows the root. 
  SkipRoot = Ptr2StrU(PathSkipRoot(StrPtr(Path))) 
End Function
  
Public Function GetDriveNumber(Path As String) As Long
  ' Returns the drive number of a path, in the range
  ' from 0 (drive A) to 25 (drive Z). 
  GetDriveNumber = PathGetDriveNumber(StrPtr(Path)) 
End Function
  
' ==============================================
' Testing the validity of file and folder names. 
' ==============================================
Public Function FileExists(Path As String) As Boolean
  ' Returns True if the path name is valid. 
  FileExists = PathFileExists(StrPtr(Path)) 
End Function
  
Public Function FolderExists(Path As String) As Boolean
  ' Returns True if the folder name is valid. 
  FolderExists = PathIsDirectory(StrPtr(Path)) 
End Function
  
Public Function HasPath(Path As String) As Boolean
  ' Returns True if the path name contains folder info. 
  HasPath = (PathIsFileSpec(StrPtr(Path)) = False)
End Function
  
Public Function HasExtension(Path As String) As Boolean
  ' Returns True if the path name contains an extension. 
  HasExtension = Len(GetExtension(Path)) 
End Function
  
Public Function HasPrefix(Prefix As String, _
  Path As String) As Boolean
  ' Retuns True if the path name starts with a specified
  ' path component. 
  HasPrefix = PathIsPrefix(StrPtr(Prefix), StrPtr(Path)) 
End Function
  
Public Function IsRelative(Path As String) As Boolean
  ' Returns True if the file name is preceded with a
  ' path indicator. 
  IsRelative = PathIsRelative(StrPtr(Path)) 
End Function
  
Public Function IsRoot(Path As String) As Boolean
  ' Returns True if the path name is a root name. 
  IsRoot = PathIsRoot(StrPtr(Path)) 
End Function
  
Public Function HaveSameRoot(Path1 As String, _
  Path2 As String) As Boolean
  ' Returns True if the two path names have the same root. 
  HaveSameRoot = _
    PathIsSameRoot(StrPtr(Path1), StrPtr(Path2)) 
End Function
  
Public Function MatchSpec(File As String, _
  Spec As String) As Boolean
  ' Returns True if the file name matches a wildcard match
  ' type (e.g. "*.doc"). 
  MatchSpec = PathMatchSpec(StrPtr(File), StrPtr(Spec)) 
End Function
  
Public Function IsContentType(File As String,_
  FileType As String) As Boolean
  ' bug? - always returns False. 
  IsContentType = PathIsContentType(StrPtr(File), _
                                     StrPtr(FileType)) 
End Function
  
Public Function QualifyPath(Path As String) As String
  ' Returns True if the path is correctly formatted and
  ' fully qualified. If the path name doesn't contain
  ' folder info, the name of the active directory is used
  ' to create a qualified path. 
  Dim strBuff As String * MAX_PATH
  pAddr = StrPtr(strBuff) 
  If PathSearchAndQualify( _
        StrPtr(Path), pAddr, MAX_PATH) Then
    QualifyPath = Ptr2StrU(pAddr) 
  End If
End Function
  
Public Function IsValidUNC(Path As String) As Boolean
  ' Returns True if the string is a valid UNC path. 
  IsValidUNC = PathIsUNC(StrPtr(Path)) 
End Function
  
Public Function IsValidUNCServer(Path As String) As Boolean
  ' Returns True if the string is a valid UNC path for a
  ' server only (no share name)IsValidUNCServer = 
  ' PathIsUNCServer(StrPtr(Path)). 
End Function
  
Public Function IsValidUNCServerShare(Path As String) _
   As Boolean
  ' Returns True if the string is in the form
  ' \\server\share. 
  IsValidUNCServerShare = _
    PathIsUNCServerShare(StrPtr(Path)) 
End Function
  
Public Function IsValidURL(Path As String) As Boolean
  ' Returns True if the path has a valid URL format. 
  IsValidURL = PathIsURL(StrPtr(Path)) 
End Function
  
' =================================================
' Formatting and modifying file and folder strings. 
' =================================================
Public Function AddBackslash(ByVal Path As String) _
   As String
  ' Adds a final backslash to the path is there
  ' is no backslash. 
  pAddr = StrPtr(PadBuffer(Path)) 
  Call PathAddBackslash(pAddr) 
  AddBackslash = Ptr2StrU(pAddr) 
End Function
  
Public Function RemoveBackslash(ByVal Path As String) _
   As String
  ' Removes a final backslash from the path
  ' if there is one. 
  pAddr = StrPtr(Path) 
  Call PathRemoveBackslash(pAddr) 
  RemoveBackslash = Ptr2StrU(pAddr) 
End Function
  
Public Function AddRemoveBackslash(ByVal Path As String, _
   Optional Add As Boolean = True) As String
  ' Adds or removes a final backslash. 
  pAddr = StrPtr(PadBuffer(Path)) 
  If Add Then
     Call PathAddBackslash(pAddr) 
  Else
     Call PathRemoveBackslash(pAddr) 
  End If
  AddRemoveBackslash = Ptr2StrU(pAddr) 
End Function
  
Public Function AddExtension(ByVal Path As String, _
  Extension As String) As String
  ' Adds the specified extension to the path
  ' if there is no extension. 
  QualifyExtension Extension
  pAddr = StrPtr(PadBuffer(Path)) 
  Call PathAddExtension(pAddr, StrPtr(Extension)) 
  AddExtension = Ptr2StrU(pAddr) 
End Function
  
Public Function RemoveExtension(ByVal Path As String) _
   As String
  ' Removes the extension from the path if there is one. 
  pAddr = StrPtr(Path) 
  Call PathRemoveExtension(pAddr) 
  RemoveExtension = Ptr2StrU(pAddr) 
End Function
  
Public Function RenameExtension(ByVal Path As String, _
  Extension As String) As String
  ' Renames the extension of the path if there is one, or
  ' adds the extension if there is none. 
  QualifyExtension Extension
  pAddr = StrPtr(PadBuffer(Path)) 
  Call PathRenameExtension(pAddr, StrPtr(Extension)) 
  RenameExtension = Ptr2StrU(pAddr) 
End Function
  
Public Function AddRemoveExtension(ByVal Path As String, _
   Optional Extension As String, _
   Optional RenameIfExists As Boolean = True)
  ' Combines the three functions above. If Extension is 
  ' omitted, any existing extension is removed. If 
  ' RenameIfExists is True, the specified extension 
  ' replaces any existing extension. 
  pAddr = StrPtr(PadBuffer(Path)) 
  Select Case Extension
   Case vbNullString
     Call PathRemoveExtension(pAddr) 
  Case Else
    QualifyExtension Extension
     If RenameIfExists = True Then
       Call PathRenameExtension(pAddr, StrPtr(Extension)) 
     Else
       Call PathAddExtension(pAddr, StrPtr(Extension)) 
     End If
  End Select
  AddRemoveExtension = Ptr2StrU(pAddr) 
End Function
  
Public Function BuildPath(ByVal Path As String, _
  File As String) As String
  ' Combines two path components, inserting a 
  ' backslash if needed. 
  pAddr = StrPtr(PadBuffer(Path)) 
  Call PathAppend(pAddr, StrPtr(File)) 
  BuildPath = Ptr2StrU(pAddr) 
End Function
  
Public FunctionBuildPath2(Path As String,_
  File As String) As String
  ' Combines two path components, inserting a 
  ' backslash if needed. 
  DimstrBuff As String* MAX_PATH
  BuildPath2 = Ptr2StrU(PathCombine(StrPtr(strBuff), _
     StrPtr(Path), StrPtr(File))) 
End Function
  
Public Function QuoteSpaces(ByVal Path As tring) As String
  ' Encloses the path in quotes if the path 
  ' contains spaces. 
  pAddr = StrPtr(PadBuffer(Path)) 
  Call PathQuoteSpaces(pAddr) 
  QuoteSpaces = Ptr2StrU(pAddr) 
End Function
  
Public Function UnquoteSpaces(ByVal Path As String) _
   As String
  ' Removes any leading and trailing quotes from the path. 
  pAddr = StrPtr(Path) 
  Call PathUnquoteSpaces(pAddr) 
  UnquoteSpaces = Ptr2StrU(pAddr) 
End Function
  
Public Function AddRemoveQuotes(ByVal Path As String, _
   Optional Add As Boolean = True)
  ' Adds or removes quotes. 
  pAddr = StrPtr(PadBuffer(Path)) 
  If Add Then
     Call PathQuoteSpaces(pAddr) 
  Else
     Call PathUnquoteSpaces(pAddr) 
  End If
  AddRemoveQuotes = Ptr2StrU(pAddr) 
End Function
  
Public Function CompactPathByChars( _
  Path As String, MaxChars) As String
  ' Truncates the path to fit within the specified
  ' number of characters. 
  Dim strBuff As String * MAX_PATH
  pAddr = StrPtr(strBuff) 
  Call PathCompactPathEx( _
          pAddr, StrPtr(Path), MaxChars + 1, 0) 
  CompactPathByChars = Ptr2StrU(pAddr) 
End Function
  
Public Function CompactPathByPixels(ByVal Path As String, _
  hDc As Long, MaxPixels As Long) As String
  ' Truncates the path to fit within the specified
  ' number of pixels. 
  pAddr = StrPtr(Path) 
  Call PathCompactPath(hDc, pAddr, MaxPixels) 
  CompactPathByPixels = Ptr2StrU(pAddr) 
End Function
  
Public Sub CompactPathDlgCrl(ByVal Path As String, _
  hDlg As Long, id As Long)
  ' Truncates the path to fit within the available space of
  ' a dialog box control, and sets the text of the control. 
  pAddr = StrPtr(Path) 
  Call PathSetDlgItemPath(hDlg, id, pAddr) 
End Sub
  
' ====
' MISC
' ====
Public Function RootFromDriveNumber(DriveNumber As Long) _
   As String
  ' Converts a drive number (from 0 to 25) into a root path
  ' (from "A:\" to "Z:\"). 
  Select Case DriveNumber
    Case 0 To 25
       Dim strBuff As String * 4
      RootFromDriveNumber = Ptr2StrU(PathBuildRoot( _
         StrPtr(strBuff), DriveNumber)) 
    Case Else:
   End Select
End Function
  
Private Function Ptr2StrU(ByVal pAddr As Long) As String
  Dim lAddr As Long: lAddr = lstrlenW(pAddr) 
  Ptr2StrU = Space$(lAddr) 
  CopyMemory ByVal StrPtr(Ptr2StrU), ByVal pAddr, lAddr * 2
End Function
  
Private Function PadBuffer(ByVal strPath As String) _
   As String
  PadBuffer = strPath & String$(MAX_PATH - Len(strPath), 0) 
End Function
  
Private Sub QualifyExtension(Extension As String)
  If Left$(Extension, 1) <> "." Then _
    Extension = "." & Extension
End Sub

End Listing Two