* Fix for bug ID #18551

git-svn-id: trunk@27773 -
This commit is contained in:
michael 2014-05-11 17:02:56 +00:00
parent a397b1b480
commit 17e34abc62
3 changed files with 9 additions and 22 deletions

View File

@ -674,6 +674,7 @@ var
{$endif FPC_HAS_FEATURE_DYNLIBS}
IsConsole : boolean = false; public name 'operatingsystem_isconsole';
NoErrMsg: Boolean platform = False; // For Delphi compatibility, not used in FPC.
FirstDotAtFileNameStartIsExtension : Boolean = False;
DefaultSystemCodePage,
DefaultUnicodeCodePage,

View File

@ -105,13 +105,20 @@ function ExtractFileExt(const FileName: PathStr): PathStr;
var
i : longint;
EndSep : Set of Char;
SOF : Boolean; // Dot at Start of filename ?
begin
Result:='';
I := Length(FileName);
EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
while (I > 0) and not CharInSet(FileName[I],EndSep) do
Dec(I);
if (I > 0) and (FileName[I] = ExtensionSeparator) then
Result := Copy(FileName, I, MaxInt)
begin
SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
if (Not SOF) or FirstDotAtFileNameStartIsExtension then
Result := Copy(FileName, I, MaxInt);
end
else
Result := '';
end;

View File

@ -357,27 +357,6 @@ end;
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
Var
DotPos,SlashPos,i : longint;
Begin
SlashPos:=0;
DotPos:=256;
i:=Length(Path);
While (i>0) and (SlashPos=0) Do
Begin
If (DotPos=256) and (Path[i]='.') Then
begin
DotPos:=i;
end;
If (Path[i]='/') Then
SlashPos:=i;
Dec(i);
End;
Ext:=Copy(Path,DotPos,255);
Dir:=Copy(Path,1,SlashPos);
Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
End;
Function DoFileLocking(Handle: Longint; Mode: Integer) : Longint;