function ExtractRelativepath (Const BaseName,DestName : PathStr): PathStr;
Var Source, Dest : PathStr;
Sc,Dc,I,J
{$ifndef SYSUTILSUNICODE}
,Len, NewLen
{$endif not SYSUTILSUNICODE}
: Longint;
SD,DD : Array[1..MaxDirs] of PathPChar;
Const OneLevelBack = '..'+DirectorySeparator;
begin
If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then
begin
Result:=DestName;
exit;
end;
Source:=ExcludeTrailingPathDelimiter(ExtractFilePath(BaseName));
Dest:=ExcludeTrailingPathDelimiter(ExtractFilePath(DestName));
SC:=GetDirs (Source,SD);
DC:=GetDirs (Dest,DD);
I:=1;
While (I<=DC) and (I<=SC) do
begin
If StrIcomp(DD[i],SD[i])=0 then
Inc(i)
else
Break;
end;
Result:='';
{$ifdef SYSUTILSUNICODE}
For J:=I to SC do Result:=Result+OneLevelBack;
For J:=I to DC do Result:=Result+DD[J]+DirectorySeparator;
{$else SYSUTILSUNICODE}
{ prevent conversion to DefaultSystemCodePage due to concatenation of
constant string -- and optimise a little by reducing the numher of
setlength cals }
if SC>=I then
begin
Len:=Length(Result);
SetLength(Result,Len+(SC-I+1)*Length(OneLevelBack));
For J:=0 to SC-I do
move(shortstring(OneLevelBack)[1],Result[Len+1+J*Length(OneLevelBack)],Length(OneLevelBack));
end;
if DC>=I then
begin
Len:=Length(Result);
NewLen:=Len+(DC-I+1)*sizeof(ansichar);
For J:=I to DC do
Inc(NewLen,Length(DD[J]));
SetLength(Result,NewLen);
For J:=I to DC do
begin
NewLen:=Length(DD[J]);
Move(DD[J][0],Result[Len+1],NewLen);
inc(Len,NewLen);
Result[Len+1]:=DirectorySeparator;
Inc(Len);
end;
end;
{$endif SYSUTILSUNICODE}
Result:=Result+ExtractFileName(DestName);
end;
Forse ho trovato il modo di "imbrogliare" la funzione:
Writeln(ExtractRelativepath(ExtractFilePath(ExpandFileName(Application.ExeName)), ExtractFilePath(ExpandFileName(Application.ExeName)) + '\ss1'));
..\bin\\ss1
Effettivamente il comportamento non è esattamente quello che mi aspettavo leggendo la documentazione.