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

Daniel change removed : broke make cycle !!

Browse Source
This commit is contained in:
pierre 1999-01-22 15:44:59 +00:00
parent ab763cd69c
commit 76375f02f8
1 changed files with 1068 additions and 1069 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
rtl/go32v2/dos.pp
View File

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