paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 04:19:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amiga: ExtractFilenameOnly/ExtractFileRoot for amiga systems

Browse Source 
git-svn-id: trunk@53971 -
This commit is contained in:
marcus 2017-01-18 19:43:14 +00:00
parent 85b6fc0bc3
commit d9f917f93e
1 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/lazutils/lazfileutils.pas
View File

@ -278,7 +278,7 @@ begin
StartPos:=length(AFilename)+1;
while (StartPos>1)
and not (AFilename[StartPos-1] in AllowDirectorySeparators)
{$IFDEF Windows}and (AFilename[StartPos-1]<>':'){$ENDIF}
{$IF defined(Windows) or defined(HASAMIGA)}and (AFilename[StartPos-1]<>':'){$ENDIF}
do
dec(StartPos);
ExtPos:=length(AFilename);
@ -1326,8 +1326,13 @@ begin
{$if defined(unix) or defined(wince)}
if (FileName[1] = PathDelim) then Result := PathDelim;
{$else}
if (Len > 2) and (FileName[1] in ['a'..'z','A'..'Z']) and (FileName[2] = ':') and (FileName[3] in AllowDirectorySeparators) then
Result := UpperCase(Copy(FileName,1,3));
{$ifdef HASAMIGA}
if Pos(':', FileName) > 1 then
Result := Copy(FileName, 1, Pos(':', FileName));
{$else}
if (Len > 2) and (FileName[1] in ['a'..'z','A'..'Z']) and (FileName[2] = ':') and (FileName[3] in AllowDirectorySeparators) then
Result := UpperCase(Copy(FileName,1,3));
{$endif}
{$endif}
end;
end;