lazutils: restored old CreateRelativePath, added doc

git-svn-id: trunk@41064 -

components/lazutils/lazfileutils.pas

@@ -648,9 +648,157 @@ end;
 
 function CreateRelativePath(const Filename, BaseDirectory: string;
   UsePointDirectory: boolean): string;
+{
+Creates a relative path from BaseDirectory to Filename.
+A trailing path delimiter of BaseDirectory is ignored.
+If there is no relative path it returns Filename.
+If BaseDirectory and Filename are the same and UsePointDirectory is false it
+returns the empty string. If UsePointDirectory is true it returns '.'.
+Duplicate path delimiters are treated as one.
+
+In other words if it returns a relative file name then the following is true:
+TrimFilename(Filename) = TrimFilename(BaseDirectory+PathDelim+Result).
+
+Filename='/a' BaseDir='/a' Result=''
+Filename='/a' BaseDir='/a' UsePointDirectory=true Result='.'
+Filename='/a' BaseDir='/a/' Result=''
+Filename='/a/b' BaseDir='/a/b' Result=''
+Filename='/a/b' BaseDir='/a/b/' Result=''
+Filename='/a' BaseDir='/a/' Result=''
+Filename='/a' BaseDir='' Result='/a'
+Filename='/a/b' BaseDir='/a' Result='b'
+Filename='/a/b' BaseDir='/a/' Result='b'
+Filename='/a/b' BaseDir='/a//' Result='b'
+Filename='/a' BaseDir='/a/b' Result='../'
+Filename='/a' BaseDir='/a/b/' Result='../'
+Filename='/a' BaseDir='/a/b//' Result='../'
+Filename='/a/' BaseDir='/a/b' Result='../'
+Filename='/a' BaseDir='/a/b/c' Result='../../'
+Filename='/a' BaseDir='/a/b//c' Result='../../'
+Filename='/a' BaseDir='/a//b/c' Result='../../'
+Filename='/a' BaseDir='/a//b/c/' Result='../../'
+Filename='/a' BaseDir='/b' Result='/a'
+
+}
+var
+  FileNameLength: Integer;
+  BaseDirLen: Integer;
+  SamePos: Integer;
+  UpDirCount: Integer;
+  BaseDirPos: Integer;
+  ResultPos: Integer;
+  i: Integer;
+  FileNameRestLen: Integer;
+  CmpBaseDirectory: String;
+  CmpFilename: String;
+  p: Integer;
+  DirCount: Integer;
 begin
