//Преобразование путей файловой системы
unit PathConvert;

interface
uses Windows, SysUtils, Classes;


function LongPathToShort(path: String): String;
function ShortPathToLong(path: String): String;
function AbsPathToRelative(path, curdir: String): String;
function RelativePathToRelative(path, curdir: String): String;

implementation

//Именно объявления нужной нам функции нет в unit Windows (Delphi 7)
function GetLongPathName(lpszLongPath: PChar; lpszShortPath: PChar;
  cchBuffer: DWORD): DWORD; stdcall; external kernel32 name 'GetLongPathNameA';

//Преобразование пути с длинными именами файлов в путем с
//форматов имен 8.3 (DOS)
function LongPathToShort(path: String): String;
var
  buffer: String;
  len: Integer;
begin
  SetLength(buffer, MAX_PATH);
  len := GetShortPathName(PAnsiChar(path), PAnsiChar(buffer), MAX_PATH);
  SetLength(buffer, len);
  LongPathToShort := buffer;
end;

//Преобразование пути из формата 8.3 (DOS) к пути с длинными именами файлов
function ShortPathToLong(path: String): String;
var
  buffer: String;
  len: Integer;
begin
  SetLength(buffer, MAX_PATH);
  len := GetLongPathName(PAnsiChar(path), PAnsiChar(buffer), MAX_PATH);
  SetLength(buffer, len);
  ShortPathToLong := buffer;
end;

//Процедура заполняет список строк элементами пути (именами отдельных
//каталогов пути)
procedure GetPathElements(path: String; elements: TStrings);
var
  start, pos: Integer;
begin
  start := 1;
  for pos := 1 to Length(path) do
    if path[pos] = '\' then
    begin
      if start <> pos then
        //Выделим имя каталога
        elements.Add(Copy(path, start, pos - start))
      else
        //Сочетание типа '\\' в середине пути пропускаем
        ;
      start := pos + 1;
    end;
    pos := Length(path) + 1;
    if start <> pos then
      //Выделим имя последнего каталога или файла
      elements.Add(Copy(path, start, pos - start));
end;

//Преобразование абсолютного пути path в относительный относительно
//папки curdir
function AbsPathToRelative(path, curdir: String): String;
var
  pathElements, curElements: TStrings;
  outPath: String;
  i, j: Integer;
begin
  if Copy(path, 1, 2) <> Copy(curdir, 1, 2) then
  begin
    //Папки на разных дисках
    AbsPathToRelative := path;
    Exit;
  end;

  //Получение составляющих абсолютного и текущего пути
  pathElements := TStringList.Create;
  GetPathElements(path, pathElements);
  curElements := TStringList.Create;
  GetPathElements(curdir, curElements);

  i := 0;
  //Пропускаем одинаковые папки
  while (i < curElements.Count) and (i < pathElements.Count)
    and (CompareText(curElements[i], pathElements[i]) = 0) do Inc(i);
  //Добавляем небходимое количество переходов вверх для того, чтобы из
  //папки curdir попасть в общую для path и curdir папку
  for j := i to curElements.Count-1 do
    outPath := outPath + '..\';
  //Заходим из папки полученной (общей) папки в папку path
  for j := i to pathElements.Count - 2 do
    outPath := outPath + pathElements[j] + '\';
  //Последним добавляем имя конечной папки или файла
  AbsPathToRelative := outPath + pathElements[pathElements.Count - 1];

  pathElements.Free;
  curElements.Free;
end;



//Функция преобразует относительный (начальная папка - curdir) путь в
//абсолютный (или относительный, если путь папки curdir относительный)
function RelativePathToRelative(path, curdir: String): String;
var
  pathElements, curElements: TStrings;
  outPath: String;
  i: Integer;
begin
  //Получение списка составляющих абсолютного и текущего пути
  pathElements := TStringList.Create;
  GetPathElements(path, pathElements);
  curElements := TStringList.Create;
  GetPathElements(curdir, curElements);
  //Изначально находимся в последней папке пути curdir
  // "Путешествуем" от текущей папке вверх или вниз по дереву каталогов
  // (прибавляя или удаляя компоненты пути в список curElements)
  for i := 0 to pathElements.Count-1 do
  begin
    if pathElements[i] = '..' then
      //Вверх по дереву
      if (curElements.Count > 0)then
        curElements.Delete(curElements.Count - 1)
      else
        curElements.Append('..')
    else if pathElements[i] <> '.' then
      //Вниз по дереву (знак текущей папки "." не изменяет положение)
      curElements.Append(pathElements[i]);
  end;
  //Формируем результирующий путь
  if (curElements.Count > 0) then outPath := curElements[0];
  for i := 1 to curElements.Count-1 do
    outPath := outPath + '\' + curElements[i];
  RelativePathToRelative := outPath;
  //Списки строк больше не нужны
  pathElements.Free;
  curElements.Free;
end;

end.
