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 >
Wrap
Pascal/Delphi Source File
|
1988-10-05
|
2KB
|
118 lines
Unit Logfile ;
{
Keeps a log file
Edition history:
----------------
12-05-88 13:20 HL Copied this unit from GOdebug
25-05-88 16:00 HL Added a print in the start of debug file
05-10-88 10:00 HL Placed in ShareWare
Problems, Errors, Bugs:
-----------------------
What next:
----------
Overall structure:
------------------
Debug LOG: This unit declares, opens and closes a text file named DEBUG.LOG.
Any routine can write debug info by write(ln) ( log, .. ) ;
(c) Copyright 1988 LSD - Levanto Software Development
You may distribute this program freely, provided that
- You don't change a bit of it
- You don't take money for it.
You may use this unit for your own programs free of charge. If you use it
in programs you sell, or otherwise make business with it, you are asked to
send some money or at least a post card to
LSD Levanto Software Development
Rydevaeget 35,2,th
DK 8210 Aarhus V
Denmark
}
INTERFACE
Uses
Crt, { TURBO screen and sound }
Dos ; { TURBO Dos calls for date and time }
Var
Log : text ;
IMPLEMENTATION
var ExitSave : pointer ;
Procedure StartLog ;
var y,m,d,w : word ;
h,n,s,p : word ;
{ Writes a start message in the log }
begin
GetDate ( y,m,d,w );
GetTime ( h,n,s,p );
write ( log, '------------------------- ', d,'.',m,'.',y,' ' );
write ( log, h,':' );
if n < 10
then write ( log, '0',n,':' )
else write ( log, n,':' );
if s < 10
then write ( log, '0',s,'.' )
else write ( log, s,'.' );
if p < 10
then writeln ( log, '0',p )
else writeln ( log, p );
end ; { StartLog }
{$F+}
Procedure Exit ;
{$F-}
begin
close ( log );
ExitProc := ExitSave ;
end ; { Exit }
var i : integer ;
begin { init section of GoDebug }
assign ( log, 'DEBUG.LOG' );
{$I-}
Append ( log );
i := IoResult ;
{$I+}
if i = 2 then begin { file not found }
{$I-}
rewrite ( log ) ;
i := ioresult ;
{$I+}
end ; { not found }
if i <> 0 then begin { could not open log file }
writeln ( 'I/O error ',i,' when opening log file ');
writeln ( 'No log will be written ');
writeln ( 'Hit Enter to continue ( or ctrl-C to quit ) ');
readln ;
assign ( log, 'NUL:' );
rewrite ( log );
end ;
StartLog ;
ExitSave := ExitProc ;
ExitProc := @ Exit ;
end . { GoDebug }