-  if (BaseDirectory='') or (Filename='') then Exit(FileName);
-  Result := SysUtils.ExtractRelativePath(ExpandFileNameUtf8(IncludetrailingPathDelimiter(BaseDirectory)),FileName);
+  Result:=Filename;
+  if (BaseDirectory='') or (Filename='') then exit;
+
+  {$IFDEF Windows}
+  // check for different windows file drives
+  if (CompareText(ExtractFileDrive(Filename),
+                  ExtractFileDrive(BaseDirectory))<>0)
+  then
+    exit;
+  {$ENDIF}
+  CmpBaseDirectory:=BaseDirectory;
+  CmpFilename:=Filename;
+  {$IFDEF darwin}
+  CmpBaseDirectory:=GetDarwinSystemFilename(CmpBaseDirectory);
+  CmpFilename:=GetDarwinSystemFilename(CmpFilename);
+  {$ENDIF}
+  {$IFDEF CaseInsensitiveFilenames}
+  CmpBaseDirectory:=AnsiUpperCaseFileName(CmpBaseDirectory);
+  CmpFilename:=AnsiUpperCaseFileName(CmpFilename);
+  {$ENDIF}
+
+  FileNameLength:=length(CmpFilename);
+  while (FileNameLength>0) and (CmpFilename[FileNameLength]=PathDelim) do
+    dec(FileNameLength);
+  BaseDirLen:=length(CmpBaseDirectory);
+  while (BaseDirLen>0) and (CmpBaseDirectory[BaseDirLen]=PathDelim) do
+    dec(BaseDirLen);
+  if BaseDirLen=0 then exit;
+
+  //DebugLn(['CreateRelativePath START ',copy(CmpBaseDirectory,1,BaseDirLen),' ',copy(CmpFilename,1,FileNameLength)]);
+
+  // count shared directories
+  p:=1;
+  DirCount:=0;
+  BaseDirPos:=p;
+  while (p<=FileNameLength) and (BaseDirPos<=BaseDirLen)
+  and (CmpFileName[p]=CmpBaseDirectory[BaseDirPos]) do
+  begin
+    if CmpFilename[p]=PathDelim then
+    begin
+      inc(DirCount);
+      repeat
+        inc(p);
+      until (p>FileNameLength) or (CmpFilename[p]<>PathDelim);
+      repeat
+        inc(BaseDirPos);
+      until (BaseDirPos>BaseDirLen) or (CmpBaseDirectory[BaseDirPos]<>PathDelim);
+    end else begin
+      inc(p);
+      inc(BaseDirPos);
+    end;
+  end;
+  UpDirCount:=0;
+  if ((BaseDirPos>BaseDirLen) or (CmpBaseDirectory[BaseDirPos]=PathDelim))
+  and ((p>FileNameLength) or (CmpFilename[p]=PathDelim)) then
+  begin
+    // for example File=/a BaseDir=/a/b
+    inc(DirCount);
+  end else begin
+    // for example File=/aa BaseDir=/ab
+    inc(UpDirCount);
+  end;
+  if DirCount=0 then exit;
+  if FilenameIsAbsolute(BaseDirectory) and (DirCount=1) then exit;
+
+  // calculate needed up directories
+  while (BaseDirPos<=BaseDirLen) do begin
+    if (CmpBaseDirectory[BaseDirPos]=PathDelim) then
+    begin
+      inc(UpDirCount);
+      repeat
+        inc(BaseDirPos);
+      until (BaseDirPos>BaseDirLen) or (CmpBaseDirectory[BaseDirPos]<>PathDelim);
+    end else
+      inc(BaseDirPos);
+  end;
+
+  // create relative filename
+  SamePos:=1;
+  p:=0;
+  FileNameLength:=length(Filename);
+  while (SamePos<=FileNameLength) do begin
+    if (Filename[SamePos]=PathDelim) then begin
+      repeat
+        inc(SamePos);
+      until (SamePos>FileNameLength) or (Filename[SamePos]<>PathDelim);
+      inc(p);
+      if p>=DirCount then
+        break;
+    end else
+      inc(SamePos);
+  end;
+  FileNameRestLen:=FileNameLength-SamePos+1;
+  //writeln('DirCount=',DirCount,' UpDirCount=',UpDirCount,' FileNameRestLen=',FileNameRestLen,' SamePos=',SamePos);
+  SetLength(Result,3*UpDirCount+FileNameRestLen);
+  ResultPos:=1;
+  for i:=1 to UpDirCount do begin
+    Result[ResultPos]:='.';
+    Result[ResultPos+1]:='.';
+    Result[ResultPos+2]:=PathDelim;
+    inc(ResultPos,3);
+  end;
+  if FileNameRestLen>0 then
+    System.Move(Filename[SamePos],Result[ResultPos],FileNameRestLen);
+
   if UsePointDirectory and (Result='') and (Filename<>'') then
     Result:='.'; // Filename is the BaseDirectory
 end;

docs/xml/lazutils/lazfileutils.xml

@@ -527,7 +527,7 @@
 A trailing path delimiter of BaseDirectory is ignored.
 If there is no relative path it returns Filename.
 If BaseDirectory and Filename are the same and UsePointDirectory is false it returns the empty string. If UsePointDirectory is true it returns '.'.
-
+Duplicate path delimiters are treated as one.
 In other words if it returns a relative file name then the following is true:
 TrimFilename(Filename) = TrimFilename(BaseDirectory+PathDelim+Result).</descr>
 <errors>

test/bugs/testfileproc.pas

@@ -66,6 +66,7 @@ procedure TTestFileProc.TestCreateRelativePath;
 
 begin
   DoTest('/a','/a','');
+  DoTest('/a','/a','.',true);
   DoTest('/a','/a/','');
   DoTest('/a/b','/a/b','');
   DoTest('/a/b','/a/b/','');