方法一: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
?

轉載于:https://www.cnblogs.com/martian6125/archive/2009/07/22/9631286.html

總結

以上是生活随笔為你收集整理的12种方法返回2个文件路径之间的公共基路径ExtractBasePath的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。