paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 22:59:15 +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

7
components/lazutils/lazfileutils.pas
View File

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