RBBS in a Box Volume 1 #3.1/RBBSIABOX31.cdr/scrg/safhlt.pas

Pascal/Delphi Source File | 1990-09-29 | 5.4 KB | 190 lines

(*[72457,2131]
SAFHLT.PAS                27-Mar-86 5220               99

    Keywords: PCDOS MSDOS FILE ERROR SAFE HALT HANDLER HANDLE

    Demonstrates some routines to keep a list of open files in a Turbo program.
    This list can be used by an error handler in order to close all open files
    before halting.
*)

{
 a set of routines which keep track of all text files open at a given
 point in program execution. This allows an error handler to close
 all open files so that the Turbo internal text buffers are flushed.

 written 2/86. Kim Kokkonen.
 Compuserve 72457,2131.
}

PROGRAM TestSafeHalt;

  {the following or a similar version should be included into your application}
  {***************************************************************************}

CONST
  TextBufferSize = 512;
TYPE
  TextFile = Text[TextBufferSize];
  TextFilePtr = ^TextFile;
  TextListPtr = ^TextListRec;
  TextListRec = RECORD
                  fptr : TextFilePtr;
                  handle : Integer; {for consistency check only}
                  next : TextListPtr;
                END;
  TextOpenMode = (tReset, tRewrite);
  TextPathname = STRING[63];
  TextFIB = RECORD
              handle : Integer;
              flags : Byte;
              charbuff : Char;
              bufofs : Integer;
              bufsize : Integer;
              bufpos : Integer;
              bufend : Integer;
              path : ARRAY[1..64] OF Char;
            END;
VAR
  TextList : TextListPtr;

  PROCEDURE InitializeTextList;
  BEGIN
    TextList := NIL;
  END {initializetextlist} ;

  PROCEDURE OpenTextFile(VAR f : TextFile;
                         path : TextPathname;
                         OpenMode : TextOpenMode;
                         VAR Result : Integer);
    {-shell around Assign/Reset/Rewrite to allow protected halts}
  VAR
    temp : TextListPtr;
    fib : TextFIB ABSOLUTE f;
  BEGIN
    Assign(f, path);
    {$I-}
    CASE OpenMode OF
      tReset : Reset(f);
      tRewrite : Rewrite(f);
    END;
    {$I+}
    Result := IOResult;
    IF Result <> 0 THEN Exit;
    {add the file to the list of open files}
    temp := TextList;
    New(TextList);
    WITH TextList^ DO BEGIN
      fptr := Ptr(Seg(f), Ofs(f));
      handle := fib.handle;
      next := temp;
    END;
  END {opentextfile} ;

  PROCEDURE CloseTextFile(VAR f : TextFile;
                          VAR Result : Integer);
    {-shell around Close to allow protected halts}
  VAR
    prevfile, curfile : TextListPtr;
    foundit : Boolean;
  BEGIN
    {$I-}
    Close(f);
    {$I+}
    Result := IOResult;
    IF Result <> 0 THEN Exit;
    {remove the record from the text file list}
    foundit := False;
    curfile := TextList;
    prevfile := NIL;
    WHILE NOT(foundit) AND (curfile <> NIL) DO BEGIN
      foundit := (curfile^.fptr = Ptr(Seg(f), Ofs(f)));
      IF foundit THEN BEGIN
        IF prevfile = NIL THEN
          {file was first in the list}
          TextList := curfile^.next
        ELSE
          {file is in middle of list}
          prevfile^.next := curfile^.next;
        Dispose(curfile);
      END ELSE BEGIN
        prevfile := curfile;
        curfile := curfile^.next;
      END;
    END;
    IF NOT(foundit) THEN
      WriteLn('PROGRAM ERROR: closed file not found in text file list....');
  END {closetextfile} ;

  PROCEDURE FlushAllTextFiles;
    {-call from a shutdown procedure to flush Turbo's text buffers}
  VAR
    curfile : TextListPtr;
    fib : TextFIB;
    i : Byte;
  BEGIN
    curfile := TextList;
    WHILE curfile <> NIL DO BEGIN
      {consistency check - make sure handle matches what it was opened to}
      Move(curfile^.fptr^, fib, SizeOf(TextFIB));
      WITH fib DO
        IF handle <> curfile^.handle THEN BEGIN
          WriteLn('PROGRAM ERROR: file and list handles do not match');
          Write('filename: ');
          i := 1;
          WHILE path[i] <> #0 DO BEGIN
            Write(path[i]);
            i := Succ(i);
          END;
          WriteLn;
        END;
      {close the file, this automatically flushes it}
      {at this point, error checking the close is superfluous}
      {$I-}
      Close(curfile^.fptr^);
      {$I+}
      curfile := curfile^.next;
    END;
  END {flushalltextfiles} ;

  PROCEDURE SafeHalt(ReturnCode : Integer);
    {-call instead of Turbo's Halt procedure to really clean up at halt time}
  BEGIN
    {assure Turbo's text buffers are clean}
    {DOS will close all typed and untyped files, which Turbo doesn't buffer}
    FlushAllTextFiles;
    {restore trapped interrupts, if any - here}
    {let Turbo restore its own interrupts and return the return code}
    Halt(ReturnCode);
  END {safehalt} ;


  {*********half-hearted demonstration follows********************}

VAR
  f1, f2, f3 : TextFile;
  Result : Integer;

  PROCEDURE WriteGarbage(VAR f : TextFile);
  VAR
    i : Integer;
  BEGIN
    FOR i := 1 TO 20 DO
      WriteLn(f, i, ' garbage ', i);
  END {writegarbage} ;

BEGIN
  InitializeTextList;
  OpenTextFile(f1, 'tmp1.tmp', tRewrite, Result);
  OpenTextFile(f2, 'tmp2.tmp', tRewrite, Result);
  OpenTextFile(f3, 'tmp3.tmp', tRewrite, Result);
  WriteGarbage(f1);
  WriteGarbage(f2);
  WriteGarbage(f3);
  CloseTextFile(f1, Result);
  CloseTextFile(f3, Result);
  {safehalt gets all text into TMP2.TMP}
  {if not called, TMP2.TMP will be an empty file}
  SafeHalt(0);
END.