paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 15:37:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed bug #6491, fileextdrive

Browse Source 
git-svn-id: trunk@3560 -
This commit is contained in:
michael 2006-05-18 12:45:03 +00:00
parent b1cae757a5
commit b9a0fae596
1 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
rtl/objpas/sysutils/fina.inc
View File

@ -53,20 +53,26 @@ Result := Copy(FileName, 1, I);
end; end;
function ExtractFileDrive(const FileName: string): string; function ExtractFileDrive(const FileName: string): string;
var i: longint;
var
i,l: longint;
begin begin
if (Length(FileName) >= 2) and (FileName[2] = ':') then Result := '';
result := Copy(FileName, 1, 2) l:=Length(FileName);
else if (Length(FileName) >= 2) and (FileName[1] in ['/', '\']) and if (L>=2) then
(FileName[2] in ['/', '\']) then begin begin
i := 2; If (FileName[2]=':') then
While (i < Length(Filename)) do begin result:=Copy(FileName,1,2)
if Filename[i + 1] in ['/', '\'] then break; else if (FileName[1] in ['/','\']) and
inc(i); (FileName[2] in ['/','\']) then
end ; begin
Result := Copy(FileName, 1, i); i := 2;
end While (i<L) and Not (Filename[i+1] in ['/', '\']) do
else Result := ''; inc(i);
Result:=Copy(FileName,1,i);
end;
end;
end; end;
function ExtractFileName(const FileName: string): string; function ExtractFileName(const FileName: string): string;