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

* more cleanup in FindFirst/FindNext

Browse Source 
* implemented FindClose, no more leaking of file locks
This commit is contained in:
Károly Balogh 2004-12-07 13:35:53 +00:00
parent 8eb794231c
commit 3310421621
1 changed files with 94 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

213
rtl/morphos/dos.pp
View File

@ -580,129 +580,104 @@ Begin
end; end;
Procedure FindFirst(const Path: PathStr; Attr: Word; Var f: SearchRec); procedure FindFirst(const Path: PathStr; Attr: Word; Var f: SearchRec);
var var
tmpStr: Array[0..255] of char; tmpStr: array[0..255] of Char;
Anchor: pAnchorPath; Anchor: PAnchorPath;
Result: Longint; Result: LongInt;
index : Integer; begin
s : string; tmpStr:=PathConv(path)+#0;
j : integer; DosError:=0;
Begin
tmpStr:=PathConv(path)+#0;
DosError:=0;
New(Anchor); new(Anchor);
FillChar(Anchor^,sizeof(TAnchorPath),#0); FillChar(Anchor^,sizeof(TAnchorPath),#0);
Result:=MatchFirst(@tmpStr,Anchor); Result:=MatchFirst(@tmpStr,Anchor);
f.AnchorPtr:=Anchor; f.AnchorPtr:=Anchor;
if Result = ERROR_NO_MORE_ENTRIES then if Result = ERROR_NO_MORE_ENTRIES then
DosError:=18 DosError:=18
else else
if Result <> 0 then if Result<>0 then DosError:=3;
DosError:=3;
{ If there is an error, deallocate }
{ the anchorpath structure }
if DosError <> 0 then
Begin
MatchEnd(Anchor);
if assigned(Anchor) then
Dispose(Anchor);
end
else
{-------------------------------------------------------------------}
{ Here we fill up the SearchRec attribute, but we also do check }
{ something else, if the it does not match the mask we are looking }
{ for we should go to the next file or directory. }
{-------------------------------------------------------------------}
begin
with Anchor^.ap_Info do
Begin
f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
fib_Date.ds_Minute * 60 +
fib_Date.ds_Tick div 50;
{*------------------------------------*}
{* Determine if is a file or a folder *}
{*------------------------------------*}
if fib_DirEntryType > 0 then
f.attr:=f.attr OR DIRECTORY;
{*------------------------------------*} if DosError=0 then begin
{* Determine if Read only *} {-------------------------------------------------------------------}
{* Readonly if R flag on and W flag *} { Here we fill up the SearchRec attribute, but we also do check }
{* off. *} { something else, if the it does not match the mask we are looking }
{* Should we check also that EXEC *} { for we should go to the next file or directory. }
{* is zero? for read only? *} {-------------------------------------------------------------------}
{*------------------------------------*} with Anchor^.ap_Info do begin
if ((fib_Protection and FIBF_READ) <> 0) f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
AND ((fib_Protection and FIBF_WRITE) = 0) fib_Date.ds_Minute * 60 +
then fib_Date.ds_Tick div 50;
f.attr:=f.attr or READONLY; {*------------------------------------*}
f.Name := strpas(fib_FileName); {* Determine if is a file or a folder *}
f.Size := fib_Size; {*------------------------------------*}
end; { end with } if fib_DirEntryType>0 then f.attr:=f.attr OR DIRECTORY;
end;
End; {*------------------------------------*}
{* Determine if Read only *}
{* Readonly if R flag on and W flag *}
{* off. *}
{* Should we check also that EXEC *}
{* is zero? for read only? *}
{*------------------------------------*}
if ((fib_Protection and FIBF_READ) <> 0) and
((fib_Protection and FIBF_WRITE) = 0) then f.attr:=f.attr or READONLY;
f.Name := strpas(fib_FileName);
f.Size := fib_Size;
end; { end with }
end;
end;
Procedure FindNext(Var f: SearchRec); procedure FindNext(Var f: SearchRec);
var var
Result: longint; Result: longint;
Anchor : pAnchorPath; Anchor: PAnchorPath;
Begin begin
DosError:=0; DosError:=0;
Result:=MatchNext(f.AnchorPtr); Result:=MatchNext(f.AnchorPtr);
if Result = ERROR_NO_MORE_ENTRIES then if Result = ERROR_NO_MORE_ENTRIES then
DosError:=18 DosError:=18
else else
if Result <> 0 then if Result <> 0 then DosError:=3;
DosError:=3;
{ If there is an error, deallocate }
{ the anchorpath structure }
if DosError <> 0 then
Begin
MatchEnd(f.AnchorPtr);
if assigned(f.AnchorPtr) then
{Dispose}FreeMem(f.AnchorPtr);
end
else
{ Fill up the Searchrec information }
{ and also check if the files are with }
{ the correct attributes }
Begin
Anchor:=pAnchorPath(f.AnchorPtr);
with Anchor^.ap_Info do
Begin
f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
fib_Date.ds_Minute * 60 +
fib_Date.ds_Tick div 50;
{*------------------------------------*}
{* Determine if is a file or a folder *}
{*------------------------------------*}
if fib_DirEntryType > 0 then
f.attr:=f.attr OR DIRECTORY;
{*------------------------------------*} if DosError=0 then begin
{* Determine if Read only *} { Fill up the Searchrec information }
{* Readonly if R flag on and W flag *} { and also check if the files are with }
{* off. *} { the correct attributes }
{* Should we check also that EXEC *} Anchor:=pAnchorPath(f.AnchorPtr);
{* is zero? for read only? *} with Anchor^.ap_Info do begin
{*------------------------------------*} f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
if ((fib_Protection and FIBF_READ) <> 0) fib_Date.ds_Minute * 60 +
AND ((fib_Protection and FIBF_WRITE) = 0) fib_Date.ds_Tick div 50;
then {*------------------------------------*}
f.attr:=f.attr or READONLY; {* Determine if is a file or a folder *}
f.Name := strpas(fib_FileName); {*------------------------------------*}
f.Size := fib_Size; if fib_DirEntryType > 0 then f.attr:=f.attr OR DIRECTORY;
end; { end with }
end; {*------------------------------------*}
End; {* Determine if Read only *}
{* Readonly if R flag on and W flag *}
{* off. *}
{* Should we check also that EXEC *}
{* is zero? for read only? *}
{*------------------------------------*}
if ((fib_Protection and FIBF_READ) <> 0) and
((fib_Protection and FIBF_WRITE) = 0) then f.attr:=f.attr or READONLY;
f.Name := strpas(fib_FileName);
f.Size := fib_Size;
end; { end with }
end;
end;
procedure FindClose(Var f: SearchRec);
begin
MatchEnd(f.AnchorPtr);
if assigned(f.AnchorPtr) then
Dispose(PAnchorPath(f.AnchorPtr));
end;
Procedure FindClose(Var f: SearchRec);
begin
end;
{****************************************************************************** {******************************************************************************
--- File --- --- File ---
@ -718,11 +693,7 @@ begin
{ No wildcards allowed in these things } { No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) or (path='') then if (pos('?',path)<>0) or (pos('*',path)<>0) or (path='') then
FSearch:='' FSearch:=''
else begin else begin
{ allow slash as backslash }
for counter:=1 to length(dirlist) do
if dirlist[counter]='\' then dirlist[counter]:='/';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then begin if p1<>0 then begin
@ -1032,7 +1003,11 @@ End.
{ {
$Log$ $Log$
Revision 1.12 2004-12-06 20:01:20 karoly Revision 1.13 2004-12-07 13:35:53 karoly
* more cleanup in FindFirst/FindNext
* implemented FindClose, no more leaking of file locks
Revision 1.12 2004/12/06 20:01:20 karoly
* made it compile again after changes by Tomas * made it compile again after changes by Tomas
* cleaned up FindFirst mess (still more things to do, as usual) * cleaned up FindFirst mess (still more things to do, as usual)