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