Валерий Борисок - Delphi. Трюки и эффекты

Примечание

Все приведенные далее функции преобразования вы можете найти в модуле PathConvert, расположенном на диске, в папке с названием подраздела.

Листинг 4.17.

Преобразование пути из длинной в короткую форму

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;

Листинг 4.18.

Преобразование пути из короткой в длинную форму

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;

function GetLongPathName(lpszLongPath: PChar;

lpszShortPath: PChar; cchBuffer: DWORD): DWORD;

stdcall; external kernel32 name \'GetLongPathNameA\

Листинг 4.19.

Разбиение пути на составляющие

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;

Листинг 4.20.

Преобразование абсолютного пути в относительный

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;

Листинг 4.21.

Преобразование относительного пути в абсолютный

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;