路径 c:\windows 相对于 c:\dos 来讲，相对路径为 ..\windows, 如何计算一个路径相对于另一路径的相对路径？ =========================================== 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[i] = '\' 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. 风花雪月 e梦情缘

------
风花雪月 e梦情缘