home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / LOG_01 / IOLOG.PAS next >
Pascal/Delphi Source File  |  1988-10-05  |  4KB  |  158 lines
  1. Unit IoLog ;
  2.  
  3. {
  4. Logs all output to a log file
  5.  
  6. Edition history
  7. 28-08-88 22:00  2  2  LSD/HL Started this file
  8.                              can log simple outputs and gotoxy and ClrScr
  9. 10-05-88 10:00  1  3  LSD/HL Placed in ShareWare
  10.  
  11.  
  12.  
  13. WARNING !  This unit is still under work and is released on as-is basis.
  14. If there's anything wrong with it, that's your problem.  You don't have
  15. to use it.
  16.  
  17.  
  18.  
  19. This unit declares, opens and closes a file IOLOG.LOG.  It copies all output
  20. from the program to this file, and some of the other screen routines like
  21. clrscr and gotoxy
  22.  
  23. This unit is designed for debug and documentation phase only.  It is not
  24. intended to be left in a finished product.  Buy why not, if you find some
  25. use for that.
  26.  
  27. This unit is [ should be ] totally transparent to the program using it.
  28.  
  29.  
  30. Known problems and limitations
  31. ==============================
  32.  
  33. - If the program does not use Crt, its output can be redirected in dos where
  34.   ever wanted.  This feature gets disabled because this unit uses Crt. But if
  35.   you want to redirect your output, you can still assign output to '', but
  36.   then this unit won't catch the output.  [ This might be repaired in a later
  37.   version ]
  38.  
  39. - All output functions ( like gotoxy ) are logged only if every unit of the
  40.   target program uses IOLOG.  All text is logged anyway, but not the specials.
  41.  
  42. - Not all Crt's function logged (yet)
  43.  
  44.  
  45.  
  46. (c) Copyright 1988  LSD - Levanto Software Development, Aarhus, Denmark
  47.  
  48. You may use this unit in your own programs free of charge.  If you use it
  49. programs you sell or otherwise make business with it, you are kindly asked to
  50. send some money, or at least a post card to
  51.  
  52. LSD - Levanto Software Development
  53. Rydevaenget 35,2,th
  54. DK 8210 Aarhus V
  55. Denmark
  56.  
  57. + 45 6 156270    2:505/22.28
  58.  
  59.  
  60. }
  61.  
  62. INTERFACE
  63.  
  64. Uses
  65.   Crt,
  66.   Dos ;
  67.  
  68.  
  69. Procedure GotoXy ( x,y : integer );
  70. Procedure ClrScr ;
  71.  
  72.  
  73.  
  74. IMPLEMENTATION
  75.  
  76.  
  77. var
  78.   LogFile     : text ;
  79.   ExitSave    : pointer ;
  80.   OldFlushPtr : pointer ;
  81.  
  82.  
  83. { ---------------- Logging other output-related functions --------------- }
  84.  
  85. Procedure GotoXy ( x,y : integer );
  86.   begin
  87.     writeln ( logfile, 'Gotoxy ( ',x,', ',y,' );' );
  88.     Crt.gotoxy ( x,y );
  89.     end ; { GotoXy }
  90.  
  91. Procedure ClrScr ;
  92.   begin
  93.     writeln ( logfile, 'ClrScr ;' );
  94.     crt. ClrScr ;
  95.     end ; { ClrScr }
  96.  
  97.  
  98. { ----------------- Handling the actual output ----------------------- }
  99.  
  100. Function CallOldPtr ( var F : TextRec ) : integer ;
  101.   inline ( $FF/$1E/OldFlushPtr );
  102.  
  103. {$F+} Function Flushproc ( var F : TextRec ) : integer ; {$F-}
  104.   var p : integer ;
  105.   begin
  106.     with TextRec(F) do begin
  107.       if ( BufPos > 2 ) and
  108.          ( BufPtr^ [BufPos-1] = #10 ) and
  109.          ( BufPtr^ [BufPos-2] = #13 )
  110.         then begin
  111.           write ( logfile, 'writeln ( ''' );
  112.           for p := 0 to BufPos-3 do
  113.             write ( logfile, BufPtr^[p] );
  114.             writeln ( logfile, ''' );' );
  115.           end
  116.         else begin
  117.          if ( BufPtr^ [0] = #13 ) and
  118.             ( BufPtr^ [1] = #10 )
  119.           then writeln ( logfile, 'writeln ;' )
  120.           else begin
  121.             write ( logfile, 'write ( ''' );
  122.             for p := 0 to BufPos-1 do
  123.               write ( logfile, BufPtr^[p] );
  124.               writeln ( logfile, ''' );' );
  125.             end ; { really write }
  126.           end ; { simple write }
  127.       end ; { with }
  128.     FlushProc := CallOldPtr ( F );
  129.     end ; { FlushProc }
  130.  
  131. { ------------------------- Entry and exit codes ----------------------- }
  132.  
  133. {$F+} Procedure ExitRoutine ; {$F-}
  134.   begin
  135.     TextRec ( Output ) .FlushFunc := OldFlushPtr ;
  136.     close ( logfile );
  137.     ExitProc := ExitSave ;
  138.     writeln ( 'IOLOG:  All output is captured in IOLOG.LOG ');
  139.     end ; { ExitRoutine }
  140.  
  141.  
  142. begin  { entry section of IOLOG }
  143.  
  144.   assign ( logfile, 'IOLOG.LOG' );
  145.   rewrite ( logfile );
  146.  
  147.   with TextRec ( Output ) do begin
  148.     OldFlushPtr := FlushFunc ;
  149.     FlushFunc   := @ FlushProc ;
  150.     end ; { with }
  151.  
  152.   ExitSave := ExitProc ;
  153.   ExitProc := @ ExitRoutine ;
  154.   end .
  155.  
  156.  
  157.  
  158.