Задача: Относительный путь к файлу
Исходник: Нахождение относительного пути к файлу, язык: vb [code #189, hits: 8368]
автор: - [добавлен: 20.12.2006]
  1. Function GetRelativePath(sFrom, sTo)
  2.  
  3. GetRelativePath = ""
  4. sFromTmp = ""
  5. sToTmp = ""
  6. sTmp = ""
  7. bFirst = True
  8.  
  9. Do While Len(sFrom) > Len(sFromTmp) Or Len(sTo) > Len(sToTmp)
  10. If Len(sFrom) > Len(sFromTmp) Then
  11. If Not bFirst Then sFrom = Right(sFrom, Len(sFrom) - Len(sFromTmp) - 1)
  12. sFromTmp = GetLeftPart(sFrom)
  13. Else
  14. sFrom = ""
  15. sFromTmp = ""
  16. End If
  17.  
  18. If Len(sTo) > Len(sToTmp) Then
  19. If Not bFirst Then sTo = Right(sTo, Len(sTo) - Len(sToTmp) - 1)
  20. sToTmp = GetLeftPart(sTo)
  21. Else
  22. sTo = ""
  23. sToTmp = ""
  24. End If
  25.  
  26. If bFirst And sFromTmp <> sToTmp Then
  27. Exit Function ' Нет общего корня
  28. Else
  29. bFirst = False
  30. End If
  31.  
  32. If Len(GetRelativePath) > 0 Or sFromTmp <> sToTmp Then
  33. If Len(sFromTmp) > 0 Then
  34. If Len (GetRelativePath) > 0 Then
  35. GetRelativePath = GetRelativePath & "\.."
  36. Else
  37. GetRelativePath = GetRelativePath & ".."
  38. End If
  39. End If
  40. If Len(sToTmp) > 0 Then
  41. If Len(sTmp) > 0 Then
  42. sTmp = sTmp & "\" & sToTmp
  43. Else
  44. sTmp = sTmp & sToTmp
  45. End If
  46. End If
  47. End If
  48. Loop
  49.  
  50. If Len(sTmp) > 0 Then GetRelativePath = GetRelativePath & "\" & sTmp
  51. If 0 = Len(GetRelativePath) Then GetRelativePath = "."
  52.  
  53. End Function
  54.  
  55. Function GetLeftPart(sPath)
  56.  
  57. For i = 1 To Len(sPath)
  58. If "\" = Mid(sPath, i, 1) Then
  59. GetLeftPart = Left(sPath, i - 1)
  60. Exit Function
  61. End If
  62. Next
  63.  
  64. GetLeftPart = sPath
  65.  
  66. End Function
В инсталляции (сделанной в WiX) мне понадобилось добавлять свой фильтр в ISA Server. А там, при добавлении, надо указывать относитьный путь к библиотеке фильтра (относильно самой ISA). Сделал добавление и нахождение относительного пути в скрипте на VB.

(с)BoresExpress, http://rsdn.ru/forum/Message.aspx?mid=2269433

+добавить реализацию