VB Code:
  1. Private Declare Function PathRelativePathTo Lib "shlwapi.dll" Alias "PathRelativePathToA" (ByVal pszPath As String, ByVal pszFrom As String, ByVal dwAttrFrom As Long, ByVal pszTo As String, ByVal dwAttrTo As Long) As Long
  2. Private Const MAX_PATH As Long = 260
  3. Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
  4. Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
  5.  
  6. '-----------------------------------------------------------
  7. ' Creates a relative path from one file or folder to another.
  8. '
  9. ' made by Alexander Triantafyllou alextriantf aat yahoo.gr
  10. '
  11. ' usage relative_path=get_relative_path_to(root_path,file_path)
  12. ' get_relative_path_to("d:\a\b\c\d","d:\a\b\index.html") will return
  13. ' "..\..\index.html"
  14. ' use FILE_ATTRIBUTE_DIRECTORY if the path is a directory
  15. ' or FILE_ATTRIBUTE_NORMAL if the path is a file
  16. '----------------------------------------------------------
  17.  
  18.  
  19. Public Function get_relative_path_to(ByVal parent_path As String, ByVal child_path As String) As String
  20.  
  21. Dim out_str As String
  22. Dim par_str As String
  23. Dim child_str As String
  24.  
  25. out_str = String(MAX_PATH, 0)
  26.  
  27. par_str = parent_path + String(100, 0)
  28. child_str = child_path + String(100, 0)
  29.  
  30. PathRelativePathTo out_str, par_str, FILE_ATTRIBUTE_DIRECTORY, child_str, FILE_ATTRIBUTE_NORMAL
  31.  
  32.  
  33. out_str = StripTerminator(out_str)
  34.  
  35. 'MsgBox out_str
  36. get_relate_path_to = out_str
  37. End Function
  38.  
  39.  
  40. 'Remove all trailing Chr$(0)'s
  41. Function StripTerminator(sInput As String) As String
  42.     Dim ZeroPos As Long
  43.     ZeroPos = InStr(1, sInput, Chr$(0))
  44.     If ZeroPos > 0 Then
  45.         StripTerminator = Left$(sInput, ZeroPos - 1)
  46.     Else
  47.         StripTerminator = sInput
  48.     End If
  49. End Function