===========================================================================
 BBS: Canada Remote Systems
Date: 06-23-93 (10:24)             Number: 27349
From: STEVE MULLIGAN               Refer#: NONE
  To: EDWARD WALKER                 Recvd: NO  
Subj: TSRS THAT WRITE TO DISK..      Conf: (1221) F-PASCAL
---------------------------------------------------------------------------
Tuesday June 22 1993 02:38, Edward Walker wrote to All:

 EW> What do I need to set up in the code to write to disk in a TSR?

Here's a TSR called BootRes.  It opens a file and writes to disk every x
seconds :

=-=-=-=-=-=-=-=-= PART 1 =-=-=-=-=-=-=-=-=-=
program BootRes;

{$M 2048,0,0}
{$F+}

Uses BootVars, Crt, Dos;

const
 OLDSTACKSS :  WORD = 0;
 OLDSTACKSP :  WORD = 0;
 STACKSW :    INTEGER = - 1;
 OurStackSeg : word = 0;
 OurStackSp  : word = 0;
 DosDelimSet : set of Char = ['\', ':', #0];

var
 R                    : registers;
 DosSeg, DosBusy              : word;
 Tick, WaitBuf               : integer;
 NeedPop                 : boolean;

PROCEDURE BEGINint;
INLINE($FF/$06/STACKSW/
   $75/$10/
   $8C/$16/OLDSTACKSS/
       $89/$26/OLDSTACKSP/
       $8E/$16/OURSTACKSEG/
       $8B/$26/OURSTACKSP);

PROCEDURE ENDint;
INLINE($FF/$0E/STACKSW/
       $7D/$08/
       $8E/$16/OLDSTACKSS/
   $8B/$26/OLDSTACKSP);

PROCEDURE CALLPOP(SUB:POINTER);
BEGIN
INLINE($FF/$5E/$06);
END;

PROCEDURE CLI; INLINE($FA);
PROCEDURE STI; INLINE($FB);

function Exist(fname : string) : boolean;
var
     f1  : file;  err : integer;
begin
     {$I-}
     assign(f1,fname);     reset(f1);     err := ioresult;
     {$I+}
     if  err = 0 then close(f1);     exist := err = 0;
end;

  function AddBackSlash(DirName : string) : string;
    {-Add a default backslash to a directory name}
  begin
    if DirName[Length(DirName)] in DosDelimSet then
      AddBackSlash := DirName
    else
      AddBackSlash := DirName+'\';
  end;

procedure TsrCrap;
begin
 CLI;
 BEGINint;
 STI;

 NeedPop := False;

 GetDate(h, m, s, hund);
 TimeLoad.Year := h;
 TimeLoad.Month := m;
 TimeLoad.Day := s;
 GetTime(h, m, s, hund);
 TimeLoad.Hour := h;
 TimeLoad.Min := m;
 TimeLoad.Sec := s;

 DoDate;
 DoDate2;

 if not exist(LogName) then begin
  assign(LogFile, LogName);
  rewrite(LogFile);
  write(LogFile, LogRec);
  close(LogFile);
 end;

 assign(LogFile, LogName);
 reset(LogFile);
 if FileSize(LogFile) = 0 then begin
  close(LogFile);
  assign(LogFile, LogName);
  rewrite(LogFile);
  write(LogFile, LogRec);
  close(LogFile);
  assign(LogFile, LogName);
  reset(LogFile);
 end;
 seek(LogFile, FileSize(LogFile) - 1);
 read(LogFile, LogRec);
 DoDate2;
 seek(LogFile, FileSize(LogFile) - 1);
 write(LogFile, LogRec);
 close(LogFile);
 Tick := 0;

 CLI;
 ENDint;
 STI;
end;
=-=-=-=-=-=-=-=-= PART 1 =-=-=-=-=-=-=-=-=-=

--- GoldED 2.41
 * Origin: Ask me about SubMove * Carp, Ontario (1:163/307.30)
===========================================================================
 BBS: Canada Remote Systems
Date: 06-23-93 (10:25)             Number: 27350
From: STEVE MULLIGAN               Refer#: NONE
  To: EDWARD WALKER                 Recvd: NO  
Subj: TSRS THAT WRITE TO DISK..      Conf: (1221) F-PASCAL
---------------------------------------------------------------------------
=-=-=-=-=-=-=-=-= PART 2 =-=-=-=-=-=-=-=-=-=
procedure RunTSR; Interrupt;
begin
 CLI;
 BEGINint;
 STI;
 inc(Tick);
 if Tick > 18.2 * WaitBuf then begin
  NeedPop := True;
  if MEM[DosSeg:DosBusy] = 0 then begin
   NeedPop := False;
   PORT[$20] := $20;
   TsrCrap;
  end;
 end;
 CLI;
 ENDint;
 STI;
end;

procedure Int28TSR; Interrupt;
begin
 CLI;
 BEGINint;
 STI;
 if NeedPop = True then TsrCrap;
 CLI;
 ENDint;
 STI;
end;

procedure InitTSR;
begin
 OurStackSeg := SSEG;
 InLine($89/$26/OurStackSp);
 R.Ah := $34;
 MSDOS(R);
 DosSeg := R.ES;
 DosBusy := R.BX;
end;

procedure ShowHelp;
begin
 writeln('Usage : BOOTRES <command line options>');
 writeln;
 writeln('Valid Options : #    Number of seconds to wait before writing current
time');
 writeln('                /?   This screen');
end;

begin
 InitTSR;

 GetDir(0, LogName);
 LogName := AddBackSlash(LogName) + 'BOOTLOG.DAT';
 WaitBuf := 60;

 writeln;

 if ParamCount > 0 then begin
  if ParamStr(1) = '/?' then begin
   ShowHelp;
   halt(0);
  end;
  val(ParamStr(1), WaitBuf, Tick);
  if (Tick <> 0) or ((WaitBuf > 60 * 10) or (WaitBuf < 5)) then begin
   writeln('Must be an integer between 5 and ', 60 * 10);
   halt(1);
  end;
 end else begin
  writeln('Type BOOTRES /? for help');
  writeln;
 end;

 Tick := 0;

 SetIntVec($28,@Int28TSR);
 SetIntVec($1C,@RunTSR);

 writeln('BootRes installed');

 keep(0);
end. =-=-=-=-=-=-=-=-= PART 2 =-=-=-=-=-=-=-=-=-=

--- GoldED 2.41
 * Origin: Ask me about VoteFix * Carp, Ontario (1:163/307.30)
===========================================================================
 BBS: Canada Remote Systems
Date: 06-23-93 (10:26)             Number: 27351
From: STEVE MULLIGAN               Refer#: NONE
  To: EDWARD WALKER                 Recvd: NO  
Subj: TSRS THAT WRITE TO DISK..      Conf: (1221) F-PASCAL
---------------------------------------------------------------------------
=-=-=-=-=-=-=-=-= PART 3 =-=-=-=-=-=-=-=-=-=
unit BootVars;

interface

uses Dos;

const
 Version  = '1.00';
 ProgName = 'BootLog';
        CopYear  = '1992 - 1993';

type
 LogType = record
  TimeLoad : DateTime;
  TimeOff : DateTime;
 end;

var
 LogFile    : file of LogType;
 LogRec    : LogType;
 h, m, s, hund  : word;
 TimeLoad, TimeOff : DateTime;
 LogName    : string;

procedure DoDate;
procedure DoDate2;

implementation

procedure DoDate;
begin
 LogRec.TimeLoad.Year  := TimeLoad.Year;
 LogRec.TimeLoad.Month := TimeLoad.Month;
 LogRec.TimeLoad.Day   := TimeLoad.Day;
 LogRec.TimeLoad.Hour  := TimeLoad.Hour;
 LogRec.TimeLoad.Min   := TimeLoad.Min;
 LogRec.TimeLoad.Sec   := TimeLoad.Sec;
end;

procedure DoDate2;
begin
 LogRec.TimeOff.Year   := TimeLoad.Year;
 LogRec.TimeOff.Month  := TimeLoad.Month;
 LogRec.TimeOff.Day    := TimeLoad.Day;
 LogRec.TimeOff.Hour   := TimeLoad.Hour;
 LogRec.TimeOff.Min    := TimeLoad.Min;
 LogRec.TimeOff.Sec    := TimeLoad.Sec;
end;

end.
=-=-=-=-=-=-=-=-= PART 3 =-=-=-=-=-=-=-=-=-=

--- GoldED 2.41
 * Origin: Ask me about SubMove * Carp, Ontario (1:163/307.30)