首页 > 编程学习 > 12种方法返回2个文件路径之间的公共基路径ExtractBasePath


方法一:Boris Kumpar
function ExtractBasePath(const Path1,Path2:string):string;
const
  PATH_DELIMITER = '\';
  DRIVE_DELIMITER = ':';
var
  P1,P2:PChar;
  cnt,j:Integer;
begin
  P1:=PChar(Path1) ;
  P2:=PChar(Path2) ;

  cnt := 1;
  j := 0;
  {$B-}
  while (P1^ <> #0) and (P2^ <> #0) and (UpCase(P1^) = UpCase(P2^) ) do
  begin
    if (P1^=PATH_DELIMITER) or (P2^=PATH_DELIMITER) or ((j=0) and (P1^=DRIVE_DELIMITER)) then j:=cnt;

    Inc(cnt) ;
    Inc(P1) ;
    Inc(P2) ;
  end;

  if (P1^=PATH_DELIMITER) or (P2^=PATH_DELIMITER) then j := cnt - 1;

  Result:=Copy(Path1,1,j) ;
end;
方法二:Pablo Anizio
function ExtractBasePath(const path1, path2 : string) : string;
var
  sP1, sP2, stemp, rslt: String;
  slP1, slP2: TStringList;
  dif: Boolean;
  cnt, max: integer;
begin
  rslt := EmptyStr;
  if ((path1 <> EmptyStr) and (path2 <> EmptyStr)) then
  begin
    sP1 := ExtractFilePath(path1) ;
    sP2 := ExtractFilePath(path2) ;

    slP1 := TStringList.Create;
    while length(sP1) <> 0 do
    begin
      stemp := Copy(sP1,1,pos('\',sP1)) ;
      Delete(sP1,1,pos('\',sP1)) ;
      slP1.Add(stemp) ;
    end;

    slP2 := TStringList.Create;
    while length(sP2) <> 0 do
    begin
      stemp := Copy(sP2,1,pos('\',sP2)) ;
      Delete(sP2,1,pos('\',sP2)) ;
      slP2.Add(stemp) ;
    end;

    dif := False;
    cnt := 0;
    if (slP1.Count >= slP2.Count) then
      max := slP2.Count
    else
      max := slP1.Count;

    while (not dif) and (cnt < max) do
    begin
      if slP1.Strings[cnt] = slP2.Strings[cnt] then
        rslt := rslt + slP1.Strings[cnt]
      else
        dif := True;
      inc(cnt) ;
    end;

    slP1.Free;
    slP2.Free;
  end;

  Result := rslt;
end;

方法三:Vlad Man
function ExtractBasePath(const path1, path2: string): string;
var
  j: Integer;
  vStrLength: Integer;
  vLastDelemiterIndex: Integer;
begin
  Result := '';

  if Length(path1) > Length(path2) then
    vStrLength := Length(path2)
  else
    vStrLength := Length(path1) ;

  for j := 1 to vStrLength do
    if path1[j] = path2[j] then
      Result := Result + path1[j]
    else
      Break;

  vLastDelemiterIndex := LastDelimiter('\', Result) ;
  Delete(Result, vLastDelemiterIndex + 1, Length(Result) - vLastDelemiterIndex) ;
end;
方法四:Josip Brozovic
function ExtractBasePath( const path1, path2 : string ): string;
var
  s_shorter, s_longer: string;
  j: integer;
begin
  if Length( path1 ) > Length( path2 ) then
  begin
    s_longer := path1;
    s_shorter := path2;
  end
else
begin
    s_longer := path2;
    s_shorter := path1;
  end;

  result := s_shorter;

  for j := 1 to Length( s_shorter ) do
  begin
    if UpCase( path1[ j ] ) <> UpCase( path2[ j ] ) then
    begin
      Delete( result, j, MaxInt ) ;
      break;
    end;
  end;

  if ( result = s_shorter ) and
     ( Length( s_longer ) > Length( s_shorter )) and
     ( s_longer[ Length( s_shorter ) + 1 ] = '\' ) then
  begin
      result := result + '\';
  end;

  result := ExtractFilePath( result ) ;
end;

方法五:Korhan
function ExtractBasePath(const path1, path2 : string) : string;
var
  minLength : Integer;
  cnt : Integer;
  samePart : String;
begin
  if Length(path1) < Length(path2) then
    minLength := length(path1)
  else
    minLength := length(path2) ;

  Result := '';
  samePart := '';

  for cnt := 1 to minLength do
  begin
    if path1[cnt] = path2[cnt] then
    begin
      samePart := samePart + path1[cnt];
      if (path1[cnt] = '\') or ( (Length(path1) = Length(path2)) and (minLength = cnt) ) then
      begin
        Result := Result + samePart;
        samePart := '';
      end;
    end
    else
      Break;
  end;
end;

方法六:Jeff Lawson
function ExtractBasePath(const Path1, Path2: string): string;
var
  P1, P2,
  Dir1, Dir2,
  Base: string;
begin
  Base := '';
  P1 := LowerCase(Path1) ;
  P2 := LowerCase(Path2) ;

  if (ExtractFileExt(P1) = '') and (P1[Length(P1) - 1] <> '\') then P1 := P1 + '\';

  if (ExtractFileExt(P2) = '') and (P2[Length(P2) - 1] <> '\') then P2 := P2 + '\';

  while (P1 <> '') and (P2 <> '') do
  begin
    Dir1 := Copy(P1, 0, AnsiPos('\', P1)) ;
    Dir2 := Copy(P2, 0, AnsiPos('\', P2)) ;
    P1 := Copy(P1, Length(Dir1) + 1, Length(P1) - Length(Dir1) + 1) ;
    P2 := Copy(P2, Length(Dir2) + 1, Length(P2) - Length(Dir2) + 1) ;
    if Dir1 <> Dir2 then Break;
    Base := Base + Dir1;
  end;

  Result := Base;
end;
方法七: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;
方法十:Ricardo de O. Soares
function ExtractBasePath(const path1, path2: string): string;
var
   cnt: integer;
begin
   Result := '';

   if UpCase(path1[1]) <> UpCase(path2[1]) then
      Exit
   else
   begin
      for cnt := 1 to Min(Length(path1),Length(path2)) do
         if CompareText(LeftStr(path1,cnt),LeftStr(path2,cnt)) <> 0 then
            break;
      Result := Result + LeftStr(path1,cnt-1) ;

      while RightStr(Result,1) <> '\' do
         Delete(Result,Length(Result),1) ;
   end;
end;

方法十一:Antonio Bakula
function ExtractBasePath(APath1, APath2: string): string;
var
  tempRez: string;
  xx, minLen: integer;
begin
  minLen := Min(Length(APath1), Length(APath2)) ;
  Result := '';
  tempRez := '';
  for xx := 1 to minLen do
begin
    if APath1[xx] <> APath2[xx] then
      Break;
    tempRez := tempRez + APath1[xx];
    if APath1[xx] = '\' then
      Result := tempRez;
  end;
end;
最后一种ASM:Jens Borrisholt:
function ExtractBasePath(const Path1, Path2: string): string;
var
  CompareLength: Integer;
  cnt: Integer;
  P, Q: PChar;
begin
  Result := '';

  //Determent the shortest string
  asm
    mov eax, Path1
    mov edx, Path2
    test eax, edx //Test for nil string
    jnz @NotNilString
    mov esp, ebp
    pop ebp
    ret //restore registers and exit

  @NotNilString:
    mov ecx, [eax - 4]
    cmp ecx, [edx - 4]
    jle @Path2Shortest //Length(P1) > Length(P2)
    mov ecx, [edx - 4]

  @Path2Shortest:
    mov CompareLength, ecx
  end;

  p := PChar(Path1) ;
  q := PChar(Path2) ;

  cnt := 1;
  while cnt <= CompareLength do
  if CSTR_EQUAL <> CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P + cnt, 1, Q + cnt, 1) then
    break
  else
    inc(cnt) ;

  while (p[cnt] <> PathDelim) and (cnt > 0) do Dec(cnt) ;

  if cnt <> 0 then SetString(Result, p, cnt + 1) ;
end;
本文来自Delphi之窗,原文地址:http://www.52delphi.com
 

Copyright © 2010-2022 ngui.cc 版权所有 |关于我们| 联系方式| 豫B2-20100000