1 unit log;
2 
3 interface
4 
5 {$ifdef __GPC__}
6 	uses gpcstrings,erweiter;
7 {$endif}
8 
9 {$ifdef fpc}
10 	{$ifdef linux}
11 	uses erweiter,dos;
12 	{$define havedosunit}
13 	{$endif}
14 {$endif}
15 
16 
17 
18 const
19  showlevel:word=5;
20  loglevel:word=3;
21 
22 procedure Logit(pri:word;t:string);
23 procedure Openlogfile(s:string);
24 procedure Closelogfile;
25 
26 implementation
27 
28 var
29  f:text;
30  exitsave:pointer;
31 
32 {$i-}
33 procedure openlogfile(s:string);
34 var
35  io:word;
36 begin
37  assign(f,s);
38  append(f);
39  io:=ioresult;
40  if io=2 then begin rewrite(f); io:=ioresult; end;
41  if io<>0 then begin
42   writeln('Could not create logfile ',s,' Error:',io);
43   halt(255);
44  end;
45  close(f);
46 append(f);
47 end;
48 
49 {pri 0..9  9 very important  0 not important}
50 
51 procedure logit(pri:word;t:string);
52 const
53      month:array[1..12] of string=  ('Jan'  ,  'Feb' ,  'Mar'  ,  'Apr'
54                  ,  'May'  ,  'Jun' ,  'Jul'  ,  'Aug'
55                  ,  'Sep'  ,  'Oct' ,  'Nov'  ,  'Dec');
56 var
57  y,m,d,dow:word;
58  h,min,sec,s100:word;
59  s:String;
60 begin
61  s:='';
62 	{$ifdef __GPC__}
63 	y:=0; m:=0; d:=0; dow:=0; h:=0; min:=0; sec:=0; s100:=0;
64 	{$else}
65  getdate (y,m,d,dow);
66  gettime(h,min,sec,s100);
67 	{$endif}
68  if pri>9 then pri:=9;
69  s:=z2s(pri)+' '+z2s_nullen(d,2)+' '+month[m]+' '+z2s_nullen(h,2)+':'+z2s_nullen(min,2)+':'+z2s_nullen(sec,2)+' FFMA '+t;
70  if loglevel<=pri then writeln(f,s);
71  if showlevel<=pri then writeln(t);
72  flush(f);
73 end;
74 
75 procedure closelogfile;
76 begin
77 	close(f);
78     if ioresult=0 then;
79 end;
80 
81 procedure logexit;
82 begin
83 	{$ifdef __GPC__}
84     closelogfile;
85 	{$else}
86 	exitproc:=exitsave;
87 	closelogfile;
88 	{$endif}
89 end;
90 
91 begin
92 	{$ifdef __GPC__}
93 	{$else}
94 	exitsave:=exitproc;
95 	exitproc:=@logexit;
96 	{$endif}
97 	{$ifdef debugit}
98 	loglevel:=0;
99 	{$endif}
100 end.