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