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

- Findclose removed: This is TP incompatible!!

Browse Source
This commit is contained in:
daniel 1999-01-22 10:07:02 +00:00
parent 4517f917fd
commit 5dd4f9f422
2 changed files with 1932 additions and 1927 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rtl/go32v1/dos.pp
View File

@ -109,7 +109,6 @@ Function DiskFree(drive: byte) : longint;
Function DiskSize(drive: byte) : longint;
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
Procedure FindNext(var f: searchRec);
Procedure FindClose(Var f: SearchRec);
{File}
Procedure GetFAttr(var f; var attr: word);
@ -482,12 +481,6 @@ begin
end;
Procedure FindClose(Var f: SearchRec);
begin
DosError:=0;
end;
procedure swapvectors;
begin
DosError:=0;
@ -791,7 +784,10 @@ End;
end.
{
$Log$
Revision 1.1 1998-12-21 13:07:02 peter
Revision 1.2 1999-01-22 10:07:02 daniel
- Findclose removed: This is TP incompatible!!
Revision 1.1 1998/12/21 13:07:02 peter
* use -FE
Revision 1.19 1998/11/23 13:53:59 peter

81
rtl/go32v2/dos.pp
View File

@ -106,7 +106,6 @@ Function DiskFree(drive: byte) : longint;
Function DiskSize(drive: byte) : longint;
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
Procedure FindNext(var f: searchRec);
Procedure FindClose(Var f: SearchRec);
{File}
Procedure GetFAttr(var f; var attr: word);
@ -145,8 +144,8 @@ uses
--- Dos Interrupt ---
******************************************************************************}
var
dosregs : registers;
var dosregs:registers;
oldexitproc:pointer;
procedure LoadDosError;
begin
@ -468,7 +467,9 @@ type
shortname : array[0..13] of byte;
end;
procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec);
const LFNfindhandle:word=$ffff;
procedure LFNSearchRec2Dos(const w:LFNSearchRec;var d:Searchrec);
var
Len : longint;
begin
@ -484,23 +485,34 @@ begin
d.Time:=lmTime;
d.Size:=Size;
d.Attr:=Attr and $FF;
Move(hdl,d.Fill,4);
end;
end;
procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
var
i : longint;
w : LFNSearchRec;
var i:longint;
w:LFNSearchRec;
begin
if LFNfindhandle<>$ffff then
begin
dosregs.bx:=LFNfindhandle;
dosregs.ax:=$71a1;
msdos(dosregs);
LoadDosError;
end;
if doserror=0 then
begin
{ allow slash as backslash }
for i:=0 to strlen(path) do
if path[i]='/' then path[i]:='\';
if path[i]='/' then
path[i]:='\';
dosregs.si:=1; { use ms-dos time }
dosregs.ecx:=attr;
dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,
strlen(path)+1);
dosregs.ds:=tb_segment;
dosregs.edi:=tb_offset;
dosregs.es:=tb_segment;
@ -508,39 +520,27 @@ begin
msdos(dosregs);
LoadDosError;
copyfromdos(w,sizeof(LFNSearchRec));
LFNSearchRec2Dos(w,dosregs.ax,s);
LFNSearchRec2Dos(w,s);
LFNfindhandle:=dosregs.ax
end;
end;
procedure LFNFindNext(var s:searchrec);
var
hdl : longint;
w : LFNSearchRec;
begin
Move(s.Fill,hdl,4);
dosregs.si:=1; { use ms-dos time }
dosregs.edi:=tb_offset;
dosregs.es:=tb_segment;
dosregs.ebx:=hdl;
dosregs.bx:=LFNfindhandle;
dosregs.ax:=$714f;
msdos(dosregs);
LoadDosError;
copyfromdos(w,sizeof(LFNSearchRec));
LFNSearchRec2Dos(w,hdl,s);
LFNSearchRec2Dos(w,s);
end;
procedure LFNFindClose(var s:searchrec);
var
hdl : longint;
begin
Move(s.Fill,hdl,4);
dosregs.ebx:=hdl;
dosregs.ax:=$71a1;
msdos(dosregs);
LoadDosError;
end;
{******************************************************************************
--- DosFindfirst DosFindNext ---
@ -622,14 +622,6 @@ begin
end;
Procedure FindClose(Var f: SearchRec);
begin
DosError:=0;
if LFNSupport then
LFNFindClose(f);
end;
{$ASMMODE DIRECT}
procedure swapvectors;
begin
@ -982,11 +974,28 @@ Procedure setintvec(intno : byte;vector : pointer);
Begin
End;
procedure exithandler;
begin
exitproc:=oldexitproc;
if LFNfindhandle<>$ffff then
begin
dosregs.bx:=LFNfindhandle;
dosregs.ax:=$71a1;
msdos(dosregs);
end;
end;
begin
oldexitproc:=exitproc;
exitproc:=@exithandler;
end.
{
$Log$
Revision 1.1 1998-12-21 13:07:02 peter
Revision 1.2 1999-01-22 10:07:03 daniel
- Findclose removed: This is TP incompatible!!
Revision 1.1 1998/12/21 13:07:02 peter
* use -FE
Revision 1.19 1998/11/23 13:53:59 peter