home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SYSPC22.ZIP / WAITCALL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-15  |  10.5 KB  |  451 lines
  1. overlay procedure waitcall;
  2.  
  3.   var wscount:integer;
  4.       lt:real;
  5.       mustgetbaud:boolean;
  6.       which:integer;
  7.       xcount:integer;
  8.  
  9.   procedure maybewritestatus;
  10.   begin
  11.     wscount:=wscount+1;
  12.     if wscount>10 then begin
  13.       writestatus;
  14.       wscount:=0
  15.     end
  16.   end;
  17.  
  18.   function checkforhayesreport:boolean;  { Looks for CONNECT 300 }
  19.   var n:real;
  20.       q:sstr;
  21.       p,b:integer;
  22.       k:char;
  23.       brate:baudratetype;
  24.   const lookfor:sstr=#13#10'CONNECT ';
  25.   begin
  26.     checkforhayesreport:=false;
  27.     if numchars=0 then exit;
  28.     p:=1;
  29.     q:='';
  30.     b:=0;
  31.     repeat
  32.       n:=realtime;
  33.       repeat until (realtime>n+15) or (numchars>0);
  34.       if numchars=0 then exit else k:=getchar;
  35.       if (k=#13) and (length(q)>0) then begin
  36.         val (q,b,p);
  37.         brate:=b110;
  38.         while (brate<=b9600) and
  39.               ((b<>baudarray[brate])
  40.                 or (not (brate in supportedrates)))
  41.               do brate:=succ(brate);
  42.         if brate<=b9600 then begin
  43.           parity:=false;
  44.           baudrate:=b;
  45.           checkforhayesreport:=true;
  46.           mustgetbaud:=false;
  47.           n:=realtime;
  48.           repeat until carrier or (realtime>n+45)
  49.         end;
  50.         exit
  51.       end;
  52.       if p>length(lookfor) then q:=q+k else begin
  53.         if k=lookfor[p] then p:=p+1 else begin
  54.           b:=b+1;
  55.           if b=2 then exit
  56.         end
  57.       end
  58.     until false
  59.   end;
  60.  
  61.   procedure sendprompt;
  62.   begin
  63.     online:=true;
  64.     write ('System: Press [ENTER] :');
  65.     online:=false;
  66.   end;
  67.  
  68.   procedure receivecall;
  69.   var b:byte;
  70.       timeout,autoswitch:integer;
  71.       k:char;
  72.       brate:baudratetype;
  73.  
  74.     procedure nextrate (var b:baudratetype);
  75.     var ob:baudratetype;
  76.     begin
  77.       ob:=b;
  78.       repeat
  79.         b:=succ(b);
  80.         if b>b9600 then b:=b110;
  81.         if b=ob then exit
  82.       until b in supportedrates
  83.     end;
  84.  
  85.     procedure disconnect;
  86.     begin
  87.       if carrier then hangupmodem;
  88.       baudrate:=defbaudrate;
  89.       parity:=false;
  90.       setparam (usecom,baudrate,parity);
  91.       setupmodem
  92.     end;
  93.  
  94.     function seconds:integer;
  95.     var r:regs;
  96.     begin
  97.       r.ah:=$2c;
  98.       intr ($21,r);
  99.       seconds:=r.dh
  100.     end;
  101.  
  102.   label abort,connected;
  103.   begin
  104.     local:=false;
  105.     online:=false;
  106.     textcolor (normbotcolor);
  107.     window (1,1,80,25);
  108.     clrscr;
  109.     window (1,1,80,24);
  110.     if not mustgetbaud then goto connected;
  111.     writeln;
  112.     brate:=b110;
  113.     parity:=false;
  114.     timeout:=timer+2;
  115.     repeat
  116.       nextrate (brate);
  117.       baudrate:=baudarray[brate];
  118.       writeln (usr,^M^J'Trying ',baudrate,' BAUD: ');
  119.       setparam (usecom,baudrate,parity);
  120.       sendprompt;
  121.       autoswitch:=seconds+3;
  122.       if autoswitch>59 then autoswitch:=autoswitch-60;
  123.       repeat until (not carrier) or (numchars>0) or (keyhit) or
  124.                    (timer>=timeout) or (autoswitch=seconds);
  125.       if timer>=timeout then hangupmodem;
  126.       if not carrier then goto abort;
  127.       if keyhit
  128.         then
  129.           begin
  130.             k:=bioskey;
  131.             case upcase(k) of
  132.               #13:goto connected;
  133.               'D':goto abort;
  134.             end
  135.           end
  136.         else
  137.           begin
  138.             if numchars>0 then begin
  139.               b:=ord(getchar);
  140.               write (usr,b,' received.')
  141.             end else b:=0;
  142.             if b<>13
  143.               then if b=141
  144.                 then parity:=true
  145.                 else
  146.                   begin
  147.                     delay (200);
  148.                     while numchars>0 do b:=ord(getchar)
  149.                   end
  150.           end
  151.     until (b=13) or (b=141) or (timer>timeout);
  152.     if timer<=timeout then begin
  153.       connected:
  154.       setparam (usecom,baudrate,parity);
  155.       baudstr:=strr(baudrate)+','+baudstr+',1';
  156.       online:=true;
  157.       urec.config:=[lowercase,linefeeds,eightycols];
  158.       newcalls:=newcalls+1;
  159.       if carrier then exit
  160.     end;
  161.     abort:
  162.     disconnect
  163.   end;
  164.  
  165.   procedure exitprog(x:byte);
  166.   begin
  167.     if X<>1 then resetit else
  168.     offhook;
  169.     window (1,1,80,25);
  170.     textcolor (normtopcolor);
  171.     textbackground (0);
  172.     clrscr;
  173.     gotoxy (30,24);
  174.     ensureclosed;
  175.     halt(4)
  176.   end;
  177.  
  178.   procedure checkday;
  179.   begin
  180.     if lastdayup<>datestr then begin
  181.       lastdayup:=datestr;
  182.       numdaysup:=numdaysup+1;
  183.       callstoday:=0;
  184.       writestatus;
  185.       gotoxy (71,5);
  186.       write (usr,callstoday:3);
  187.     end
  188.   end;
  189.  
  190.   function statusscreen:char;
  191.   const statwindx=5;
  192.         statwindy=1;
  193.         firstcolx=21;
  194.         firstline=5;
  195.         secondcolx=57;
  196.  
  197.     procedure col1;
  198.     begin
  199.       window (statwindx+firstcolx,statwindy+firstline,80,25);
  200.     end;
  201.  
  202.     procedure col2;
  203.     begin
  204.       window (statwindx+secondcolx,statwindy+firstline,80,25);
  205.     end;
  206.  
  207.     procedure percent (r1,r2:real);
  208.     begin
  209.       if (r2<1) then exit;
  210.       r2:=round((r1/r2)*1000)/10;
  211.       write (usr,r2:6:1)
  212.     end;
  213.  
  214.     procedure drawstatus;
  215.       var tmp:integer;
  216.           totalidle,totalup,totalmins,r:real;
  217.     begin
  218.      if carrier or keyhit then exit;
  219.      window (22,5,29,16);
  220.      textcolor (15);
  221.      gotoxy (1,3);
  222.       totalidle:=numminsidle.total+elapsedtime(numminsidle);
  223.       write (usr,totalidle:7:0);
  224.      gotoxy (1,6);
  225.       r:=round(10*numcallers/numdaysup)/10;
  226.       write (usr,r:7:1);
  227.      gotoxy (1,11);
  228.       write (usr,numdaysup:7);
  229.      gotoxy (1,12);
  230.       totalup:=totalidle+numminsused.total;
  231.       write (usr,totalup:7:0);
  232.       totalmins:=1440.0*(numdaysup-1.0)+timer;
  233.       window (22,17,29,22);
  234.      gotoxy (2,1);
  235.       percent (numminsused.total,totalmins);
  236.      gotoxy (2,2);
  237.       percent (numminsxfer.total,totalmins);
  238.      gotoxy (2,3);
  239.       percent (totalidle,totalmins);
  240.      gotoxy (2,4);
  241.       percent (totalup,totalmins);
  242.      gotoxy (2,5);
  243.       percent (totalmins-totalup,totalmins);
  244.      window (1,1,80,25);
  245.      textcolor(4);
  246.      gotoxy (31,3);
  247.       write (usr,timestr:8);
  248.      gotoxy (40,3);
  249.       write (usr,datestr:8);
  250.    {*gotoxy (47,5);
  251.       tmp:=elapsedtime(numminsidle);
  252.       write (usr,tmp:4);*}
  253.      textcolor(15);
  254.      gotoxy (1,1);
  255.      end;
  256.  
  257.     procedure writeavail;
  258.     var m:sstr;
  259.  
  260.     begin
  261.       gotoxy (48,6);
  262.       m:=sysopavailstr;
  263.       if m='By time: No' then m:='No';
  264.       if m='By time: Yes' then m:='Yes';
  265.       write (usr,'Sysop Available: ',m:3);
  266.       gotoxy (1,1)
  267.     end;
  268.  
  269.   var cnt,numsmail:integer;
  270.       k:char;
  271.       tmp:mstr;
  272.       b,c:byte;
  273.       done,kool:boolean;
  274.       f:char;
  275.       sowhat:anystr;
  276.  
  277.    function shouldexit:boolean;
  278.     begin
  279.       shouldexit:=done or carrier
  280.     end;
  281.  
  282.     procedure handlekey (k:char; beforeabout:boolean);
  283.     begin
  284.       b:=ord(k);
  285.      kool:=true;
  286.       case b of
  287.         50:begin
  288.           toggleavail;
  289.           if not beforeabout then writeavail
  290.         end;
  291.         51:answer;
  292.         49,52,53,54:begin
  293.           done:=true;
  294.           statusscreen:=k
  295.         end;
  296.       end;
  297.     end;
  298.  
  299.     function interrupted (beforeabout:boolean):boolean;
  300.     begin
  301.       if keyhit then begin
  302.         k:=bioskey;
  303.         handlekey (k,beforeabout)
  304.       end;
  305.       done:=done or carrier;
  306.       interrupted:=done;
  307.     end;
  308.  
  309.  begin
  310.    statusscreen:=#0;
  311.    window (1,1,80,25);
  312.    sta:=false;
  313.    done:=false;
  314.    sowhat:=getlastcaller;
  315.    if ansiwait then
  316.    dos_shell ('Waitscrn xcr1000Marcy Y') else dos_shell('Waitscrn xcr1000Marcy N');
  317.    textcolor(1);
  318.    gotoxy (2,5);
  319.    write (usr,'Total Mins Used:');
  320.    gotoxy (2,6);
  321.    write (usr,'Mins Used By Xfer:');
  322.    gotoxy (2,7);
  323.    write (usr,'Minutes Idle:');
  324.    gotoxy (2,8);
  325.    write (usr,'New Calls:');
  326.    gotoxy(2,9);
  327.    write (usr,'New Posts:');
  328.    gotoxy(2,10);
  329.    write (usr,'Calls/Day:');
  330.    gotoxy(2,11);
  331.    write (usr,'New Uploads:');
  332.    gotoxy(2,12);
  333.    write (usr,'New Feedback:');
  334.    gotoxy(2,13);
  335.    write (usr,'New Mail:');
  336.    gotoxy(2,14);
  337.    write (usr,'Number of Calls:');
  338.    gotoxy(2,15);
  339.    write (usr,'Number of Days Up:');
  340.    gotoxy(2,16);
  341.    write (usr,'Total Up:');
  342.    gotoxy(2,17);
  343.    write (usr,'Percent Used:');
  344.    gotoxy(2,18);
  345.    write (usr,'Percent Xfer:');
  346.    gotoxy(2,19);
  347.    write (usr,'Percent Idle:');
  348.    gotoxy(2,20);
  349.    write (usr,'Percent Up:');
  350.    gotoxy(2,21);
  351.    write (usr,'Percent Down:');
  352.    gotoxy (1,25);
  353.    write (usr,'      ');
  354.    gotoxy (48,15);
  355.    write (usr,'[1] - Local Login (off-hook)');
  356.    gotoxy (48,16);
  357.    write (usr,'[2] - Toggle Sysop Available');
  358.    gotoxy (48,17);
  359.    write (usr,'[3] - Answer Modem');
  360.    gotoxy (48,18);
  361.    write (usr,'[4] - Exit (0)');
  362.    gotoxy (48,19);
  363.    write (usr,'[5] - Exit (1)');
  364.    movexy (35,1);
  365.    textcolor (15);
  366.    write (usr,'Utopia BBS');
  367.    window (22,5,29,16);
  368.    checkday;
  369.    gotoxy (1,1);
  370.    write (usr,numminsused.total:7:0); {1}
  371.    gotoxy (1,2);
  372.    write (usr,numminsxfer.total:7:0); {2}
  373.    gotoxy (1,4);
  374.    write (usr,newcalls:7);            {4}
  375.    gotoxy (1,5);
  376.    write (usr,newposts:7);            {5}
  377.    gotoxy (1,7);
  378.    write (usr,newuploads:7);          {7}
  379.    gotoxy (1,8);
  380.    write (usr,newfeedback:7);         {8}
  381.    gotoxy (1,9);
  382.    write (usr,newmail:7);             {9}
  383.    gotoxy (1,10);
  384.    write (usr,numcallers:7:0);        {10}
  385.    window (1,1,80,25);
  386.    gotoxy (48,8);
  387.    Write (usr,'Last Caller: ');
  388.    gotoxy (61,8);
  389.    Write (usr,sowhat);
  390.    gotoxy (48,5);
  391.    Write (usr,'Num Calls Today:');
  392.    gotoxy (65,5);
  393.    Write (usr,callstoday:3);
  394.    writeavail;
  395.    repeat
  396.        checkday;
  397.        drawstatus;
  398.        cnt:=0;
  399.        repeat
  400.        delay (250);
  401.        cnt:=cnt+1;
  402.         done:=done or checkforhayesreport
  403.       until (cnt>=240) or done or interrupted (false)
  404.     until done
  405.   end;
  406.  
  407.  
  408. var k:char;
  409. label exit;
  410. begin
  411.   starttimer (numminsidle);
  412.   wscount:=0;
  413.   clrscr;
  414.   repeat
  415.     doanswer;
  416.     mustgetbaud:=true;
  417.     k:=statusscreen;
  418.     if carrier then begin
  419.       receivecall;
  420.       if carrier then goto exit;
  421.     end;
  422.     case ord(k) of
  423.       52:begin
  424.            local:=false;
  425.            online:=false;
  426.            writestatus;
  427.            goto exit
  428.          end;
  429.       53:exitprog(0);
  430.       54:exitprog(1);
  431.       49:begin
  432.            offhook;
  433.            local:=true;
  434.            online:=false;
  435.            newfeedback:=0;
  436.            newcalls:=0;
  437.            newmail:=0;
  438.            newuploads:=0;
  439.            newposts:=0;
  440.            writestatus;
  441.            goto exit
  442.          end
  443.     end
  444.   until 0=1;
  445.   exit:
  446.   write (normvid);
  447.   window (1,1,80,25);
  448.   clrscr
  449. end;
  450.  
  451.