[Back to TSR SWAG index] [Back to Main SWAG index] [Original]

    ===========================================================================
     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)

[Back to TSR SWAG index] [Back to Main SWAG index] [Original]