home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / waitcall.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-14  |  40KB  |  1,460 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit waitcall;
  4.  
  5. interface
  6.  
  7. uses dos,crt,windows,userret,mainmenu,main,email,
  8.      gentypes,statret,configrt,modem,gensubs,subs1,subs2,mailret,
  9.      overret1,mainr1,mainr2,textret,ExecSwap;
  10.  
  11. var wasted:minuterec;
  12.  
  13. Const SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS');
  14.  
  15. function waitforacall:boolean;
  16. function suporterd:boolean;
  17.  
  18. implementation
  19.  
  20. Procedure Do_Net_Mail;               (* ViSiON NetMail Version 1.01 *)
  21. Var NodeRec:NodeNetRec;
  22.     CurrentNodeNumber,NumMsgs:Integer;
  23.     Fnode:File of NodeNetRec;
  24.     chrr:Char;
  25.     simplex:boolean;
  26.     jo:integer;
  27.     finished:boolean;
  28.     oktosend:BooLean;
  29.  
  30.   Function FindBaseName(BaseId:Byte):SStr;
  31.   Var Board:BoardRec;
  32.       Fbd:File of BoardRec;
  33.       Sek:Integer;
  34.   Begin           (* Echo should equal baseId *)
  35.       Assign(Fbd,ConfigSet.BoardDi+'BoardDir');
  36.       Reset(Fbd);
  37.       Sek:=0;
  38.       FindBaseName:='';
  39.       Repeat
  40.         Seek(Fbd,Sek);
  41.         Read(Fbd,Board);
  42.         Inc(Sek);
  43.         If Board.Echo=BaseId then FindBaseName:=Board.ShortName;
  44.       Until (Board.Echo=BaseId) or Eof(Fbd);
  45.       Close(Fbd);
  46.   End;             (* End FindBaseName *)
  47.  
  48.   Procedure SendString(S:Lstr);
  49.   Var I:Integer;
  50.   Begin
  51.        For I:=1 to Length(S) Do SendChar(S[I]);
  52.   End;     (* End Send String *)
  53.  
  54.   procedure UpDateStory(Nums:Integer; Sent,Upgraded:Boolean);
  55.   Var T:Text;
  56.   Begin
  57.         appendfile(configset.forumdi+'Notices.BBS',t);
  58.         WriteLn(T,^M^S'────────────────────────────────────────────────────────────────────────');
  59.     WriteLn(T,^R'             On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened');
  60.     if not Sent then WriteLn(T,^R'('+Strr(Nums)+') Messages were sent to '+NodeRec.Name)
  61.     else WriteLn(T,^R'('+Strr(Nums)+') Messages were received from '+NodeRec.Name);
  62.     If Upgraded then WriteLn(T,^R'An Upgrade was received with this packet!');
  63.     WriteLn(T,^S'────────────────────────────────────────────────────────────────────────'^M);
  64.     TextClose(T);
  65.   End;      (* End UpdateStory *)
  66.  
  67.   Procedure GetItAll;
  68.   Var C:Char;
  69.   Begin
  70.    While NumChars>0 do
  71.    write(usr,getchar);
  72.   End;                    (* End GetItAll *)
  73.  
  74.  
  75.   Procedure SetUpForNetMail;
  76.   Begin
  77.     ClrScr;
  78.     WriteLn(Usr,'ViSiON Netmail version 1.01 (c) 1991 Ruthless Enterprises.');
  79.     If Not Exist(ConfigSet.ForumDi+'NodeList.BBS') then
  80.        Begin
  81.          WriteLn(Usr,'We WOULD send NetMail, BUT there seems to be no one to net with. MAKE');
  82.          WriteLn(Usr,'your NODELIST.BBS file BEFORE trying to attempt netmail!');
  83.          EnsureClosed;
  84.          Halt(0);
  85.        End;      (* End If then Begin *)
  86.     WriteLn(Usr,'First we must disable Auto-Answer!');
  87.     SendString('ATZ'+#13);
  88.     Delay(1500);
  89.     GetItAll;
  90.     SendString('ATS0=0'+#13);
  91.     Delay(500);
  92.     GetItAll;
  93.     WriteLn(Usr,'Now we will go ahead and set the Extended Registers to recognize everything.');
  94.     SendString('ATX6'+#13);
  95.     Delay(500);
  96.     GetItAll;
  97.     WriteLn(Usr,'Now we will open up the Node List file.');
  98.     Assign(Fnode,Configset.ForumDi+'NodeList.BBS');
  99.     Reset(Fnode);
  100.     CurrentNodeNumber:=0;
  101.     WriteLn(Usr,'There. All done.');
  102.   End;                  (* End SetUpForNetMail *)
  103.  
  104.   Procedure DialNodes;
  105.   Var Packaged:Boolean;
  106.  
  107.  
  108.        Function Connected:Boolean;
  109.        Var C:Char;
  110.            S:String;
  111.        Begin
  112.          Delay(9000);
  113.          S:='';
  114.                  While NumChars>0 Do
  115.                  Begin
  116.                      S:=S+getchar;
  117.            If C=#13 then S:='';
  118.            If Pos('[Enter]',S)>0 Then
  119.            Begin
  120.              WriteLn(Usr,'We MUST hit return!');
  121.              SendString(#13+#13+#13+#13);
  122.              S:='';
  123.            End;    (* End If then *)
  124.          End;      (* End Repeat Loop *)
  125.          If Carrier then Connected:=True;
  126.        End;         (* End Connected *)
  127.  
  128.    Procedure DialNode;
  129.  
  130.        Procedure PrepNetMail;
  131.        Var Ct,Loper:Integer;
  132.        NetPost:NetPostRec;
  133.        FNP:File of NetPostRec;
  134.        Bul:BulRec;
  135.        M:Message;
  136.        Bfile:File of BulRec;
  137.        BaseName:SStr;
  138.        CurBase:Byte;
  139.  
  140.        Procedure Package;
  141.        Begin
  142.        ClrScr;
  143.        WriteLn(Usr,'Making NetMail Package as per request.');
  144.        CurBase:=0;
  145.        NumMsgs:=0;
  146.        Assign(Fnp,Configset.NetDir+'NetMail.Pkg');
  147.        ReWrite(Fnp);
  148.        Loper:=0;
  149.        While Loper<255 Do
  150.         Begin
  151.            Inc(Loper);
  152.            If NodeRec.BaseSelection[Loper] Then Begin
  153.            BaseName:=FindBaseName(Loper);
  154.            If BaseName<>'' then Begin
  155.            Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL');
  156.            Reset(Bfile);
  157.            Ct:=0;
  158.          While Not Eof(Bfile) Do
  159.            Begin
  160.              Seek(Bfile,Ct);
  161.              Read(Bfile,Bul);
  162.              If Bul.When>NodeRec.LastDate Then
  163.                Begin
  164.                Inc(NumMsgs);
  165.                NetPost.NetIdNum:=Loper;
  166.                NetPost.BulletinRec:=Bul;
  167.                ReloadText(Bul.Line,M);
  168.                NetPost.MessageRec:=M;
  169.                Seek(Fnp,FileSize(Fnp));
  170.                Write(Fnp,NetPost);
  171.                End; (* If Bul.When>NodeRec.LastDate *)
  172.              Inc(Ct);
  173.            End;  (* End While Not Eof *)
  174.          Close(Bfile);
  175.          End;         (* End if basename<>'' *)
  176.          End;         (* End if basethingie *)
  177.        End;           (* End Loper *)
  178.        Close(Fnp);
  179.       End;            (* End Package *)
  180.  
  181.       Procedure ZipPackage;
  182.       Var F:File;
  183.       Begin
  184.            Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg');
  185.            Assign(F,ConfigSet.NetDir+'NetMail.Pkg');
  186.            Erase(F);
  187.            Close(F);
  188.       End;          (* End ZipPackage *)
  189.  
  190.  
  191.       Begin
  192.         Package;
  193.         If NumMsgs>0 Then Begin
  194.         ZipPackage;
  195.         Packaged:=True;
  196.         End;
  197.       End;                    (* End SendOutGoing *)
  198.  
  199.        Function Call(X:Lstr):Boolean;
  200.        Var Pre,Suf:Lstr;
  201.            Jo:Integer;
  202.            Finished:Boolean;
  203.  
  204.            Function Busy:Boolean;
  205.            Var K:String;
  206.                C:Char;
  207.            Begin
  208.                 K:='';
  209.                                 While NumChars>0 do k:=k+getchar;
  210.                 Busy:=False;
  211.                 If Pos('BUSY',K)>0 then Busy:=True;
  212.                 If Pos('NO CARRIER',K)>0 Then Busy:=True;
  213.                 If Pos('NO DIAL',K)>0 Then Busy:=True;
  214.            End;    (* End Busy *)
  215.  
  216.  
  217.        Begin
  218.             ClrScr;
  219.             WriteLn(Usr,'Dialing Number...');
  220.             If X='' then Exit;
  221.             dontanswer;
  222.             Delay(1500);
  223.             Pre:='';
  224.             Suf:='';
  225.             If Length(X)>7 then
  226.                Begin
  227.                     Pre:=ConfigSet.CoPre;
  228.                     Suf:=ConfigSet.CoSuf;
  229.                End;
  230.             If KeyPressed then Chrr:=ReadKey;
  231.             DoAnswer;
  232.             Delay(1200);
  233.             SendString('     ');
  234.             Delay(1600);
  235.             GetItAll;
  236.             SendString('ATDT'+Pre+X+Suf+#13);
  237.             Finished:=False;
  238.             delay(1500);
  239.             GetItAll;
  240.             Jo:=0;
  241.             Repeat
  242.                   Inc(Jo);
  243.                   Delay(10);
  244.                   If Busy then Finished:=True;
  245.                   If Finished then WriteLn(Usr,'Line was busy!'^M);
  246.                   If KeyPressed then Finished:=True;
  247.                   If KeyPressed then WriteLn(Usr,'User Abort!');
  248.                   If Carrier then Finished:=True;
  249.             Until Finished or (Jo>15000);
  250.             SendString(^M);
  251.             Call:=Carrier;
  252.        End;         (* End Call *)
  253.  
  254.  
  255.     Begin
  256.        PrepNetMail;
  257.        Window(1,1,80,25);
  258.        ClrScr;
  259.        TextColor(15);
  260.        WriteLn(Usr,'ViSiON NetMail Dialing '+NodeRec.Name+' @'+NodeRec.Phone);
  261.        TextColor(11);
  262.        WriteLn(Usr,'──────────────────────────────────────────────────────────────────────────');
  263.        TextColor(7);
  264.        Window(1,3,80,25);
  265.        Repeat
  266.         delay(2500);
  267.        Until Call(NodeRec.Phone) or
  268.          (Not WithinTime(ConfigSet.NetStc,Configset.NetEnc));
  269.     End; (* End DialNode *)
  270.  
  271.   Function SuccessfulNetMail:Boolean;
  272.   Var T:Text;
  273.       Received:Boolean;
  274.       F:File;
  275.       I:Integer;
  276.  
  277.   Procedure SendViaDSZ;
  278.   Begin
  279.   Delay(3000);
  280.   Exec('Dsz.Com',' port '+Strr(Configset.UseCo)+' speed '+strlong(baudrate)+' ha slow sz -m '+Configset.NetDir+'Net.Zip');
  281.     Assign(F,ConfigSet.NetDir+'Net.Zip');
  282.     Erase(F);
  283.     updatestory(NumMsgs,False,False);
  284.     NumMsgs:=0;
  285.   End;                   (* End SendViaDSZ *)
  286.  
  287.     Function ExecDsz:Boolean;
  288.     var ken:char;
  289.     Begin
  290.              If Exist(ConfigSet.WorkDir+'Net.Zip') then
  291.                  Begin
  292.                      Assign(F,ConfigSet.WorkDir+'Net.Zip');
  293.                      Erase(F);
  294.                  End;       (* End If Then *)
  295.              Delay(500);
  296.              GetItAll;
  297.              Repeat
  298.              Until (NumChars>0) or (Not Carrier);
  299.   Exec('Dsz.Com',' port '+Strr(ConfigSet.UseCo)+' speed '+strlong(baudrate)+' ha slow rz -m '+ConfigSet.WorkDir+'Net.Zip');
  300.        ExecDsz:=True;
  301.   End;
  302.  
  303.   Procedure ProcessIncomming;
  304.   Var Fnp:File of NetPostRec;
  305.       NetPost:NetPostRec;
  306.       M:Message;
  307.       B:BulRec;
  308.       Bfile:File of BulRec;
  309.       Upgrade,oktosend:Boolean;
  310.  
  311.       Procedure UnZipNet;
  312.       Var F:File;
  313.       Begin
  314.            SwapVectors;
  315.            Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir);
  316.            Assign(F,Configset.WorkDir+'Net.Zip');
  317.            Erase(F);
  318.            Close(F);
  319.       End;          (* End UnZipNet *)
  320.  
  321.       Procedure PostMsgs;
  322.       Var F:File;
  323.           TId:Word;
  324.           Current:Byte;
  325.           BaseName:Sstr;
  326.       Begin
  327.            ClrScr;
  328.            Upgrade:=False;
  329.            WriteLn(Usr,'Posting NetMail Messages.');
  330.            If Exist(ConfigSet.WorkDir+'Upgrade.Zip') then
  331.            Begin
  332.              Upgrade:=true;
  333.              Exec(GetEnv('ComSpec'),'/C Copy '+ConfigSet.WorkDir+'Upgrade.Zip '+
  334.              ConfigSet.NetType1Path+'Upgrade.Zip > NUL');
  335.              Assign(F,ConfigSet.WorkDir+'Upgrade.Zip');
  336.              Erase(F);
  337.              Close(F);
  338.            End;
  339.            If Exist(ConfigSet.WorkDir+'NetMail.Pkg') Then
  340.               Begin
  341.                  Assign(Fnp,Configset.WorkDir+'NetMail.Pkg');
  342.                  Reset(Fnp);
  343.                  NumMsgs:=0;
  344.                  Current:=0;
  345.                  While Not Eof(Fnp) Do
  346.                    Begin
  347.                      Read(Fnp,NetPost);
  348.                      If Current<>NetPost.NetIdNum Then Begin
  349.                         BaseName:=FindBaseName(NetPost.NetIdNum);
  350.                         Close(Bfile);
  351.                         If BaseName<>'' Then Begin
  352.                            Assign(Bfile,ConfigSet.BoardDi+BaseName+'.Bul');
  353.                            Reset(Bfile);
  354.                         End;   (* End if basename<>'' *)
  355.                      End;      (* End if current<>netpost.netidnum *)
  356.                    If NetPost.BulletinRec.Where=ConfigSet.Origin1 Then Else
  357.                       Begin
  358.                         Seek(Bfile,FileSize(BFile)-1);
  359.                         Read(Bfile,B);
  360.                         If B.Id=65535 then NetPost.BulletinRec.Id:=1 Else
  361.                             NetPost.BulletinRec.Id:=B.Id+1;
  362.                         B:=NetPost.BulletinRec;
  363.                         M:=NetPost.MessageRec;
  364.                         B.Line:=MakeText(M);
  365.                         B.When:=Now;
  366.                         Seek(Bfile,FileSize(Bfile));
  367.                         Write(Bfile,B);
  368.                         Inc(NumMsgs);
  369.                       End;           (* End if origin is here *)
  370.                    End;              (* End While Not Eof Do Begin *)
  371.                  Close(Fnp);
  372.                  Assign(F,ConfigSet.WorkDir+'NetMail.Pkg');
  373.                  Erase(F);
  374.                 NewPosts:=NewPosts+NumMsgs;
  375.                 Gnup:=Gnup+NumMsgs;
  376.                 WriteStatus;
  377.               End;        (* End If Exist Msgs *)
  378.       End;                (* End PostMsgs *)
  379.  
  380.  
  381.       Begin         (* Main ProcessIncomming *)
  382.            UnZipNet;
  383.            PostMsgs;
  384.            UpDateStory(NumMsgs,True,Upgrade);
  385.       End;           (* End ProcessIncomming *)
  386.  
  387.   Procedure UpDateNode;
  388.   Begin
  389.        NodeRec.LastDate:=Now;
  390.        Seek(Fnode,CurrentNodeNumber);
  391.        Write(Fnode,NodeRec);
  392.   End;                      (* End UpDateNode *)
  393.  
  394.   Begin
  395.        If Not Carrier And Not WithinTime(ConfigSet.NetStc,ConfigSet.NetEnc) then
  396.           Begin
  397.                SuccessfulNetMail:=True;
  398.                Exit;
  399.           End;
  400.        If Not Connected Then
  401.           Begin
  402.             SuccessfulNetMail:=False;
  403.             WriteLn(Usr,'NetMail failed.. Why???');
  404.             HangUp;
  405.             Delay(1600);
  406.             Exit;
  407.           End;   (* End Delay *)
  408.        SuccessfulNetMail:=False;
  409.        SendString(ConfigSet.NetPas+#13);
  410.        Delay(500);
  411.        GetItAll;
  412.        SendString(NodeRec.Node+#13);
  413.        Delay(500);
  414.        GetItAll;
  415.        SendString(NodeRec.Pass+#13);
  416.        Delay(500);
  417.        GetItAll;
  418.        Delay(1500);
  419.        If Not Carrier then Begin
  420.        Appendfile(ConfigSet.ForumDi+'Notices.BBS',t);
  421.        WriteLn(T,'On '+DateStr(Now)+' at '+TimeStr(Now)+' we had the wrong password');
  422.          WriteLn(T,'when we tried to send netmail to '+NodeRec.Name);
  423.          TextClose(T);
  424.          SuccessfulNetMail:=True;
  425.        End;                      (* End if not carrier *)
  426.        If ConfigSet.NetType1 then SendString('U'+#13);
  427.        oktosend:=False;
  428.        For I:=1 to 255 Do
  429.            Begin
  430.                 If NodeRec.BaseSelection[I] Then SendString(Strr(I)+#13);
  431.                 If NodeRec.BaseSelection[I] then GetItAll;
  432.                 oktosend:=False;
  433.            End;
  434.        SendString('0'+#13);
  435.        Delay(500);
  436.        GetItAll;
  437.        oktosend:=true;
  438.        If Packaged then
  439.           Begin
  440.                SendString('Y'+#13);
  441.                Delay(500);
  442.                GetItAll;
  443.                SendString('Y'+#13); (* This is the "Yes to receive" *)
  444.                If oktosend then SendViaDSZ;
  445.           End Else            (* End if packaged *)
  446.        Begin
  447.          SendString('N'+#13);
  448.          Delay(500);
  449.          GetItAll;
  450.          SendString('Y'+#13); (* yes to receive *)
  451.        end;
  452.        Delay(1500);
  453.        If Not Carrier then Begin
  454.           SuccessfulNetMail:=False;
  455.           Exit;
  456.        End;    (* If Not Carrier *)
  457.        Received:=ExecDsz;
  458.        HangUp;
  459.        If Received then ProcessIncomming;
  460.        UpDateNode;
  461.        SuccessfulNetMail:=True;
  462.   End;                         (* End SuccessfulNetMail *)
  463.  
  464.  
  465.   Begin
  466.        While Not Eof(Fnode) Do
  467.        Begin
  468.        Seek(Fnode,CurrentNodeNumber);
  469.        Read(Fnode,NodeRec);
  470.        Repeat
  471.              DialNode;
  472.        Until SuccessfulNetMail;   (* End Loop *)
  473.        Inc(CurrentNodeNumber);
  474.        End;      (* End While Not EofFnode *)
  475.   End;      (* End DialNodes *)
  476.  
  477.   Procedure ExitNetMail;
  478.   Begin
  479.     ClrScr;
  480.     WriteLn(Usr,'Now we''re done.. Setting back on Auto Answer.');
  481.     DoAnswer;
  482.     SendString('ATZ'+#13);
  483.     Delay(2500);
  484.     GetItAll;
  485.     SendString('ATS0=1'+#13);
  486.     Delay(700);
  487.     GetItAll;
  488.   End;
  489.  
  490. Begin
  491.      SetUpForNetMail;
  492.      DialNodes;
  493.      ExitNetMail;
  494.      EnsureClosed;
  495.      Halt(0);
  496. End;             (* End Do_Net_Mail *)
  497.  
  498. function suporterd:boolean;
  499. var brated:baudratetype;
  500.     TempSprt:Boolean;
  501. begin
  502.      case connectbaud of
  503.      300:brated:=b300;
  504.      1200:brated:=b1200;
  505.      2400:brated:=b2400;
  506.      4800:brated:=b4800;
  507.      9600:brated:=b9600;
  508.      end;
  509.  TempSprt:=true;
  510.  if not (brated in configset.supportedrate) and (connectbaud<9600) then begin
  511.     TempSprt:=False;
  512.     if configset.LockOutBaudPass<>'' then begin
  513.      WriteStr('Enter Lock-Out Baud password:');
  514.      TempSprt:=Match(Input,Configset.LockOutBaudPass);
  515.      End;
  516.      If not TempSprt then writeln('Sorry, that baud rate is NOT supported!');
  517.     delay(1500);
  518.  end;
  519.  Suporterd:=TempSprt;
  520. end;
  521.  
  522. function waitforacall:boolean;
  523.  
  524.   var wscount:integer;
  525.       ScreenColor:Byte;
  526.       mustgetbaud,SaveScreenOn:boolean;
  527.  
  528.   procedure getansimode;
  529.   Var T:String;
  530.       c:char;
  531.   Begin
  532.     Delay(500);
  533.     sendchar(#27);
  534.     delay(15);
  535.     sendchar('[');
  536.     delay(15);
  537.     sendchar('6');
  538.     delay(15);
  539.     sendchar('n');
  540.     delay(15);
  541.     delay(3700);
  542.     T:='';
  543.     While NumChars>0 do t:=t+getchar;
  544.     If Pos('2;1R',T)>0 then
  545.      begin
  546.      urec.config:=urec.config+[Ansigraphics,AsciiGraphics];
  547.      urec.statcolor:=configset.defstacolor;
  548.      urec.regularcolor:=configset.defreg;
  549.      urec.promptcolor:=configset.defpromp;
  550.      urec.inputcolor:=configset.definput;
  551.      end;
  552.      If exist (configset.textfiledi+'MATRIX.NOW') then Begin
  553.        Printfile(configset.textfiledi+'MATRIX.NOW');
  554.        GoXy(1,22);
  555.        WriteStr(^R'Press '^P'['^U'Enter'^P']'^S':*');
  556.        End;
  557.   End;
  558.  
  559.   procedure maybewritestatus;
  560.   begin
  561.     wscount:=wscount+1;
  562.     if wscount>250 then begin
  563.       writestatus;
  564.       wscount:=0
  565.     end
  566.   end;
  567.  
  568. (***
  569.  
  570.   function checkforhayesreport:boolean;  { Looks for CONNECT 300 }
  571.   var n:longint;
  572.       q:sstr;
  573.       p,b:integer;
  574.       k:char;
  575.       brate:baudratetype;
  576.   const lookfor:sstr=#13#10'CONNECT ';
  577.   begin
  578.     checkforhayesreport:=false;
  579.     if numchars=0 then exit;
  580.     p:=1;
  581.     q:='';
  582.     b:=0;
  583.     repeat
  584.       n:=now;
  585.       repeat until (now>n+1) or (numchars>0);
  586.             k:=getchar;
  587.       if (k=#13) and (length(q)>0) then begin
  588.         val (q,b,p);
  589.         brate:=b110;
  590.         while (brate<=b9600) and
  591.               ((b<>baudarray[brate])
  592.                 or (not (brate in supportedrates)))
  593.               do brate:=succ(brate);
  594.         if brate<=b9600 then begin
  595.           parity:=false;
  596.           baudrate:=b;
  597.           checkforhayesreport:=true;
  598.           mustgetbaud:=false;
  599.           n:=now;
  600.           repeat until carrier or (now>n+1)
  601.         end;
  602.         exit
  603.       end;
  604.       if p>length(lookfor) then begin
  605.       q:=q+k;
  606.       writeln(usr,q);
  607.       delay(200);
  608.       end
  609.        else begin
  610.         if k=lookfor[p] then p:=p+1 else begin
  611.           b:=b+1;
  612.           if b=2 then exit
  613.         end
  614.       end
  615.     until false
  616.   end;
  617.  
  618. ***)
  619.  
  620.   procedure receivecall;
  621.   var b:byte;
  622.       timeout,autoswitch:integer;
  623.       k:char;
  624.       brate:baudratetype;
  625.       joemam:anystr;
  626.       brow:integer;
  627.       speed:boolean;
  628.  
  629.     procedure sendstring (s:string);
  630.     var cnt:integer;
  631.     begin
  632.       for cnt:=1 to length(s) do
  633.        sendchar (s[cnt]);
  634.     end;
  635.  
  636.     procedure nextrate (var b:baudratetype);
  637.     var ob:baudratetype;
  638.     begin
  639.       ob:=b;
  640.       repeat
  641.         b:=succ(b);
  642.         if b>b38400 then b:=b110;
  643.         if b=ob then exit
  644.       until b in configset.supportedrate
  645.     end;
  646.  
  647.     procedure disconnect;
  648.     begin
  649.             if carrier then hangupmodem;
  650.       baudrate:=configset.defbaudrat;
  651.       parity:=false;
  652.       setparam (configset.useco,baudrate,parity);
  653.       setupmodem
  654.     end;
  655.  
  656.     function seconds:integer;
  657.     var r:registers;
  658.     begin
  659.       r.ah:=$2c;
  660.       intr ($21,r);
  661.       seconds:=r.dh
  662.     end;
  663.  
  664.     label abort,connected;
  665.     var tempchar:char;
  666.     begin
  667.         local:=false;
  668.         online:=false;
  669.         textcolor (configset.normbotcolo);
  670.     begin
  671.          matrix:='';
  672.          online:=true;
  673.          delay (200);
  674.         if numchars>0 then begin
  675.         matrix:=matrix+getchar;
  676.         delay (100);
  677.     while numchars>0 do matrix:=matrix+getchar;
  678.         (* if (pos('CONNECT '+#10,matrix)>0) then begin
  679.              baudrate:=baudarray[b300];
  680.              goto connected;
  681.              end; *)
  682.         if pos('5',matrix)>0 then begin
  683.              baudrate:=baudarray[b1200];
  684.              goto connected;
  685.        end;
  686.     If pos('14',matrix)>0 then Begin
  687.       baudrate:=baudarray[b19200];
  688.       goto connected;
  689.       End;
  690.     if pos('12',matrix)>0 then begin
  691.        baudrate:=baudarray[b1200];
  692.        goto connected;
  693.        end;
  694.     if pos('24',matrix)>0 then begin
  695.        baudrate:=baudarray[b2400];
  696.        goto connected;
  697.        end;
  698.     if  pos('11',matrix)>0 then begin
  699.        baudrate:=baudarray[b2400];
  700.        goto connected;
  701.        end;
  702.     if  pos('96',matrix)>0 then begin
  703.        baudrate:=baudarray[b9600];
  704.        goto connected;
  705.        end;
  706.     if pos('19',matrix)>0 then begin
  707.        baudrate:=baudarray[b19200];
  708.        goto connected;
  709.        end;
  710.     if pos('10',matrix)>0 then begin
  711.        baudrate:=baudarray[b2400];
  712.        goto connected;
  713.              end;
  714.              baudrate:=baudarray[b300];
  715.              goto connected;
  716.     writeln (usr,matrix);
  717. end;
  718.   begin
  719.     local:=false;
  720.     online:=false;
  721.     textcolor (configset.normbotcolo);
  722.     window (1,1,80,25);
  723.     clrscr;
  724.     window (1,1,80,23);
  725.     if not mustgetbaud then goto connected;
  726.     writeln;
  727.     brate:=b110;
  728.     parity:=false;
  729.     timeout:=timer+2;
  730.     repeat
  731.       nextrate (brate);
  732.       baudrate:=baudarray[brate];
  733.       textcolor (configset.outlockcolo);
  734.       textbackground (0);
  735.       write (^M^J'Trying ',baudrate,' BAUD: ');
  736.       setparam (configset.useco,baudrate,parity);
  737.       sendstring ('Hit Return: ');
  738.       delay (40);
  739.       if numchars > 0 then if k = #13 then goto connected;
  740.       autoswitch:=seconds + 3;
  741.       if autoswitch > 59 then autoswitch:=autoswitch - 60;
  742.       repeat
  743.        k:=#0;
  744.        if keyhit then k:='A' else
  745.        if numchars > 0 then k:=getchar;
  746.        if not carrier then exit;
  747.       until (k <> #0) or (timer >= timeout) or (autoswitch = seconds);
  748.       if timer >= timeout then hangupmodem;
  749.       if not carrier then goto abort;
  750.       if keyhit then begin
  751.         k:=bioskey;
  752.         case upcase(k) of
  753.          #13:goto connected;
  754.          'D':goto abort;
  755.         end
  756.       end else if k <> #0 then begin
  757.         b:=ord(k);
  758.         write (usr,b,' received.');
  759.         if b = 13 then parity:=false else
  760.         if b = 141 then parity:=true;
  761.       end else b:=0;
  762.     until (b=13) or (b=141) or (timer>timeout);
  763.     if timer<=timeout then begin
  764.       connected:
  765.       totalsent:=0;
  766.       totalrece:=0;
  767.       connectbaud:=baudrate;
  768.       if (configset.defbaudrat>=9600) then baudrate:=configset.defbaudrat;
  769.             setparam(configset.useco,baudrate,parity);
  770.             baudstr:=strr(connectbaud);
  771.                         If baudrate>4800 then Speed:=True;
  772.             if (connectbaud=38400) then baudstr:='38400';
  773.             online:=true;
  774.             urec.config:=[lowercase,linefeeds,eightycols];
  775.             clearscr;
  776.             textcolor(configset.normbotcolo);
  777.             initwinds;
  778.                         if configset.useansidetect then Begin
  779.             writeln('Detecting Graphics Mode (One Moment)');
  780.             getansimode;
  781.             if ansigraphics in urec.config then WriteLn(^R'Ansi Graphics Enabled..')
  782.             else WriteLn('Ansi Graphics Disabled..');
  783.                         End;
  784.             if pos('ARQ',Matrix)>0 then BaudStr:=BaudStr+'/ARQ';
  785.             if pos('HST',Matrix)>0 then BaudStr:=BaudStr+'/HST';
  786.             if pos('42',Matrix)>0 then BaudStr:=BaudStr+'/V.42';
  787.                         If ansigraphics in urec.config then Begin
  788.                         ClearScr;
  789.                         goxy(1,14);ANSiColor(15);
  790.           WRiTE ('            ViSiON / Lock at '+baudstr+' 8,N,1 on '+DateStr(Now)+' at '+Timestr(Now));
  791.           GoXy(1,14);ANSiColor(7);Delay(500);
  792.           Write ('            ViSiON / Lock at '+baudstr+' 8,N,1 on '+DateStr(Now)+' at '+TimeStr(Now));
  793.           GoXy(1,14);AnsiColor(8);Delay(500);
  794.           Write ('            ViSiON / Lock at '+baudstr+' 8,N,1 on '+DateStr(Now)+' at '+TimeStr(Now));
  795.           ClearScr;
  796.           End;
  797.         If ansigraphics in urec.config then
  798.     writeln (^M^M^R'■ '^F'Connected at '^S,baudstr,' 8,N,1',^R' ■',^M);
  799.         If exist(configset.forumdi+'LOGON.BAT') then
  800.           exec(getenv('COMSPEC'), '/C LOGON.BAT');
  801.         If (configset.defbaudrat>=9600) and (Speed) then Begin
  802.              If configset.defbaudrat=19200 then Begin
  803.              WRiteLn(^S'Locking Com Port at '^U'19200'^S' Baud...');
  804.              setparam(configset.useco,19200,parity);
  805.              Delay(1000);
  806.              WriteLn(^P'Done!'^M^M);
  807.            End;
  808.            If (configset.defbaudrat=38400) and (Speed) then Begin
  809.              WriteLn(^S'Locking Com Port at '^U'38400'^S' Baud...');
  810.              setparam(configset.useco,38400,parity);
  811.              Delay(1000);
  812.              WRiteLn(^P'Done!'^M^M);
  813.            End;
  814.            End;
  815.     newcalls:=newcalls+1;
  816.       if not suporterd then hangup;
  817.       if carrier then exit
  818.     end;
  819.     abort:
  820.     disconnect
  821.   end;
  822.   end;
  823.   end;
  824.  
  825.   procedure exitprog;
  826.   begin
  827.         doanswer;
  828.     window (1,1,80,25);
  829.     textmode(co80);
  830.     textcolor (15);
  831.     textbackground (0);
  832.     clrscr;
  833.     gotoxy (1,10);
  834.     writeln(usr,'                          ViSiON BBS Systems v',versionnum);
  835.     writeln(usr,'                       (c) 1991 Ruthless Enterprises');
  836.     writeln(usr,^M'                          Written by Crimson Blade');
  837.     writeln(usr,'');
  838.     writeln(usr,'     Call Countdown To Chaos at 619/868-2025 for Comments or Suggestions!');
  839.     gotoxy(1,24);
  840.     ensureclosed;
  841.     closeport;
  842.     halt(4)
  843.   end;
  844.  
  845.  
  846.  
  847.   procedure checkday;
  848.   begin
  849.     if lastdayup<>datestr(now) then begin
  850.       lastdayup:=datestr(now);
  851.       numdaysup:=numdaysup+1;
  852.       callstoday:=0;
  853.       writestatus
  854.     end
  855.   end;
  856.  
  857.   procedure dotimedevent;
  858.   var tf:text;
  859.   begin
  860.     window (1,1,80,25);
  861.     clrscr;
  862.     writeln (usr,'Executing timed event: ',configset.eventbatc);
  863.     writeln (usr);
  864.     assign (tf,'Door.bat');
  865.     rewrite (tf);
  866.     writeln (tf,configset.eventbatc);
  867.     textclose (tf);
  868.     timedeventdate:=datestr(now);
  869.     ensureclosed;
  870.     closeport;
  871.     halt (3)
  872.   end;
  873.  
  874.   procedure donetevent;
  875.   var c:Char;
  876.   begin
  877.        window(1,1,80,25);
  878.        clrscr;
  879.        WriteLn(Usr,'First we must delay netmail for EXACTLY 2 Minutes.');
  880.        delay(60000);
  881.        delay(60000);
  882.        if keypressed then c:=readkey;
  883.        ClrScr;
  884.         writeln(usr,'Executing Net Mail');
  885.          neteventdate:=datestr(now);
  886.          writestatus;
  887.        do_net_mail;
  888.   end;
  889.  
  890.   function statusscreen:char;
  891.   const statwindx=5;
  892.         statwindy=1;
  893.         firstcolx=15;
  894.         firstline=5;
  895.         secondcolx=54;
  896.  
  897.     procedure percent (r1,r2:real);
  898.     begin
  899.       if (r2<1) then exit;
  900.       r2:=round((r1/r2)*1000)/10;
  901.       writeln (usr,r2:0:1,'%')
  902.     end;
  903.  
  904.  
  905.  
  906.  
  907.  
  908.     procedure drawstatus;
  909.     var totalidle,totalup,totalmins,r:real;
  910.         tmp:integer;
  911.         kk1,kk2,kk3,kkf:Byte;
  912.  
  913. (*     Procedure FiXkkk;
  914.      Begin
  915.      kkf:=kk1; kk1:=kk2; kk2:=kk3; kk3:=kk1;
  916.      end;
  917.  
  918.     Procedure DopeFiEND;
  919.      Begin
  920.        Gotoxy(5,2);
  921.        if kkf=0 then FiXkkk;
  922.        Textattr:=kk1;
  923.        Write(Usr,'Vi'); Textattr:=kk2;
  924.        Write(Usr,'Si'); Textattr:=kk3;
  925.        Write(Usr,'ON'); Textattr:=kk4;
  926.        Write(Usr,' v'); Textattr:=kk5;
  927.        Write(Usr,'0.'); Textattr:=kk1;
  928.        Write(Usr,'81'); Textattr:=kk2;
  929.        kkk:=kk5;
  930.        kk5:=kk4; kk4:=kk3; kk3:=kk2; kk2:=kk1; kk1:=kkk;
  931.      End;
  932.  
  933.      Procedure Trippin;
  934.       Procedure fix_ss;
  935.       begin
  936.       ss1:=15; ss2:=7; ss3:=8;
  937.       end;
  938.  
  939.      Begin
  940.       if ss1=0 then fix_ss;
  941.        gotoxy(9,3); Textattr:=ss1; Write('∙');
  942.        gotoxy(5,1); Textattr:=ss2; Write('∙');
  943.        gotoxy(9,4); Textattr:=ss3; Write('∙');
  944.        gotoxy(7,1); Textattr:=ss1; Write('∙');
  945.        gotoxy(3,3); Textattr:=ss2; Write('∙');
  946.        gotoxy(12,4); Textattr:=ss3; Write('∙');
  947.        gotoxy(13,1); Textattr:=ss1; Write('∙');
  948.        gotoxy(10,3); Textattr:=ss2; Write('∙');
  949.        ssb:=ss3; ss3:=ss2; ss2:=ss1; ss1:=ssb;
  950.        ansicolor(14);
  951.       end; *)
  952.  
  953.     begin
  954.       if not match(getenv('DSZLOG'),configset.dszlog) then begin
  955.         gotoxy(12,24);
  956.         write(usr,'[ You MUST put SET DSZLOG='+configset.dszlog+' in your KEEPUP.BAT! ]');
  957.       end;
  958.       tmp:=timetillevent;
  959.       if tmp<=30 then begin
  960.         gotoxy (23,1);
  961.         write (usr,'[ Timed event scheduled in ',tmp,' minutes! ');
  962.         if tmp<10 then write(usr,' ');
  963.         write(usr,']');
  964.         if tmp<=5 then begin
  965.     dontanswer;
  966.           if tmp<=2 then dotimedevent
  967.         end
  968.     end;
  969.       tmp:=timetillnet;
  970.       if length(configset.netstc)=0 then tmp:=1500;
  971.       if tmp<=30 then begin
  972.         gotoxy(23,1);
  973.         write(usr,'[ Net-Mail Scheduled in ',tmp,' minutes! ');
  974.         if tmp<10 then write(usr,' ');
  975.         write(usr,']');
  976.          if tmp<=5 then begin
  977.            dontanswer;
  978.            if tmp<=1 then donetevent;
  979.          end
  980.       end;
  981.       if carrier or keyhit then exit;
  982.       tmp:=elapsedtime (wasted);
  983.       if (tmp>5) and ConfigSet.SaveScreen then Begin
  984.          If Not SaveScreenOn then ClrScr;
  985.          if Not SaveScreenOn then Begin
  986.           kk1:=8; kk2:=7; kk3:=15;
  987.           End;
  988.          SaveScreenOn:=True;
  989.          kkf:=kk1; kk1:=kk2; kk2:=kk3; kk3:=kkf;
  990.          ScreenColor:=kk1;
  991.          TextColor(8);
  992.          Gotoxy(1,25);
  993.          Write(Usr,'ViSiON Screen Saver - F7 Redraws');
  994.          TextColor(1);
  995.       End Else Begin
  996.       gotoxy(57,9);
  997.       Write (usr,numminsused.total:0:0);
  998.       gotoxy(57,13);
  999.       write (usr,tmp);
  1000.       gotoxy (57,10);
  1001.       write (usr,numdaysup);
  1002.       r:=round(10*numcallers/numdaysup)/10;
  1003.       gotoxy(57,12);
  1004.       writeln (usr,r:0:1);
  1005.       gotoxy(23,10);
  1006.       writeln (usr,timestr(now),' ');
  1007.       gotoxy(23,11);
  1008.       write (usr,datestr(now),'  ');
  1009.       gotoxy (22,0);
  1010.       maybewritestatus
  1011.     end;
  1012.     End;
  1013.  
  1014. procedure CursorOff;
  1015.   var regs:registers;
  1016.     begin
  1017.       Regs.AH :=1;
  1018.           Regs.CH :=32;
  1019.       Regs.CL :=0;
  1020.       intr ($10,Regs);
  1021.     end;
  1022.  
  1023. procedure CursorOn;
  1024.   var regs:registers;
  1025.     begin
  1026.     Regs.AH:=1;
  1027.       Regs.CH:=6;
  1028.       Regs.CL:=7;
  1029.       intr ($10,Regs);
  1030.     end;
  1031.  
  1032.     procedure writeavail;
  1033.     var m:lstr;
  1034.     begin
  1035.       gotoxy (23,12);
  1036.       m:=sysopavailstr;
  1037.       write ('            ');
  1038.       gotoxy (23,12);
  1039.       write (usr,m);
  1040.       gotoxy (1,1)
  1041.     end;
  1042.  
  1043.   var cnt,numsmail:integer;
  1044.       k:char;
  1045.       tmp:mstr;
  1046.       b:byte;
  1047.       done:boolean;
  1048.  
  1049.     function shouldexit:boolean;
  1050.     begin
  1051.     shouldexit:=done or carrier;
  1052.     end;
  1053.  
  1054.     procedure handlekey (k:char; beforeabout:boolean);
  1055.     begin
  1056.       b:=ord(k)-128;
  1057.       case b of
  1058.         availtogglechar:begin
  1059.           toggleavail;
  1060.           if not beforeabout then writeavail
  1061.         end;
  1062.     120,121,122,123,124,125,126,127,128,59,60,61,62,63,64,65,66,67,68:begin
  1063.           done:=true;
  1064.           SaveScreenOn:=False;
  1065.           statusscreen:=k
  1066.         end
  1067.       end
  1068.     end;
  1069.  
  1070.     function interrupted (beforeabout:boolean):boolean;
  1071.     begin
  1072.      if keypressed then begin
  1073.      k:=bioskey;
  1074.      handlekey (k,beforeabout)
  1075.      end;
  1076.      done:=done or carrier;
  1077.       interrupted:=done
  1078.     end;
  1079.  
  1080. {$I WFC.PAS}
  1081.  
  1082.     procedure sendstring (x:lstr);
  1083.     var cnt:integer;
  1084.         k:char;
  1085.     begin
  1086.       for cnt:=1 to length(x) do begin
  1087.                 sendchar(x[cnt]);
  1088.         delay (20);
  1089.       end;
  1090.             delay (50);
  1091.             repeat k:=getchar until numchars=0;
  1092.     end;
  1093.  
  1094.     procedure phonesringing;
  1095.     begin
  1096.       sendstring ('  ATA'#13)
  1097.     end;
  1098.  
  1099.     procedure connectcode (k:char);
  1100.     var timer:word absolute $40:$6c;
  1101.         t:word;
  1102.         k2:char;
  1103.         bd:baudratetype;
  1104.     begin
  1105.       t:=timer+18;
  1106.       repeat
  1107.       until (timer>t) or carrier or (numchars>0);
  1108.       case k of
  1109.         '1':case k2 of
  1110.               #0:bd:=b300;
  1111.               '0':bd:=b2400;
  1112.               else exit
  1113.             end;
  1114.         '5':bd:=b1200;
  1115.         else exit
  1116.       end;
  1117.       if bd in configset.supportedrate then begin
  1118.         parity:=false;
  1119.         baudrate:=baudarray[bd];
  1120.         mustgetbaud:=false;
  1121.         t:=timer+18;
  1122.     repeat until carrier or (timer>t)
  1123.       end
  1124.     end;
  1125.  
  1126.    procedure writefreespace;
  1127.     var r:registers; tempfree:real; lp:integer; total:real;
  1128.         csize:real;
  1129.  
  1130.     function unsigned (i:integer):real;
  1131.     begin
  1132.     if i>=0 then unsigned:=i else unsigned:=65536.0+i
  1133.     end;
  1134.  
  1135.     begin
  1136.     total:=0;
  1137.     for lp:=3 to 15 do begin
  1138.  
  1139.       r.ah:=$1c;
  1140.       r.dl:=lp;
  1141.       intr ($21,r);
  1142.  
  1143.       if mem[r.ds:r.bx]=$f8 then begin
  1144.           r.ah:=$36;
  1145.           r.dl:=lp;
  1146.           intr ($21,r);
  1147.           csize:=unsigned(r.ax)*unsigned(r.cx);
  1148.           tempfree:=(csize*unsigned(r.bx))/1000;
  1149.           total:=total+tempfree/1000;
  1150.           gotoxy(57,15);
  1151.             write(usr,streal(total)+' Megz ');
  1152.             end;
  1153.  
  1154.             end;
  1155.         end;
  1156.  
  1157. var tempoct:integer;
  1158.   begin
  1159.     updatenodestatus('■ Waiting For Call ■');
  1160.     while numchars > 0 do k:=getchar;
  1161.     statusscreen:=#0;
  1162.     window(1,1,80,25);
  1163.     done:=false;
  1164.     If Not SaveScreenOn then textcolor (15);
  1165.     clrscr;
  1166.     wasted.started:=false;
  1167.     wasted.startedat:=timer;
  1168.     wasted.total:=0;
  1169.     starttimer(wasted);
  1170.     gotoxy(0,0);
  1171.     if interrupted (true) then exit;
  1172. If Not SaveScreenOn then Begin
  1173. CursorOff;
  1174. DrawWFC;
  1175.     if interrupted (true) then exit;
  1176.     textcolor(12);
  1177.     writefreespace;
  1178.     gotoxy (1,1);
  1179.     textcolor (configset.normtopcolo);
  1180.     gotoxy(3,21);
  1181.     if registo = '■╣┬æN╟' then write ('[ Evaluation Copy ]') else
  1182.     write(usr,registo);
  1183.     gotoxy(3,23);
  1184.     textcolor(configset.normtopcolo);write(usr,registb);
  1185.     textcolor(14);
  1186.     gotoxy(51,16);
  1187.     write(usr,getlastcaller);
  1188.     gotoxy (23,14);
  1189.     numsmail:=getnummail(1)+numfeedback;
  1190.     writeln (usr,numsmail);
  1191.     gotoxy(57,11);
  1192.     write (usr,callstoday:0);
  1193.     gotoxy (57,8);
  1194.     writeln (usr,newcalls);
  1195.     gotoxy(23,16);
  1196.     write (usr,newposts);
  1197.     writeavail;
  1198.     gotoxy (1,1);
  1199.     gotoxy (23,17);
  1200.     writeln (usr,newuploads);
  1201.     gotoxy(23,13);
  1202.     writeln (usr,newfeedback);
  1203.     gotoxy(23,15);
  1204.     write (usr,newmail);
  1205.     End;
  1206.     repeat
  1207.       checkday;
  1208.       drawstatus;
  1209.       cnt:=0;
  1210.       repeat
  1211.         while configset.hashaye and (not carrier) and (numchars>0) do begin
  1212.      k:=getchar;
  1213.       case k of
  1214.       '2':phonesringing;
  1215.       '1','5':connectcode (k)
  1216.        end
  1217.       end;
  1218.      cnt:=cnt+1
  1219.      until (cnt>=10000) or interrupted (false) or done
  1220.     until done;
  1221.       CursorOn;
  1222.   end;
  1223.  
  1224. procedure gotodos;
  1225.   var status:word;
  1226.       tmp1:integer;
  1227.       st:mstr;
  1228.   begin
  1229.     ansicolor(15);
  1230.     window (1,1,80,25);
  1231.     gotoxy (1,25);
  1232.        clrscr; textcolor(1);
  1233.        write(usr,'««');
  1234.        Textcolor(11); Write(usr,' ViSiON Dos Shell');
  1235.        Textcolor(1); WriteLn(usr,' »»');
  1236.        Textcolor(14);
  1237.        write(usr,'Type ''');
  1238.        textcolor(10); Write(usr,'EXIT');
  1239.        Textcolor(14); WriteLn(usr,''' to return.');
  1240.        if not configset.maximumdosshell then begin
  1241.         swapvectors;
  1242.         exec(getenv('COMSPEC'),'');
  1243.         swapvectors;
  1244.        End Else Begin
  1245.          Textcolor(5);
  1246.          Write(Usr,'Allocated ');
  1247.          Textcolor(13);
  1248.          Write(usr,bytesswapped);
  1249.          Textcolor(5); WriteLn(usr,' bytes ',swaploc[EmsAllocated]);
  1250.          SwapVectors;
  1251.          Status:=ExecWithSwap(GetEnv('Comspec'),'');
  1252.          SwapVectors;
  1253.         End;
  1254.        st:=configset.forumdi;
  1255.        if st[length(st)]='\' then st[length(st)]:=#0;
  1256.        chdir(st);
  1257.     ClrScr;
  1258.   end;
  1259.  
  1260. procedure runconfig;
  1261. var status:word;
  1262. begin
  1263.  if configset.forumdi[length(configset.forumdi)]<>'\' then configset.forumdi:=configset.forumdi+'\';
  1264.  swapvectors;
  1265.  exec(getenv('COMSPEC'), '/C CONFIG.EXE');
  1266.  swapvectors;
  1267.  readconfig;
  1268. end;
  1269.  
  1270. procedure alt(i:integer);
  1271. begin
  1272. window(1,1,80,25);
  1273. clrscr;
  1274. ensureclosed;
  1275. closeport;
  1276. textmode (co80);
  1277. halt(i);
  1278. end;
  1279.  
  1280. var k:char;
  1281. label exit;
  1282. begin
  1283.   waitforacall:=false;
  1284.   SaveScreenOn:=False;
  1285.   aa:='sp';
  1286.   bb:='oo';
  1287.   setparam (configset.useco,configset.defbaudrat,false);
  1288.   setupmodem;
  1289.   starttimer (numminsidle);
  1290.   wscount:=0;
  1291.   local:=false;
  1292.   cc:='in';
  1293.   dd:='!?';
  1294.   ff:=aa+bb+cc+dd;
  1295.   clrscr;
  1296.   repeat
  1297.     doanswer;
  1298.     mustgetbaud:=true;
  1299.     k:=statusscreen;
  1300.     if carrier then begin
  1301.       receivecall;
  1302.       if carrier then goto exit;
  1303.     end;
  1304.     case ord(k)-128 of
  1305.       59:begin
  1306.               ensureclosed;
  1307.               closeport;
  1308.               alt(11);
  1309.          end;
  1310.       64:do_net_mail;
  1311.       61:begin
  1312.               sendchar('A');
  1313.               delay(20);
  1314.               sendchar('T');
  1315.               delay(20);
  1316.               sendchar('A');
  1317.               delay(20);
  1318.               sendchar(#13);
  1319.               delay(20);
  1320.        end;
  1321.        62:begin
  1322.           sendchar('A');
  1323.           delay(20);
  1324.           sendchar('T');
  1325.           delay(20);
  1326.           sendchar('H');
  1327.           delay(20);
  1328.           sendchar('1');
  1329.           delay(20);
  1330.           sendchar(' ');
  1331.           delay(20);
  1332.           sendchar('M');
  1333.           delay(20);
  1334.           sendchar('0');
  1335.           delay(20);
  1336.           sendchar(#13);
  1337.           delay(20);
  1338.           local:=true;
  1339.           online:=false;
  1340.           unum:=1;
  1341.           readurec;
  1342.           clrscr;
  1343.           settimeleft(500);
  1344.           emailmenu;
  1345.           seek(ufile,unum);
  1346.           writeurec;
  1347.           ensureclosed;
  1348.           alt(0);
  1349.           end;
  1350.        63:begin
  1351.           ClearScr;
  1352.           Write(usr,'Would You Like To Go OFF-HOOK? [y/N]: ');
  1353.           WriteStr('*');
  1354.           if yes then Begin
  1355.           sendchar('A');
  1356.           delay(20);
  1357.           sendchar('T');
  1358.           delay(20);
  1359.           sendchar('H');
  1360.           delay(20);
  1361.           sendchar('1');
  1362.           delay(20);
  1363.           sendchar(' ');
  1364.           delay(20);
  1365.           sendchar('M');
  1366.           delay(20);
  1367.           sendchar('0');
  1368.           delay(20);
  1369.           sendchar(#13);
  1370.           delay(20);
  1371.           end;
  1372.           local:=true;
  1373.           online:=false;
  1374.           unum:=1;
  1375.           readurec;
  1376.           clrscr;
  1377.           settimeleft(500);
  1378.           mainsysopcommands;
  1379.           seek(ufile,unum);
  1380.           writeurec;
  1381.           ensureclosed;
  1382.           alt(0);
  1383.         end;
  1384.       120:alt(110);
  1385.       121:alt(111);
  1386.       122:alt(112);
  1387.       123:alt(113);
  1388.       124:alt(114);
  1389.       125:alt(115);
  1390.       126:alt(116);
  1391.       127:alt(117);
  1392.       128:alt(118);
  1393.       66:gotodos;
  1394.       67:runconfig;
  1395.       68:begin
  1396.            doanswer;
  1397.            ClearScr;
  1398.            Write(usr,'Would You Like To Go OFF-HOOK? [y/N]: ');
  1399.            WriteStr('*');
  1400.            if yes then Begin
  1401.            sendchar('A');
  1402.            delay(20);
  1403.            sendchar('T');
  1404.            delay(20);
  1405.            sendchar('H');
  1406.            delay(20);
  1407.            sendchar('1');
  1408.            delay(20);
  1409.            sendchar(' ');
  1410.            delay(20);
  1411.            sendchar('M');
  1412.            delay(20);
  1413.            sendchar('0');
  1414.            delay(20);
  1415.            sendchar(#13);
  1416.            delay(100);
  1417.            end;
  1418.            local:=true;
  1419.            online:=false;
  1420.            newfeedback:=0;
  1421.            newuploads:=0;
  1422.            newcalls:=0;
  1423.            newposts:=0;
  1424.            newmail:=0;
  1425.            writestatus;
  1426.            goto exit
  1427.          end;
  1428.     60:begin
  1429.        ClrScr;
  1430.        Write(usr,'Would You like to go OFF-HOOK? [y/N]: ');
  1431.        WriteStr('*');
  1432.        If yes then begin
  1433.           sendchar('A');
  1434.            delay(20);
  1435.            sendchar('T');
  1436.            delay(20);
  1437.            sendchar('H');
  1438.            delay(20);
  1439.            sendchar('1');
  1440.            delay(20);
  1441.            sendchar(' ');
  1442.            delay(20);
  1443.            sendchar('M');
  1444.            delay(20);
  1445.            sendchar('0');
  1446.            delay(20);
  1447.            sendchar(#13);
  1448.            delay(100);
  1449.        End;
  1450.        exitprog;
  1451.     end;
  1452.     end
  1453.   until 0=1;
  1454.   exit:
  1455.   textcolor (configset.normbotcolo);
  1456. end;
  1457.  
  1458. begin
  1459. end.
  1460.