12种方法返回2个文件路径之间的公共基路径ExtractBasePath(3)

时间：2011/9/3 15:31:41 点击：

方法七：Ivan Cvetkovic

function ExtractBasePath(const path1, path2 : string) : string;
  procedure SplitPath(Path: string; sl: TStrings) ;
  begin
    sl.Delimiter := PathDelim;
    sl.StrictDelimiter := True;
    sl.DelimitedText := Path;
  end;
var
sl1, sl2: TStrings;
cnt: Integer;
begin
Result := EmptyStr;

sl1 := TStringList.Create;
try
   SplitPath(Path1, sl1) ;

   sl2 := TStringList.Create;
   try
     SplitPath(Path2, sl2) ;

     for cnt := 0 to Min(sl1.Count, sl2.count) - 1 do
     begin
       if not AnsiSameText(sl1[cnt], sl2[cnt]) then Break;
       Result := Result + sl1[cnt] + PathDelim;
     end;
   finally
     sl2.Free;
   end;
finally
   sl1.Free;
end;
end;
方法八：Paul Bennett

function ExtractBasePath(const Path1, Path2: string): string;
var
  p1, p2, Matched: string;
  PathDelimiter: string[1];
  nStart, n1, n2, ctr: Integer;
begin
  p1 := ExtractFilePath(Path1) ;
  p2 := ExtractFilePath(Path2) ;

  if (Length(p1) = 0) or (Length(p2) = 0) then Exit;

  if CompareText(p1, p2) = 0 then
  begin
    Result:= p1;
    Exit;
  end;

  PathDelimiter := p1[Length(p1)];
  Matched := '';
  nStart := 1;

  repeat
    n1 := PosEx(PathDelimiter, p1, nStart) ;
    n2 := PosEx(PathDelimiter, p2, nStart) ;

    if (n1 = n2) And (n1 <> 0) then
    begin
      for ctr:= nStart to n1 do
      begin
        if p1[ctr] <> p2[ctr] then Break;
      end;

      if ctr > n1 then
      begin
        Matched:= Matched +Copy(p1, nStart, ctr -nStart) ;
        nStart := ctr;
      end;
    end;
  until (n1 <> n2) or (ctr < n1) ;

  if Length(Matched) > 2 then Matched := IncludeTrailingPathDelimiter(Matched) ;

  Result:= Matched;
end;
方法九：Caleb Hattingh

function ExtractBasePath(const path1, path2 : string) : string;
var
  tsl1, tsl2: TStringList;
  j: Integer;
begin
  Result := '';
  tsl1 := TStringList.Create;
  tsl2 := TStringList.Create;
  try
    tsl1.StrictDelimiter := True;
    tsl2.StrictDelimiter := True;
    tsl1.Delimiter := '\';
    tsl1.DelimitedText := path1;
    tsl2.Delimiter := '\';
    tsl2.DelimitedText := path2;
    for j := 0 to tsl1.Count - 1 do
    begin
      if tsl1[j] = tsl2[j] then
        Result := Result + tsl1[j] + '\'
      else
        Exit;
    end;
  finally
    FreeAndNil(tsl1) ;
    FreeAndNil(tsl2) ;
  end;
end;