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

amiga: call InternalFindClose in InternalFindFirst, if finding the first file fails

Browse Source 
git-svn-id: trunk@36505 -
This commit is contained in:
Károly Balogh 2017-06-15 12:51:06 +00:00
parent f6af4ab25f
commit c1187a17cd
1 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rtl/amicommon/sysutils.pp
View File

@ -432,17 +432,25 @@ begin
new(Anchor); new(Anchor);
FillChar(Anchor^,sizeof(TAnchorPath),#0); FillChar(Anchor^,sizeof(TAnchorPath),#0);
if MatchFirst(pchar(tmpStr),Anchor)<>0 then exit;
Rslt.FindHandle := Anchor; Rslt.FindHandle := Anchor;
if MatchFirst(pchar(tmpStr),Anchor)<>0 then
begin
InternalFindClose(Rslt.FindHandle);
exit;
end;
with Anchor^.ap_Info do begin with Anchor^.ap_Info do begin
Name := fib_FileName; Name := fib_FileName;
SetCodePage(Name,DefaultFileSystemCodePage,false); SetCodePage(Name,DefaultFileSystemCodePage,false);
Rslt.Size := fib_Size; Rslt.Size := fib_Size;
Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate)); Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
if not validDate then exit; if not validDate then
begin
InternalFindClose(Rslt.FindHandle);
exit;
end;
{ "128" is Windows "NORMALFILE" attribute. Some buggy code depend on this... :( (KB) } { "128" is Windows "NORMALFILE" attribute. Some buggy code depend on this... :( (KB) }
Rslt.Attr := 128; Rslt.Attr := 128;
@ -487,10 +495,10 @@ end;
Procedure InternalFindClose(var Handle: Pointer); Procedure InternalFindClose(var Handle: Pointer);
var var
Anchor: PAnchorPath; Anchor: PAnchorPath absolute Handle;
begin begin
Anchor:=PAnchorPath(Handle); if not assigned(Anchor) then
if not assigned(Anchor) then exit; exit;
MatchEnd(Anchor); MatchEnd(Anchor);
Dispose(Anchor); Dispose(Anchor);
Handle:=nil; Handle:=nil;