home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / STATRET.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-09  |  2KB  |  111 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit statret;
  5.  
  6. interface
  7.  
  8. uses gentypes,dos;
  9.  
  10. type systemstatus=array [1..511] of byte;
  11.  
  12. var numcallers:real;
  13.     tonext:integer;
  14.     sysopavail:availtype;
  15.     lastdayup:sstr;
  16.     numdaysup,callstoday:integer;
  17.     numminsidle,numminsused,numminsxfer:minuterec;
  18.     messages,ups,emails,gfilez,dbases:integer;
  19.     timedeventdate:sstr;
  20.     newfeedback,newuploads,newcalls,newposts,newmail,newusers,screendef:integer;
  21.     dummyfiller:array [1..499] of byte;
  22.  
  23. function timer:integer;
  24. procedure starttimer (var m:minuterec);
  25. function elapsedtime (var m:minuterec):integer;
  26. procedure stoptimer (var m:minuterec);
  27. procedure writestatus;
  28. procedure readstatus;
  29.  
  30. implementation
  31.  
  32. function timer:integer;
  33. var r:registers;
  34. begin
  35.   r.ax:=$2c00;
  36.   intr ($21,r);
  37.   timer:=(r.cx shr 8)*60+(r.cx and 255)
  38. end;
  39.  
  40. procedure starttimer (var m:minuterec);
  41. begin
  42.   if m.started then exit;
  43.   m.startedat:=timer;
  44.   m.started:=true
  45. end;
  46.  
  47. function elapsedtime (var m:minuterec):integer;
  48. var n:integer;
  49. begin
  50.   if not m.started then begin
  51.     elapsedtime:=0;
  52.     m.startedat:=timer;
  53.     exit
  54.   end;
  55.   n:=timer-m.startedat;
  56.   if n<0 then n:=n+1440;
  57.   elapsedtime:=n
  58. end;
  59.  
  60. procedure stoptimer (var m:minuterec);
  61. begin
  62.   if not m.started then begin
  63.     m.startedat:=0;
  64.     exit
  65.   end;
  66.   m.startedat:=elapsedtime(m);
  67.   m.total:=m.total+m.startedat;
  68.   m.started:=false
  69. end;
  70.  
  71. procedure writestatus;
  72. const numtimers=3;
  73. type timerset=array [1..numtimers] of minuterec;
  74. var realt:timerset absolute numminsidle;
  75.     t:timerset;
  76.     cnt:integer;
  77.     ss:systemstatus absolute numcallers;
  78.     f:file of systemstatus;
  79. begin
  80.   assign (f,'Status');
  81.   rewrite (f);
  82.   t:=realt;
  83.   for cnt:=1 to numtimers do
  84.     if realt[cnt].started
  85.      then stoptimer (realt[cnt]);
  86.   write (f,ss);
  87.   realt:=t;
  88.   close (f)
  89. end;
  90.  
  91. procedure readstatus;
  92. var f:file of systemstatus;
  93.     ss:systemstatus absolute numcallers;
  94. begin
  95.   assign (f,'Status');
  96.   reset (f);
  97.   if ioresult<>0 then begin
  98.     fillchar (numcallers,511,0);
  99.     tonext:=-1;
  100.     sysopavail:=bytime;
  101.     writestatus;
  102.     exit
  103.   end;
  104.   read (f,ss);
  105.   close (f)
  106. end;
  107.  
  108. begin
  109. end.
  110.  
  111.