'------------------------------------------------------
'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