[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

    {
    You included one of my subroutines in the SWAG-library. Unfortunately
    it was buggy. Below you will find the, hopefully, bugfree code.
    }

    function GetRelativeFileName (F: FNameStr): FNameStr;
    var
      D: DirStr;
      N: NameStr;
      E: ExtStr;
      i: integer;
      rd: string;
    begin
      F := FExpand(F);
      FSplit(F, D, N, E);
      if GetCurDrive = D[1] then begin
        { Same Drive - remove Driveinformation from D }
        Delete (D,1,2);
        F := GetCurDir;
        Delete (F,1,2);
        { Maybe it is a file in a directory higher than the actual directory }
        i := Pos(F,d);
        if i > 0 then begin
          if length(f) = 1 then Delete (d,1,length(F))
                           else Delete (d,1,length(F)+1);
          end
        else begin
          rd := '';
          if Pos(d,F) = 0 then begin
            repeat
              repeat
                rd := d[Ord(d[0])]+rd;
                dec(d[0]);
              until d[Ord(d[0])] = '\';
            until Pos(d,F) > 0;
            end;
          { Maybe it  is a file in a directory lower than the actual directory }
          if length(d)=1 then
             d:= '\'+rd
          else if Pos(d,F) > 0 then begin
            repeat
              rd := '..\'+rd;
              dec (F[0]);
              while F[Ord(F[0])] <> '\' do dec(F[0]);
            until (Pos(F,D) > 0) and not((d='\') and (F<>'\'));
            d := rd;
            end
          end;
        end;
      GetRelativeFileName := lower(D+N+E);
    end;

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]