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