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.