paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 11:28:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fsplit adapted to long filenames

Browse Source
This commit is contained in:
pierre 1998-10-22 15:32:38 +00:00
parent d2f078ce49
commit b0bc7490ef
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
rtl/win32/dos.pp
View File

@ -573,7 +573,7 @@ end;
procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr); procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
var var
p1,i : longint; dotpos,p1,i : longint;
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(path) do for i:=1 to length(path) do
@ -598,15 +598,20 @@ begin
delete(path,1,p1); delete(path,1,p1);
end; end;
{ try to find out a extension } { try to find out a extension }
p1:=pos('.',path); Ext:='';
if p1>0 then i:=Length(Path);
begin DotPos:=256;
ext:=copy(path,p1,4); While (i>0) Do
delete(path,p1,length(path)-p1+1); Begin
end If (Path[i]='.') Then
else begin
ext:=''; DotPos:=i;
name:=path; break;
end;
Dec(i);
end;
Ext:=Copy(Path,DotPos,255);
Name:=Copy(Path,1,DotPos - 1);
end; end;
@ -876,7 +881,10 @@ End;
end. end.
{ {
$Log$ $Log$
Revision 1.10 1998-10-16 14:20:06 peter Revision 1.11 1998-10-22 15:32:38 pierre
* fsplit adapted to long filenames
Revision 1.10 1998/10/16 14:20:06 peter
* removed writelns * removed writelns
Revision 1.9 1998/10/16 08:55:26 peter Revision 1.9 1998/10/16 08:55:26 peter