Category : Files from Magazines
Archive   : TSR.ZIP
Filename : STAYDEM.420

{----------------------------------------------------------------------------}
{ F I L E S U B R O U T I N E S }
{----------------------------------------------------------------------------}
type
Dir_Entry = record
Reserved : array[1..21] of byte;
Attribute: byte;
Time, Date, FileSizeLo, FileSizeHi : integer;
Name : string[13];
end;
var
RetCode : byte;
Filename : filename_type;
Buffer : Dir_Entry;

Trash : char;
attribyte : byte;
Xcursor : integer ;
Ycursor : integer ;

Procedure Disk_Trns_Addr(var Disk_Buf);
var segment,offset : integer;
Begin
segment := seg(Disk_buf);
offset := ofs(Disk_buf);
SetDTA(segment,offset);
end;
{----------------------------------------------------------------------------}
{ F I N D N E X T F I L E E N T R Y }
{----------------------------------------------------------------------------}
Procedure Find_Next(var Att:byte; var Filename : Filename_type;
var Next_RetCode : byte);
var
Registers : regtype;
Carry_flag : integer;
N : byte;

Begin {Find_Next}
Buffer.Name := ' '; { Clear result buffer }
with Registers do
begin
Ax := $4F shl 8; { Dos Find next function }
MsDos(Registers);
Att := Buffer.Attribute; { Set file attribute }
Carry_flag := 1 and Flags; { Isolate the Error flag }
Filename := ' ';
if Carry_flag = 1 then
Next_RetCode := Ax and $00FF
else
begin { Move file name }
Next_RetCode := 0;
for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
end;
end; {with}
end;
{----------------------------------------------------------------------------}
{ F I N D F I R S T F I L E F U N C T I O N }
{----------------------------------------------------------------------------}
Procedure Find_First (var Att: byte;
var Filename: Filename_type;
var RetCode_code : byte);

var
Registers :regtype;
Carry_flag :integer;
N : byte;

begin
Disk_Trns_Addr(Buffer); { Set DTA address }
Filename[length(Filename) + 1] := chr(0);
Buffer.Name := ' ';
with Registers do
begin
Ax := $4E shl 8; { Dos Find First Function }
Cx := Att; { Attribute of file to fine }
Ds := seg(Filename); { Ds:Dx Asciiz string to find }
Dx := ofs(Filename) + 1;
MsDos(Registers);
Att := Buffer.Attribute; { set the file attribute byte }

{ If error occured set, Return code. }

Carry_flag := 1 and Flags; { If Carry flag, error occured }
{ and Ax will contain Return code }
if Carry_flag = 1 then
begin
RetCode_code := Ax and $00FF;
end

else
begin
RetCode_code := 0;
Filename := ' ';
for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
end;

end; {with}
end;
{----------------------------------------------------------------------}
{ G E T F I L E }
{----------------------------------------------------------------------}
Procedure Get_file;
begin

filename := '*.*' ;
attribyte := 255 ;

Xcursor := 2 ;
Ycursor := 1 ;
GotoXy(Xcursor,Ycursor) ;

Find_First(attribyte,filename,Retcode);
If Retcode = 0 then
begin
write(Filename);
Ycursor := Ycursor +1 ;
end;
{Now we repeat Find_Next until an error occurs }

repeat
Find_Next(attribyte,filename,Retcode);
if Retcode = 0 then
begin
GotoXY(Xcursor,Ycursor);
Write(filename) ;
Ycursor := Ycursor + 1 ;

if WhereY >= 14 then
begin
Xcursor := Xcursor + 16 ;
Ycursor := 1 ;
end;

if (Xcursor >= 50) and (Ycursor = 13 ) then
begin
Ycursor := Ycursor + 1;
GotoXY(Xcursor,Ycursor);

Get_Abs_Cursor(x,y); { Box up More msg..}
MkWin(x,y,x+10,y+1,Cyan,black,0); Gotoxy(1,1);
Write (' More...');

While (Not Keypressed) do;
Read(Kbd,trash) ;
RmWin; { Remove "More" window }

clrscr ;
Xcursor := 2 ;
Ycursor := 1 ;
end;
end;
until Retcode <> 0;
{ Make a little Window and hold for }
{ user to give us a goose..or whatever}
GotoXY(Xcursor,Ycursor);
Get_Abs_Cursor(x,y); { Get Absolute Cursor Position }
MkWin(x,y,x+16,y+1,Cyan,Black,0); { Put Window at Cursor }
GotoXY(1,1);
Write('Press a key ...');

While (Not Keypressed) do; { Pause until Key pressed }
KeyChr := Keyin; { Read the users Key }
RmWin ; { Remove the Window }
If KeyChr = Quit_Key then { If Terminate Key then }
Terminate := true ; { remove ourself from Memory }
end;

{----------------------------------------------------------------------}
{ D E M O }
{----------------------------------------------------------------------}
Procedure Demo ; { Give Demonstration of Code }

begin
KeyChr := #0; { Clear any residual krap }
MkWin(5,5,75,20,Bright+Cyan,Black,3); { Make a Biiiiiiig window}
Clrscr; { Clear screen out }
Get_file; { Show directory entries }
RmWin; { Remove the big window }
end; { Demo }