paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-03 22:57:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ Fixed changefileexit for long (>255) filenames

Browse Source
This commit is contained in:
michael 2002-10-12 15:34:09 +00:00
parent cb7dee6850
commit 9f019c3c85
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/objpas/fina.inc
View File

@ -24,10 +24,12 @@
function ChangeFileExt(const FileName, Extension: string): string; function ChangeFileExt(const FileName, Extension: string): string;
var i: longint; var i: longint;
begin begin
I := Length(FileName); I := Length(FileName);
while (I > 0) and not(FileName[I] in ['/', '.', '\', ':']) do Dec(I); while (I > 0) and not(FileName[I] in ['/', '.', '\', ':']) do
if (I = 0) or (FileName[I] <> '.') then I := 255; Dec(I);
Result := Copy(FileName, 1, I - 1) + Extension; if (I = 0) or (FileName[I] <> '.') then
I := Length(FileName)+1;
Result := Copy(FileName, 1, I - 1) + Extension;
end; end;
function ExtractFilePath(const FileName: string): string; function ExtractFilePath(const FileName: string): string;
@ -188,7 +190,10 @@ end;
{ {
$Log$ $Log$
Revision 1.6 2002-09-07 16:01:22 peter Revision 1.7 2002-10-12 15:34:09 michael
+ Fixed changefileexit for long (>255) filenames
Revision 1.6 2002/09/07 16:01:22 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
} }