home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / MISC.ZIP / SAFEHALT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-02  |  4.7 KB  |  168 lines
  1. PROGRAM TestSafeHalt;
  2.  
  3.   {the following or a similar version should be included into an application}
  4.  
  5. CONST
  6.   TextBufferSize = 512;
  7. TYPE
  8.   TextFile = Text[TextBufferSize];
  9.   TextFilePtr = ^TextFile;
  10.   TextListPtr = ^TextListRec;
  11.   TextListRec = RECORD
  12.                   fptr : TextFilePtr;
  13.                   handle : Integer; {for consistency check only}
  14.                   next : TextListPtr;
  15.                 END;
  16.   TextOpenMode = (tReset, tRewrite);
  17.   TextPathname = STRING[63];
  18.   TextFIB = RECORD
  19.               handle : Integer;
  20.               flags : Byte;
  21.               charbuff : Char;
  22.               bufofs : Integer;
  23.               bufsize : Integer;
  24.               bufpos : Integer;
  25.               bufend : Integer;
  26.               path : ARRAY[1..64] OF Char;
  27.             END;
  28. VAR
  29.   TextList : TextListPtr;
  30.  
  31.   PROCEDURE InitializeTextList;
  32.   BEGIN
  33.     TextList := NIL;
  34.   END {initializetextlist} ;
  35.  
  36.   PROCEDURE OpenTextFile(VAR f : TextFile;
  37.                          path : TextPathname;
  38.                          OpenMode : TextOpenMode;
  39.                          VAR Result : Integer);
  40.     {-shell around Assign/Reset/Rewrite to allow protected halts}
  41.   VAR
  42.     temp : TextListPtr;
  43.     fib : TextFIB ABSOLUTE f;
  44.   BEGIN
  45.     Assign(f, path);
  46.     {$I-}
  47.     CASE OpenMode OF
  48.       tReset : Reset(f);
  49.       tRewrite : Rewrite(f);
  50.     END;
  51.     {$I+}
  52.     Result := IOResult;
  53.     IF Result <> 0 THEN Exit;
  54.     {add the file to the list of open files}
  55.     temp := TextList;
  56.     New(TextList);
  57.     WITH TextList^ DO BEGIN
  58.       fptr := Ptr(Seg(f), Ofs(f));
  59.       handle := fib.handle;
  60.       next := temp;
  61.     END;
  62.   END {opentextfile} ;
  63.  
  64.   PROCEDURE CloseTextFile(VAR f : TextFile;
  65.                           VAR Result : Integer);
  66.     {-shell around Close to allow protected halts}
  67.   VAR
  68.     prevfile, curfile : TextListPtr;
  69.     foundit : Boolean;
  70.   BEGIN
  71.     {$I-}
  72.     Close(f);
  73.     {$I+}
  74.     Result := IOResult;
  75.     IF Result <> 0 THEN Exit;
  76.     {remove the record from the text file list}
  77.     foundit := False;
  78.     curfile := TextList;
  79.     prevfile := NIL;
  80.     WHILE NOT(foundit) AND (curfile <> NIL) DO BEGIN
  81.       foundit := (curfile^.fptr = Ptr(Seg(f), Ofs(f)));
  82.       IF foundit THEN BEGIN
  83.         IF prevfile = NIL THEN
  84.           {file was first in the list}
  85.           TextList := curfile^.next
  86.         ELSE
  87.           {file is in middle of list}
  88.           prevfile^.next := curfile^.next;
  89.         Dispose(curfile);
  90.       END ELSE BEGIN
  91.         prevfile := curfile;
  92.         curfile := curfile^.next;
  93.       END;
  94.     END;
  95.     IF NOT(foundit) THEN
  96.       WriteLn('PROGRAM ERROR: closed file not found in text file list....');
  97.   END {closetextfile} ;
  98.  
  99.   PROCEDURE FlushAllTextFiles;
  100.     {-call from a shutdown procedure to flush Turbo's text buffers}
  101.   VAR
  102.     curfile : TextListPtr;
  103.     fib : TextFIB;
  104.     i : Byte;
  105.   BEGIN
  106.     curfile := TextList;
  107.     WHILE curfile <> NIL DO BEGIN
  108.       {consistency check - make sure handle matches what it was opened to}
  109.       Move(curfile^.fptr^, fib, SizeOf(TextFIB));
  110.       WITH fib DO
  111.         IF handle <> curfile^.handle THEN BEGIN
  112.           WriteLn('PROGRAM ERROR: file and list handles do not match');
  113.           Write('filename: ');
  114.           i := 1;
  115.           WHILE path[i] <> #0 DO BEGIN
  116.             Write(path[i]);
  117.             i := Succ(i);
  118.           END;
  119.           WriteLn;
  120.         END;
  121.       {close the file, this automatically flushes it}
  122.       {at this point, error checking the close is superfluous}
  123.       Close(curfile^.fptr^);
  124.       curfile := curfile^.next;
  125.     END;
  126.   END {flushalltextfiles} ;
  127.  
  128.   PROCEDURE SafeHalt(ReturnCode : Integer);
  129.     {-call instead of Turbo's Halt procedure to really clean up at halt time}
  130.   BEGIN
  131.     {assure Turbo's text buffers are clean}
  132.     {DOS will close all typed and untyped files, which Turbo doesn't buffer}
  133.     FlushAllTextFiles;
  134.     {restore trapped interrupts, if any}
  135.     {let Turbo restore its own interrupts and return the return code}
  136.     Halt(ReturnCode);
  137.   END {safehalt} ;
  138.  
  139.  
  140.   {*********half-hearted demonstration follows********************}
  141.  
  142. VAR
  143.   f1, f2, f3 : TextFile;
  144.   Result : Integer;
  145.  
  146.   PROCEDURE WriteGarbage(VAR f : TextFile);
  147.   VAR
  148.     i : Integer;
  149.   BEGIN
  150.     FOR i := 1 TO 20 DO
  151.       WriteLn(f, i, ' garbage ', i);
  152.   END {writegarbage} ;
  153.  
  154. BEGIN
  155.   InitializeTextList;
  156.   OpenTextFile(f1, 'tmp1.tmp', tRewrite, Result);
  157.   OpenTextFile(f2, 'tmp2.tmp', tRewrite, Result);
  158.   OpenTextFile(f3, 'tmp3.tmp', tRewrite, Result);
  159.   WriteGarbage(f1);
  160.   WriteGarbage(f2);
  161.   WriteGarbage(f3);
  162.   CloseTextFile(f1, Result);
  163.   CloseTextFile(f3, Result);
  164.   {safehalt gets all text into TMP2.TMP}
  165.   {if not called, TMP2.TMP will be an empty file}
  166.   SafeHalt(0);
  167. END.
  168.