home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / LOG_01 / LOGFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-05  |  2KB  |  118 lines
  1.  
  2. Unit Logfile ;
  3.  
  4. {
  5.  
  6. Keeps a log file
  7.  
  8. Edition history:
  9. ----------------
  10.  
  11. 12-05-88 13:20 HL Copied this unit from GOdebug
  12. 25-05-88 16:00 HL Added a print in the start of debug file
  13. 05-10-88 10:00 HL Placed in ShareWare
  14.  
  15.  
  16. Problems, Errors, Bugs:
  17. -----------------------
  18.  
  19. What next:
  20. ----------
  21.  
  22. Overall structure:
  23. ------------------
  24.  
  25. Debug LOG:  This unit declares, opens and closes a text file named DEBUG.LOG.
  26. Any routine can write debug info by write(ln) ( log, .. ) ;
  27.  
  28. (c) Copyright 1988  LSD - Levanto Software Development
  29.  
  30. You may distribute this program freely, provided that
  31.   - You don't change a bit of it
  32.   - You don't take money for it.
  33.  
  34. You may use this unit for your own programs free of charge.  If you use it
  35. in programs you sell, or otherwise make business with it, you are asked to
  36. send some money or at least a post card to
  37.  
  38. LSD Levanto Software Development
  39. Rydevaeget 35,2,th
  40. DK 8210 Aarhus V
  41. Denmark
  42.  
  43.  
  44. }
  45.  
  46. INTERFACE
  47.  
  48. Uses
  49.   Crt,        { TURBO screen and sound }
  50.   Dos ;       { TURBO Dos calls for date and time }
  51.  
  52. Var
  53.   Log    : text ;
  54.  
  55.  
  56.  
  57.  
  58. IMPLEMENTATION
  59.  
  60.  
  61. var ExitSave : pointer ;
  62.  
  63. Procedure StartLog ;
  64.   var y,m,d,w : word ;
  65.       h,n,s,p : word ;
  66.   { Writes a start message in the log }
  67.   begin
  68.     GetDate ( y,m,d,w );
  69.     GetTime ( h,n,s,p );
  70.     write ( log, '------------------------- ', d,'.',m,'.',y,'  ' );
  71.     write ( log, h,':' );
  72.     if n < 10
  73.       then write ( log, '0',n,':' )
  74.       else write ( log,     n,':' );
  75.     if s < 10
  76.       then write ( log, '0',s,'.' )
  77.       else write ( log,     s,'.' );
  78.     if p < 10
  79.       then writeln ( log, '0',p )
  80.       else writeln ( log,     p );
  81.     end ; { StartLog }
  82.  
  83. {$F+}
  84. Procedure Exit ;
  85. {$F-}
  86.   begin
  87.     close ( log );
  88.     ExitProc := ExitSave ;
  89.     end ; { Exit }
  90.  
  91. var i : integer ;
  92.  
  93. begin { init section of GoDebug }
  94.   assign ( log, 'DEBUG.LOG' );
  95. {$I-}
  96.   Append ( log );
  97.   i := IoResult ;
  98. {$I+}
  99.   if i = 2 then begin { file not found }
  100. {$I-}
  101.     rewrite ( log ) ;
  102.     i := ioresult ;
  103. {$I+}
  104.     end ; { not found }
  105.   if i <> 0 then begin { could not open log file }
  106.     writeln ( 'I/O error ',i,' when opening log file ');
  107.     writeln ( 'No log will be written ');
  108.     writeln ( 'Hit Enter to continue ( or ctrl-C to quit ) ');
  109.     readln ;
  110.     assign ( log, 'NUL:' );
  111.     rewrite ( log );
  112.     end ;
  113.   StartLog ;
  114.   ExitSave := ExitProc ;
  115.   ExitProc := @ Exit ;
  116.   end . { GoDebug }
  117.  
  118.