Hi Juha,
FPC RTL comes with ExtractRelativePath. I still use my own code because
Delphi's didn't work properly either. It seems FPC's ExtractRelativePath
is much shorter than mine. If someone can confirm it works well that
would be great (no time now to test thoroughly).
I use the following code (comes from Delphi but with some changes). The
second function is to expand a relative path. I don't know how you can
have one without the other, but then I probably don't know where to look
for it.
function ExtractRelativePath(const BaseName, DestName: string): string;
var
BasePath, DestPath: string;
BaseLead, DestLead: PChar;
BasePtr, DestPtr: PChar;
function ExtractFilePathNoDrive(const FileName: string): string;
begin
Result := ExtractFilePath(FileName);
Delete(Result, 1, Length(ExtractFileDrive(FileName)));
end;
function Next(var Lead: PChar): PChar;
begin
Result := Lead;
if Result = nil then Exit;
Lead := AnsiStrScan(Lead, PathDelim);
if Lead <> nil then
begin
Lead^ := #0;
Inc(Lead);
end;
end;
begin
if SameFilename(ExtractFileDrive(BaseName),
ExtractFileDrive(DestName)) then
begin
BasePath := ExtractFilePathNoDrive(BaseName);
DestPath := ExtractFilePathNoDrive(DestName);
BaseLead := PChar(BasePath);
BasePtr := Next(BaseLead);
DestLead := Pointer(DestPath);
DestPtr := Next(DestLead);
while (BasePtr <> nil) and (DestPtr <> nil) and
SameFilename(BasePtr, DestPtr) do
begin
BasePtr := Next(BaseLead);
DestPtr := Next(DestLead);
end;
Result := '';
while BaseLead <> nil do
begin
Result := Result + '..' + PathDelim;
Next(BaseLead);
end;
if (DestPtr <> nil) and (DestPtr^ <> #0) then
Result := Result + DestPtr + PathDelim;
if DestLead <> nil then
Result := Result + DestLead; // destlead already has a
trailing backslash
Result := Result + ExtractFileName(DestName);
if Result='' then Result:='.';
end
else
Result := DestName;
end;
function ExpandRelativePath(const BaseName, DestName: String): String;
var
BasePath, DestPath: string;
BaseDirs, DestDirs: array[0..129] of PChar;
BaseDirCount, DestDirCount: Integer;
I, J: Integer;
function ExtractFilePathNoDrive(const FileName: string): string;
begin
Result := ExtractFilePath(FileName);
Result := Copy(Result, Length(ExtractFileDrive(FileName)) + 1, 32767);
end;
procedure SplitDirs(var Path: string; var Dirs: array of PChar;
var DirCount: Integer);
var
I, J, L: Integer;
begin
I := 1;
J := 0;
L := Length(Path);
while (I<=L) and (Path[I] in LeadBytes) do Inc(I);
if I<=L then
begin
if Path[I] = PathDelim then
begin
Path[I] := #0;
Dirs[J] := @Path[I + 1];
Inc(J);
end
else
begin
Dirs[J] := @Path[I];
Inc(J);
end;
Inc(I);
end;
while I<=L do
begin
if Path[I] = PathDelim then
begin
Path[I] := #0;
Dirs[J] := @Path[I + 1];
Inc(J);
end;
Inc(I);
end;
DirCount := J - 1;
end;
begin
if (DestName='.') or (DestName='') then Result:=ExtractFilePath(BaseName)
else if ExtractFileDrive(DestName)='' then
begin
if DestName[1]=PathDelim then
Result:=ExtractFileDrive(BaseName)+DestName
else
begin
BasePath := ExtractFilePathNoDrive(BaseName);
DestPath := ExtractFilePathNoDrive(DestName);
SplitDirs(BasePath, BaseDirs, BaseDirCount);
SplitDirs(DestPath, DestDirs, DestDirCount);
I:=0;
while (I<DestDirCount) and (StrComp(DestDirs[I], '..')=0) do Inc(I);
Result := '';
for J := 0 to BaseDirCount-I-1 do
Result := Result + BaseDirs[J] + PathDelim;
for J := I to DestDirCount - 1 do
Result := Result + DestDirs[J] + PathDelim;
Result:=Result+ExtractFileName(DestName);
end;
end
else Result := DestName;
end;
Regards,
Paul.
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
