如何计算相对路径/目录?(100分)

D

dujuan

Unregistered / Unconfirmed
GUEST, unregistred user!
路径 c:/windows 相对于 c:/dos 来讲,相对路径为 ../windows,
请问如何计算一个路径相对于另一路径的相对路径?
 
A

aimingoo

Unregistered / Unconfirmed
GUEST, unregistred user!
天!!!!!
怎么又不能Post答案??????????????
等我给“歪歪松”大哥发Mail吧,我已经给你写了一个通用函数呢。
 
A

aimingoo

Unregistered / Unconfirmed
GUEST, unregistred user!
这个问题倒是很有趣。^-^
于是一下午花了近两个小时,写出了一个通用函数,Post如下,并附测试程序.
===========================================
uses SysUtils;
//取右子串
Function RightSub(s:string
Len:Integer) : string;
begin
Delete(s,1,Length(s)-Len);
Result := s;
end;
//交换字串
procedure swapStr(var s1,s2 : string);
var tempstr : string;
begin
tempstr := s1;
s1 := s2;
s2 := tempstr;
end;

// 取两个目录的相对路径,注意串尾不能是'/'字符!
Function GetRelativePath(Source,Dest : string) : string;
Function GetPathComp(s1,s2:string) : integer;
//比较两路径字符串头部相同串的函数
begin
if length(s1) > Length(s2) then swapStr(s1,s2);

Result := pos(s1,s2);
while Result = 0 do
begin
if s1 = '' then exit;
s1 := ExtractFileDir(s1);
Result := pos(s1,s2);
end;

if Result <> 0 then Result := Length(s1);
if Result = 3 then Result := 2;
//修正因ExtractFileDir()处理'c:/'时产生的错误.
End;

Function GetRoot(s : ShortString) : string;
//取Dest的相对根路径的函数
var i : integer;
begin
Result := '';
for i := 1 to Length(s) do
if s = '/' then Result := Result + '../';
if Result = '' then Result := './';
//如果不想处理成"./"的路径格式,可去掉本行
end;

var RelativRoot, RelativSub : string;
HeadNum : integer;
begin
Source := UpperCase(Source)
Dest := UpperCase(Dest);

//比较两路径字符串头部相同串
HeadNum := GetPathComp(Source,Dest);

//取Dest的相对根路径
RelativRoot := GetRoot(RightSub(Dest,Length(Dest) - HeadNum));

//取Source的相对子路径
RelativSub := RightSub(Source,Length(Source) - HeadNum - 1);

//返回
Result := RelativRoot + RelativSub;
end;

begin
/// TEST!!!
Writeln(GetRelativePath('c:/test/aim','c:/test'))
// result = './aim'
Writeln(GetRelativePath('c:/test','c:/test/1/2'))
// result = '../../'
Writeln(GetRelativePath('c:/aim','c:/test'))
// result = '../aim'
Writeln(GetRelativePath('c:/dest/aim','c:/test/aim'));
// result = '../../aim'
end.
<hr>
请下载:<a href="/delphi/attachments/postit1.zip">来自aimingoo的答案</a>
 
顶部