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

+ implemented dos.FindFirst/FindNext/FindClose for i8086-msdos

Browse Source 
git-svn-id: trunk@24691 -
This commit is contained in:
nickysn 2013-06-01 09:41:16 +00:00
parent 958c7a142b
commit 327628a6bd
1 changed files with 86 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
rtl/msdos/dos.pp
View File

@ -360,23 +360,82 @@ var
{$endif DEBUG_LFN} {$endif DEBUG_LFN}
procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec); procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
var
i : longint;
w : LFNSearchRec;
begin begin
{TODO: implement} { allow slash as backslash }
runerror(304); DoDirSeparators(path);
dosregs.si:=1; { use ms-dos time }
{ don't include the label if not asked for it, needed for network drives }
if attr=$8 then
dosregs.cx:=8
else
dosregs.cx:=attr and (not 8);
dosregs.dx:=Ofs(path^);
dosregs.ds:=Seg(path^);
dosregs.di:=Ofs(w);
dosregs.es:=Seg(w);
dosregs.ax:=$714e;
msdos(dosregs);
LoadDosError;
if DosError=2 then
DosError:=18;
{$ifdef DEBUG_LFN}
if (DosError=0) and LogLFN then
begin
Append(lfnfile);
inc(LFNOpenNb);
Writeln(lfnfile,LFNOpenNb,' LFNFindFirst called ',path);
close(lfnfile);
end;
{$endif DEBUG_LFN}
LFNSearchRec2Dos(w,dosregs.ax,s,true);
end; end;
procedure LFNFindNext(var s:searchrec); procedure LFNFindNext(var s:searchrec);
var
hdl : longint;
w : LFNSearchRec;
begin begin
{TODO: implement} Move(s.Fill,hdl,4);
runerror(304); dosregs.si:=1; { use ms-dos time }
dosregs.di:=Ofs(w);
dosregs.es:=Seg(w);
dosregs.bx:=hdl;
dosregs.ax:=$714f;
msdos(dosregs);
LoadDosError;
LFNSearchRec2Dos(w,hdl,s,false);
end; end;
procedure LFNFindClose(var s:searchrec); procedure LFNFindClose(var s:searchrec);
var
hdl : longint;
begin begin
{TODO: implement} Move(s.Fill,hdl,4);
runerror(304); { Do not call MsDos if FindFirst returned with an error }
if hdl=-1 then
begin
DosError:=0;
exit;
end;
dosregs.bx:=hdl;
dosregs.ax:=$71a1;
msdos(dosregs);
LoadDosError;
{$ifdef DEBUG_LFN}
if (DosError=0) and LogLFN then
begin
Append(lfnfile);
Writeln(lfnfile,LFNOpenNb,' LFNFindClose called ');
close(lfnfile);
if LFNOpenNb>0 then
dec(LFNOpenNb);
end;
{$endif DEBUG_LFN}
end; end;
@ -400,15 +459,32 @@ end;
procedure DosFindfirst(path : pchar;attr : word;var f : searchrec); procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
begin begin
{TODO: implement} { allow slash as backslash }
runerror(304); DoDirSeparators(path);
dosregs.dx:=Ofs(f);
dosregs.ds:=Seg(f);
dosregs.ah:=$1a;
msdos(dosregs);
dosregs.cx:=attr;
dosregs.dx:=Ofs(path^);
dosregs.ds:=Seg(path^);
dosregs.ah:=$4e;
msdos(dosregs);
LoadDosError;
dossearchrec2searchrec(f);
end; end;
procedure Dosfindnext(var f : searchrec); procedure Dosfindnext(var f : searchrec);
begin begin
{TODO: implement} dosregs.dx:=Ofs(f);
runerror(304); dosregs.ds:=Seg(f);
dosregs.ah:=$1a;
msdos(dosregs);
dosregs.ah:=$4f;
msdos(dosregs);
LoadDosError;
dossearchrec2searchrec(f);
end; end;