paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-01 08:26:16 +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;
function ExtractFileDrive(const FileName: string): string;
var i: longint;
var
i,l: longint;
begin
if (Length(FileName) >= 2) and (FileName[2] = ':') then
result := Copy(FileName, 1, 2)
else if (Length(FileName) >= 2) and (FileName[1] in ['/', '\']) and
(FileName[2] in ['/', '\']) then begin
i := 2;
While (i < Length(Filename)) do begin
if Filename[i + 1] in ['/', '\'] then break;
inc(i);
end ;
Result := Copy(FileName, 1, i);
end
else Result := '';
Result := '';
l:=Length(FileName);
if (L>=2) then
begin
If (FileName[2]=':') then
result:=Copy(FileName,1,2)
else if (FileName[1] in ['/','\']) and
(FileName[2] in ['/','\']) then
begin
i := 2;
While (i<L) and Not (Filename[i+1] in ['/', '\']) do
inc(i);
Result:=Copy(FileName,1,i);
end;
end;
end;
function ExtractFileName(const FileName: string): string;