{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }

unit waitcall;

interface

uses dos,crt,windows,userret,mainmenu,main,email,
     gentypes,statret,configrt,modem,gensubs,subs1,subs2,mailret,
     overret1,mainr1,mainr2,textret,ExecSwap;

var wasted:minuterec;

Const SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS');

function waitforacall:boolean;
function suporterd:boolean;

implementation

Procedure Do_Net_Mail;               (* ViSiON NetMail Version 1.01 *)
Var NodeRec:NodeNetRec;
    CurrentNodeNumber,NumMsgs:Integer;
    Fnode:File of NodeNetRec;
    chrr:Char;
    simplex:boolean;
    jo:integer;
    finished:boolean;
    oktosend:BooLean;

  Function FindBaseName(BaseId:Byte):SStr;
  Var Board:BoardRec;
      Fbd:File of BoardRec;
      Sek:Integer;
  Begin           (* Echo should equal baseId *)
      Assign(Fbd,ConfigSet.BoardDi+'BoardDir');
      Reset(Fbd);
      Sek:=0;
      FindBaseName:='';
      Repeat
        Seek(Fbd,Sek);
        Read(Fbd,Board);
        Inc(Sek);
        If Board.Echo=BaseId then FindBaseName:=Board.ShortName;
      Until (Board.Echo=BaseId) or Eof(Fbd);
      Close(Fbd);
  End;             (* End FindBaseName *)

  Procedure SendString(S:Lstr);
  Var I:Integer;
  Begin
       For I:=1 to Length(S) Do SendChar(S[I]);
  End;     (* End Send String *)

  procedure UpDateStory(Nums:Integer; Sent,Upgraded:Boolean);
  Var T:Text;
  Begin
		appendfile(configset.forumdi+'Notices.BBS',t);
		WriteLn(T,^M^S'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
    WriteLn(T,^R'             On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened');
    if not Sent then WriteLn(T,^R'('+Strr(Nums)+') Messages were sent to '+NodeRec.Name)
    else WriteLn(T,^R'('+Strr(Nums)+') Messages were received from '+NodeRec.Name);
    If Upgraded then WriteLn(T,^R'An Upgrade was received with this packet!');
    WriteLn(T,^S'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'^M);
    TextClose(T);
  End;      (* End UpdateStory *)

  Procedure GetItAll;
  Var C:Char;
  Begin
   While NumChars>0 do
   write(usr,getchar);
  End;                    (* End GetItAll *)


  Procedure SetUpForNetMail;
  Begin
    ClrScr;
    WriteLn(Usr,'ViSiON Netmail version 1.01 (c) 1991 Ruthless Enterprises.');
    If Not Exist(ConfigSet.ForumDi+'NodeList.BBS') then
       Begin
         WriteLn(Usr,'We WOULD send NetMail, BUT there seems to be no one to net with. MAKE');
         WriteLn(Usr,'your NODELIST.BBS file BEFORE trying to attempt netmail!');
         EnsureClosed;
         Halt(0);
       End;      (* End If then Begin *)
    WriteLn(Usr,'First we must disable Auto-Answer!');
    SendString('ATZ'+#13);
    Delay(1500);
    GetItAll;
    SendString('ATS0=0'+#13);
    Delay(500);
    GetItAll;
    WriteLn(Usr,'Now we will go ahead and set the Extended Registers to recognize everything.');
    SendString('ATX6'+#13);
    Delay(500);
    GetItAll;
    WriteLn(Usr,'Now we will open up the Node List file.');
    Assign(Fnode,Configset.ForumDi+'NodeList.BBS');
    Reset(Fnode);
    CurrentNodeNumber:=0;
    WriteLn(Usr,'There. All done.');
  End;                  (* End SetUpForNetMail *)

  Procedure DialNodes;
  Var Packaged:Boolean;


       Function Connected:Boolean;
       Var C:Char;
           S:String;
       Begin
         Delay(9000);
         S:='';
				 While NumChars>0 Do
				 Begin
					 S:=S+getchar;
           If C=#13 then S:='';
           If Pos('[Enter]',S)>0 Then
           Begin
             WriteLn(Usr,'We MUST hit return!');
             SendString(#13+#13+#13+#13);
             S:='';
           End;    (* End If then *)
         End;      (* End Repeat Loop *)
         If Carrier then Connected:=True;
       End;         (* End Connected *)

   Procedure DialNode;

       Procedure PrepNetMail;
       Var Ct,Loper:Integer;
       NetPost:NetPostRec;
       FNP:File of NetPostRec;
       Bul:BulRec;
       M:Message;
       Bfile:File of BulRec;
       BaseName:SStr;
       CurBase:Byte;

       Procedure Package;
       Begin
       ClrScr;
       WriteLn(Usr,'Making NetMail Package as per request.');
       CurBase:=0;
       NumMsgs:=0;
       Assign(Fnp,Configset.NetDir+'NetMail.Pkg');
       ReWrite(Fnp);
       Loper:=0;
       While Loper<255 Do
        Begin
           Inc(Loper);
           If NodeRec.BaseSelection[Loper] Then Begin
           BaseName:=FindBaseName(Loper);
           If BaseName<>'' then Begin
           Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL');
           Reset(Bfile);
           Ct:=0;
         While Not Eof(Bfile) Do
           Begin
             Seek(Bfile,Ct);
             Read(Bfile,Bul);
             If Bul.When>NodeRec.LastDate Then
               Begin
               Inc(NumMsgs);
               NetPost.NetIdNum:=Loper;
               NetPost.BulletinRec:=Bul;
               ReloadText(Bul.Line,M);
               NetPost.MessageRec:=M;
               Seek(Fnp,FileSize(Fnp));
               Write(Fnp,NetPost);
               End; (* If Bul.When>NodeRec.LastDate *)
             Inc(Ct);
           End;  (* End While Not Eof *)
         Close(Bfile);
         End;         (* End if basename<>'' *)
         End;         (* End if basethingie *)
       End;           (* End Loper *)
       Close(Fnp);
      End;            (* End Package *)

      Procedure ZipPackage;
      Var F:File;
      Begin
           Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg');
           Assign(F,ConfigSet.NetDir+'NetMail.Pkg');
           Erase(F);
           Close(F);
      End;          (* End ZipPackage *)


      Begin
        Package;
        If NumMsgs>0 Then Begin
        ZipPackage;
        Packaged:=True;
        End;
      End;                    (* End SendOutGoing *)

       Function Call(X:Lstr):Boolean;
       Var Pre,Suf:Lstr;
           Jo:Integer;
           Finished:Boolean;

           Function Busy:Boolean;
           Var K:String;
               C:Char;
           Begin
                K:='';
								While NumChars>0 do k:=k+getchar;
                Busy:=False;
                If Pos('BUSY',K)>0 then Busy:=True;
                If Pos('NO CARRIER',K)>0 Then Busy:=True;
                If Pos('NO DIAL',K)>0 Then Busy:=True;
           End;    (* End Busy *)


       Begin
            ClrScr;
            WriteLn(Usr,'Dialing Number...');
            If X='' then Exit;
            dontanswer;
            Delay(1500);
            Pre:='';
            Suf:='';
            If Length(X)>7 then
               Begin
                    Pre:=ConfigSet.CoPre;
                    Suf:=ConfigSet.CoSuf;
               End;
            If KeyPressed then Chrr:=ReadKey;
            DoAnswer;
            Delay(1200);
            SendString('     ');
            Delay(1600);
            GetItAll;
            SendString('ATDT'+Pre+X+Suf+#13);
            Finished:=False;
            delay(1500);
            GetItAll;
            Jo:=0;
            Repeat
                  Inc(Jo);
                  Delay(10);
                  If Busy then Finished:=True;
                  If Finished then WriteLn(Usr,'Line was busy!'^M);
                  If KeyPressed then Finished:=True;
                  If KeyPressed then WriteLn(Usr,'User Abort!');
                  If Carrier then Finished:=True;
            Until Finished or (Jo>15000);
            SendString(^M);
            Call:=Carrier;
       End;         (* End Call *)


    Begin
       PrepNetMail;
       Window(1,1,80,25);
       ClrScr;
       TextColor(15);
       WriteLn(Usr,'ViSiON NetMail Dialing '+NodeRec.Name+' @'+NodeRec.Phone);
       TextColor(11);
       WriteLn(Usr,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
       TextColor(7);
       Window(1,3,80,25);
       Repeat
        delay(2500);
       Until Call(NodeRec.Phone) or
         (Not WithinTime(ConfigSet.NetStc,Configset.NetEnc));
    End; (* End DialNode *)

  Function SuccessfulNetMail:Boolean;
  Var T:Text;
      Received:Boolean;
      F:File;
      I:Integer;

  Procedure SendViaDSZ;
  Begin
  Delay(3000);
  Exec('Dsz.Com',' port '+Strr(Configset.UseCo)+' speed '+strlong(baudrate)+' ha slow sz -m '+Configset.NetDir+'Net.Zip');
    Assign(F,ConfigSet.NetDir+'Net.Zip');
    Erase(F);
    updatestory(NumMsgs,False,False);
    NumMsgs:=0;
  End;                   (* End SendViaDSZ *)

	Function ExecDsz:Boolean;
	var ken:char;
	Begin
			 If Exist(ConfigSet.WorkDir+'Net.Zip') then
				 Begin
					 Assign(F,ConfigSet.WorkDir+'Net.Zip');
					 Erase(F);
				 End;       (* End If Then *)
			 Delay(500);
			 GetItAll;
			 Repeat
			 Until (NumChars>0) or (Not Carrier);
  Exec('Dsz.Com',' port '+Strr(ConfigSet.UseCo)+' speed '+strlong(baudrate)+' ha slow rz -m '+ConfigSet.WorkDir+'Net.Zip');
       ExecDsz:=True;
  End;

  Procedure ProcessIncomming;
  Var Fnp:File of NetPostRec;
      NetPost:NetPostRec;
      M:Message;
      B:BulRec;
      Bfile:File of BulRec;
      Upgrade,oktosend:Boolean;

      Procedure UnZipNet;
      Var F:File;
      Begin
           SwapVectors;
           Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir);
           Assign(F,Configset.WorkDir+'Net.Zip');
           Erase(F);
           Close(F);
      End;          (* End UnZipNet *)

      Procedure PostMsgs;
      Var F:File;
          TId:Word;
          Current:Byte;
          BaseName:Sstr;
      Begin
           ClrScr;
           Upgrade:=False;
           WriteLn(Usr,'Posting NetMail Messages.');
           If Exist(ConfigSet.WorkDir+'Upgrade.Zip') then
           Begin
             Upgrade:=true;
             Exec(GetEnv('ComSpec'),'/C Copy '+ConfigSet.WorkDir+'Upgrade.Zip '+
             ConfigSet.NetType1Path+'Upgrade.Zip > NUL');
             Assign(F,ConfigSet.WorkDir+'Upgrade.Zip');
             Erase(F);
             Close(F);
           End;
           If Exist(ConfigSet.WorkDir+'NetMail.Pkg') Then
              Begin
                 Assign(Fnp,Configset.WorkDir+'NetMail.Pkg');
                 Reset(Fnp);
                 NumMsgs:=0;
                 Current:=0;
                 While Not Eof(Fnp) Do
                   Begin
                     Read(Fnp,NetPost);
                     If Current<>NetPost.NetIdNum Then Begin
                        BaseName:=FindBaseName(NetPost.NetIdNum);
                        Close(Bfile);
                        If BaseName<>'' Then Begin
                           Assign(Bfile,ConfigSet.BoardDi+BaseName+'.Bul');
                           Reset(Bfile);
                        End;   (* End if basename<>'' *)
                     End;      (* End if current<>netpost.netidnum *)
                   If NetPost.BulletinRec.Where=ConfigSet.Origin1 Then Else
                      Begin
                        Seek(Bfile,FileSize(BFile)-1);
                        Read(Bfile,B);
                        If B.Id=65535 then NetPost.BulletinRec.Id:=1 Else
                            NetPost.BulletinRec.Id:=B.Id+1;
                        B:=NetPost.BulletinRec;
                        M:=NetPost.MessageRec;
                        B.Line:=MakeText(M);
                        B.When:=Now;
                        Seek(Bfile,FileSize(Bfile));
                        Write(Bfile,B);
                        Inc(NumMsgs);
                      End;           (* End if origin is here *)
                   End;              (* End While Not Eof Do Begin *)
                 Close(Fnp);
                 Assign(F,ConfigSet.WorkDir+'NetMail.Pkg');
                 Erase(F);
                NewPosts:=NewPosts+NumMsgs;
                Gnup:=Gnup+NumMsgs;
                WriteStatus;
              End;        (* End If Exist Msgs *)
      End;                (* End PostMsgs *)


      Begin         (* Main ProcessIncomming *)
           UnZipNet;
           PostMsgs;
           UpDateStory(NumMsgs,True,Upgrade);
      End;           (* End ProcessIncomming *)

  Procedure UpDateNode;
  Begin
       NodeRec.LastDate:=Now;
       Seek(Fnode,CurrentNodeNumber);
       Write(Fnode,NodeRec);
  End;                      (* End UpDateNode *)

  Begin
       If Not Carrier And Not WithinTime(ConfigSet.NetStc,ConfigSet.NetEnc) then
          Begin
               SuccessfulNetMail:=True;
               Exit;
          End;
       If Not Connected Then
          Begin
            SuccessfulNetMail:=False;
            WriteLn(Usr,'NetMail failed.. Why???');
            HangUp;
            Delay(1600);
            Exit;
          End;   (* End Delay *)
       SuccessfulNetMail:=False;
       SendString(ConfigSet.NetPas+#13);
       Delay(500);
       GetItAll;
       SendString(NodeRec.Node+#13);
       Delay(500);
       GetItAll;
       SendString(NodeRec.Pass+#13);
       Delay(500);
       GetItAll;
       Delay(1500);
       If Not Carrier then Begin
       Appendfile(ConfigSet.ForumDi+'Notices.BBS',t);
       WriteLn(T,'On '+DateStr(Now)+' at '+TimeStr(Now)+' we had the wrong password');
         WriteLn(T,'when we tried to send netmail to '+NodeRec.Name);
         TextClose(T);
         SuccessfulNetMail:=True;
       End;                      (* End if not carrier *)
       If ConfigSet.NetType1 then SendString('U'+#13);
       oktosend:=False;
       For I:=1 to 255 Do
           Begin
                If NodeRec.BaseSelection[I] Then SendString(Strr(I)+#13);
                If NodeRec.BaseSelection[I] then GetItAll;
                oktosend:=False;
           End;
       SendString('0'+#13);
       Delay(500);
       GetItAll;
       oktosend:=true;
       If Packaged then
          Begin
               SendString('Y'+#13);
               Delay(500);
               GetItAll;
               SendString('Y'+#13); (* This is the "Yes to receive" *)
               If oktosend then SendViaDSZ;
          End Else            (* End if packaged *)
       Begin
         SendString('N'+#13);
         Delay(500);
         GetItAll;
         SendString('Y'+#13); (* yes to receive *)
       end;
       Delay(1500);
       If Not Carrier then Begin
          SuccessfulNetMail:=False;
          Exit;
       End;    (* If Not Carrier *)
       Received:=ExecDsz;
       HangUp;
       If Received then ProcessIncomming;
       UpDateNode;
       SuccessfulNetMail:=True;
  End;                         (* End SuccessfulNetMail *)


  Begin
       While Not Eof(Fnode) Do
       Begin
       Seek(Fnode,CurrentNodeNumber);
       Read(Fnode,NodeRec);
       Repeat
             DialNode;
       Until SuccessfulNetMail;   (* End Loop *)
       Inc(CurrentNodeNumber);
       End;      (* End While Not EofFnode *)
  End;      (* End DialNodes *)

  Procedure ExitNetMail;
  Begin
    ClrScr;
    WriteLn(Usr,'Now we''re done.. Setting back on Auto Answer.');
    DoAnswer;
    SendString('ATZ'+#13);
    Delay(2500);
    GetItAll;
    SendString('ATS0=1'+#13);
    Delay(700);
    GetItAll;
  End;

Begin
     SetUpForNetMail;
     DialNodes;
     ExitNetMail;
     EnsureClosed;
     Halt(0);
End;             (* End Do_Net_Mail *)

function suporterd:boolean;
var brated:baudratetype;
    TempSprt:Boolean;
begin
     case connectbaud of
     300:brated:=b300;
     1200:brated:=b1200;
     2400:brated:=b2400;
     4800:brated:=b4800;
     9600:brated:=b9600;
     end;
 TempSprt:=true;
 if not (brated in configset.supportedrate) and (connectbaud<9600) then begin
    TempSprt:=False;
    if configset.LockOutBaudPass<>'' then begin
     WriteStr('Enter Lock-Out Baud password:');
     TempSprt:=Match(Input,Configset.LockOutBaudPass);
     End;
     If not TempSprt then writeln('Sorry, that baud rate is NOT supported!');
    delay(1500);
 end;
 Suporterd:=TempSprt;
end;

function waitforacall:boolean;

  var wscount:integer;
      ScreenColor:Byte;
      mustgetbaud,SaveScreenOn:boolean;

  procedure getansimode;
  Var T:String;
      c:char;
  Begin
    Delay(500);
    sendchar(#27);
    delay(15);
    sendchar('[');
    delay(15);
    sendchar('6');
    delay(15);
    sendchar('n');
    delay(15);
    delay(3700);
    T:='';
    While NumChars>0 do t:=t+getchar;
    If Pos('2;1R',T)>0 then
     begin
     urec.config:=urec.config+[Ansigraphics,AsciiGraphics];
     urec.statcolor:=configset.defstacolor;
     urec.regularcolor:=configset.defreg;
     urec.promptcolor:=configset.defpromp;
     urec.inputcolor:=configset.definput;
     end;
     If exist (configset.textfiledi+'MATRIX.NOW') then Begin
       Printfile(configset.textfiledi+'MATRIX.NOW');
       GoXy(1,22);
       WriteStr(^R'Press '^P'['^U'Enter'^P']'^S':*');
       End;
  End;

  procedure maybewritestatus;
  begin
    wscount:=wscount+1;
    if wscount>250 then begin
      writestatus;
      wscount:=0
    end
  end;

(***

  function checkforhayesreport:boolean;  { Looks for CONNECT 300 }
  var n:longint;
      q:sstr;
      p,b:integer;
      k:char;
      brate:baudratetype;
  const lookfor:sstr=#13#10'CONNECT ';
  begin
    checkforhayesreport:=false;
    if numchars=0 then exit;
    p:=1;
    q:='';
    b:=0;
    repeat
      n:=now;
      repeat until (now>n+1) or (numchars>0);
			k:=getchar;
      if (k=#13) and (length(q)>0) then begin
        val (q,b,p);
        brate:=b110;
        while (brate<=b9600) and
              ((b<>baudarray[brate])
                or (not (brate in supportedrates)))
              do brate:=succ(brate);
        if brate<=b9600 then begin
          parity:=false;
          baudrate:=b;
          checkforhayesreport:=true;
          mustgetbaud:=false;
          n:=now;
          repeat until carrier or (now>n+1)
        end;
        exit
      end;
      if p>length(lookfor) then begin
      q:=q+k;
      writeln(usr,q);
      delay(200);
      end
       else begin
        if k=lookfor[p] then p:=p+1 else begin
          b:=b+1;
          if b=2 then exit
        end
      end
    until false
  end;

***)

  procedure receivecall;
  var b:byte;
      timeout,autoswitch:integer;
      k:char;
      brate:baudratetype;
      joemam:anystr;
      brow:integer;
      speed:boolean;

    procedure sendstring (s:string);
    var cnt:integer;
    begin
      for cnt:=1 to length(s) do
       sendchar (s[cnt]);
    end;

    procedure nextrate (var b:baudratetype);
    var ob:baudratetype;
    begin
      ob:=b;
      repeat
        b:=succ(b);
        if b>b38400 then b:=b110;
        if b=ob then exit
      until b in configset.supportedrate
    end;

    procedure disconnect;
    begin
			if carrier then hangupmodem;
      baudrate:=configset.defbaudrat;
      parity:=false;
      setparam (configset.useco,baudrate,parity);
      setupmodem
    end;

    function seconds:integer;
    var r:registers;
    begin
      r.ah:=$2c;
      intr ($21,r);
      seconds:=r.dh
    end;

	label abort,connected;
	var tempchar:char;
	begin
		local:=false;
		online:=false;
		textcolor (configset.normbotcolo);
	begin
		 matrix:='';
		 online:=true;
		 delay (200);
		if numchars>0 then begin
		matrix:=matrix+getchar;
		delay (100);
    while numchars>0 do matrix:=matrix+getchar;
		(* if (pos('CONNECT '+#10,matrix)>0) then begin
			 baudrate:=baudarray[b300];
			 goto connected;
			 end; *)
		if pos('5',matrix)>0 then begin
			 baudrate:=baudarray[b1200];
			 goto connected;
       end;
    If pos('14',matrix)>0 then Begin
      baudrate:=baudarray[b19200];
      goto connected;
      End;
    if pos('12',matrix)>0 then begin
       baudrate:=baudarray[b1200];
       goto connected;
       end;
    if pos('24',matrix)>0 then begin
       baudrate:=baudarray[b2400];
       goto connected;
       end;
    if  pos('11',matrix)>0 then begin
       baudrate:=baudarray[b2400];
       goto connected;
       end;
    if  pos('96',matrix)>0 then begin
       baudrate:=baudarray[b9600];
       goto connected;
       end;
    if pos('19',matrix)>0 then begin
       baudrate:=baudarray[b19200];
       goto connected;
       end;
    if pos('10',matrix)>0 then begin
       baudrate:=baudarray[b2400];
       goto connected;
			 end;
			 baudrate:=baudarray[b300];
			 goto connected;
    writeln (usr,matrix);
end;
  begin
    local:=false;
    online:=false;
    textcolor (configset.normbotcolo);
    window (1,1,80,25);
    clrscr;
    window (1,1,80,23);
    if not mustgetbaud then goto connected;
    writeln;
    brate:=b110;
    parity:=false;
    timeout:=timer+2;
    repeat
      nextrate (brate);
      baudrate:=baudarray[brate];
      textcolor (configset.outlockcolo);
      textbackground (0);
      write (^M^J'Trying ',baudrate,' BAUD: ');
      setparam (configset.useco,baudrate,parity);
      sendstring ('Hit Return: ');
      delay (40);
      if numchars > 0 then if k = #13 then goto connected;
      autoswitch:=seconds + 3;
      if autoswitch > 59 then autoswitch:=autoswitch - 60;
      repeat
       k:=#0;
       if keyhit then k:='A' else
       if numchars > 0 then k:=getchar;
       if not carrier then exit;
      until (k <> #0) or (timer >= timeout) or (autoswitch = seconds);
      if timer >= timeout then hangupmodem;
      if not carrier then goto abort;
      if keyhit then begin
        k:=bioskey;
        case upcase(k) of
         #13:goto connected;
         'D':goto abort;
        end
      end else if k <> #0 then begin
        b:=ord(k);
        write (usr,b,' received.');
        if b = 13 then parity:=false else
        if b = 141 then parity:=true;
      end else b:=0;
    until (b=13) or (b=141) or (timer>timeout);
    if timer<=timeout then begin
      connected:
      totalsent:=0;
      totalrece:=0;
      connectbaud:=baudrate;
      if (configset.defbaudrat>=9600) then baudrate:=configset.defbaudrat;
			setparam(configset.useco,baudrate,parity);
			baudstr:=strr(connectbaud);
                        If baudrate>4800 then Speed:=True;
			if (connectbaud=38400) then baudstr:='38400';
			online:=true;
			urec.config:=[lowercase,linefeeds,eightycols];
			clearscr;
			textcolor(configset.normbotcolo);
			initwinds;
                        if configset.useansidetect then Begin
			writeln('Detecting Graphics Mode (One Moment)');
			getansimode;
			if ansigraphics in urec.config then WriteLn(^R'Ansi Graphics Enabled..')
			else WriteLn('Ansi Graphics Disabled..');
                        End;
			if pos('ARQ',Matrix)>0 then BaudStr:=BaudStr+'/ARQ';
			if pos('HST',Matrix)>0 then BaudStr:=BaudStr+'/HST';
			if pos('42',Matrix)>0 then BaudStr:=BaudStr+'/V.42';
                        If ansigraphics in urec.config then Begin
                        ClearScr;
                        goxy(1,14);ANSiColor(15);
          WRiTE ('            ViSiON / Lock at '+baudstr+' 8,N,1 on '+DateStr(Now)+' at '+Timestr(Now));
          GoXy(1,14);ANSiColor(7);Delay(500);
          Write ('            ViSiON / Lock at '+baudstr+' 8,N,1 on '+DateStr(Now)+' at '+TimeStr(Now));
          GoXy(1,14);AnsiColor(8);Delay(500);
          Write ('            ViSiON / Lock at '+baudstr+' 8,N,1 on '+DateStr(Now)+' at '+TimeStr(Now));
          ClearScr;
          End;
        If ansigraphics in urec.config then
	writeln (^M^M^R'þ '^F'Connected at '^S,baudstr,' 8,N,1',^R' þ',^M);
        If exist(configset.forumdi+'LOGON.BAT') then
          exec(getenv('COMSPEC'), '/C LOGON.BAT');
        If (configset.defbaudrat>=9600) and (Speed) then Begin
             If configset.defbaudrat=19200 then Begin
             WRiteLn(^S'Locking Com Port at '^U'19200'^S' Baud...');
             setparam(configset.useco,19200,parity);
             Delay(1000);
             WriteLn(^P'Done!'^M^M);
           End;
           If (configset.defbaudrat=38400) and (Speed) then Begin
             WriteLn(^S'Locking Com Port at '^U'38400'^S' Baud...');
             setparam(configset.useco,38400,parity);
             Delay(1000);
             WRiteLn(^P'Done!'^M^M);
           End;
           End;
	newcalls:=newcalls+1;
      if not suporterd then hangup;
      if carrier then exit
    end;
    abort:
    disconnect
  end;
  end;
  end;

  procedure exitprog;
  begin
		doanswer;
    window (1,1,80,25);
    textmode(co80);
    textcolor (15);
    textbackground (0);
    clrscr;
    gotoxy (1,10);
    writeln(usr,'                          ViSiON BBS Systems v',versionnum);
    writeln(usr,'                       (c) 1991 Ruthless Enterprises');
    writeln(usr,^M'                          Written by Crimson Blade');
    writeln(usr,'');
    writeln(usr,'     Call Countdown To Chaos at 619/868-2025 for Comments or Suggestions!');
    gotoxy(1,24);
    ensureclosed;
    closeport;
    halt(4)
  end;



  procedure checkday;
  begin
    if lastdayup<>datestr(now) then begin
      lastdayup:=datestr(now);
      numdaysup:=numdaysup+1;
      callstoday:=0;
      writestatus
    end
  end;

  procedure dotimedevent;
  var tf:text;
  begin
    window (1,1,80,25);
    clrscr;
    writeln (usr,'Executing timed event: ',configset.eventbatc);
    writeln (usr);
    assign (tf,'Door.bat');
    rewrite (tf);
    writeln (tf,configset.eventbatc);
    textclose (tf);
    timedeventdate:=datestr(now);
    ensureclosed;
    closeport;
    halt (3)
  end;

  procedure donetevent;
  var c:Char;
  begin
       window(1,1,80,25);
       clrscr;
       WriteLn(Usr,'First we must delay netmail for EXACTLY 2 Minutes.');
       delay(60000);
       delay(60000);
       if keypressed then c:=readkey;
       ClrScr;
        writeln(usr,'Executing Net Mail');
         neteventdate:=datestr(now);
         writestatus;
       do_net_mail;
  end;

  function statusscreen:char;
  const statwindx=5;
        statwindy=1;
        firstcolx=15;
        firstline=5;
        secondcolx=54;

    procedure percent (r1,r2:real);
    begin
      if (r2<1) then exit;
      r2:=round((r1/r2)*1000)/10;
      writeln (usr,r2:0:1,'%')
    end;





    procedure drawstatus;
    var totalidle,totalup,totalmins,r:real;
        tmp:integer;
        kk1,kk2,kk3,kkf:Byte;

(*     Procedure FiXkkk;
     Begin
     kkf:=kk1; kk1:=kk2; kk2:=kk3; kk3:=kk1;
     end;

    Procedure DopeFiEND;
     Begin
       Gotoxy(5,2);
       if kkf=0 then FiXkkk;
       Textattr:=kk1;
       Write(Usr,'Vi'); Textattr:=kk2;
       Write(Usr,'Si'); Textattr:=kk3;
       Write(Usr,'ON'); Textattr:=kk4;
       Write(Usr,' v'); Textattr:=kk5;
       Write(Usr,'0.'); Textattr:=kk1;
       Write(Usr,'81'); Textattr:=kk2;
       kkk:=kk5;
       kk5:=kk4; kk4:=kk3; kk3:=kk2; kk2:=kk1; kk1:=kkk;
     End;

     Procedure Trippin;
      Procedure fix_ss;
      begin
      ss1:=15; ss2:=7; ss3:=8;
      end;

     Begin
      if ss1=0 then fix_ss;
       gotoxy(9,3); Textattr:=ss1; Write('ù');
       gotoxy(5,1); Textattr:=ss2; Write('ù');
       gotoxy(9,4); Textattr:=ss3; Write('ù');
       gotoxy(7,1); Textattr:=ss1; Write('ù');
       gotoxy(3,3); Textattr:=ss2; Write('ù');
       gotoxy(12,4); Textattr:=ss3; Write('ù');
       gotoxy(13,1); Textattr:=ss1; Write('ù');
       gotoxy(10,3); Textattr:=ss2; Write('ù');
       ssb:=ss3; ss3:=ss2; ss2:=ss1; ss1:=ssb;
       ansicolor(14);
      end; *)

    begin
      if not match(getenv('DSZLOG'),configset.dszlog) then begin
        gotoxy(12,24);
        write(usr,'[ You MUST put SET DSZLOG='+configset.dszlog+' in your KEEPUP.BAT! ]');
      end;
      tmp:=timetillevent;
      if tmp<=30 then begin
        gotoxy (23,1);
        write (usr,'[ Timed event scheduled in ',tmp,' minutes! ');
        if tmp<10 then write(usr,' ');
        write(usr,']');
        if tmp<=5 then begin
	dontanswer;
          if tmp<=2 then dotimedevent
        end
	end;
      tmp:=timetillnet;
      if length(configset.netstc)=0 then tmp:=1500;
      if tmp<=30 then begin
        gotoxy(23,1);
        write(usr,'[ Net-Mail Scheduled in ',tmp,' minutes! ');
        if tmp<10 then write(usr,' ');
        write(usr,']');
         if tmp<=5 then begin
           dontanswer;
           if tmp<=1 then donetevent;
         end
      end;
      if carrier or keyhit then exit;
      tmp:=elapsedtime (wasted);
      if (tmp>5) and ConfigSet.SaveScreen then Begin
         If Not SaveScreenOn then ClrScr;
         if Not SaveScreenOn then Begin
          kk1:=8; kk2:=7; kk3:=15;
          End;
         SaveScreenOn:=True;
         kkf:=kk1; kk1:=kk2; kk2:=kk3; kk3:=kkf;
         ScreenColor:=kk1;
         TextColor(8);
         Gotoxy(1,25);
         Write(Usr,'ViSiON Screen Saver - F7 Redraws');
         TextColor(1);
      End Else Begin
      gotoxy(57,9);
      Write (usr,numminsused.total:0:0);
      gotoxy(57,13);
      write (usr,tmp);
      gotoxy (57,10);
      write (usr,numdaysup);
      r:=round(10*numcallers/numdaysup)/10;
      gotoxy(57,12);
      writeln (usr,r:0:1);
      gotoxy(23,10);
      writeln (usr,timestr(now),' ');
      gotoxy(23,11);
      write (usr,datestr(now),'  ');
      gotoxy (22,0);
      maybewritestatus
    end;
    End;

procedure CursorOff;
  var regs:registers;
	begin
	  Regs.AH :=1;
          Regs.CH :=32;
	  Regs.CL :=0;
	  intr ($10,Regs);
	end;

procedure CursorOn;
  var regs:registers;
	begin
	Regs.AH:=1;
	  Regs.CH:=6;
	  Regs.CL:=7;
	  intr ($10,Regs);
	end;

    procedure writeavail;
    var m:lstr;
    begin
      gotoxy (23,12);
      m:=sysopavailstr;
      write ('            ');
      gotoxy (23,12);
      write (usr,m);
      gotoxy (1,1)
    end;

  var cnt,numsmail:integer;
      k:char;
      tmp:mstr;
      b:byte;
      done:boolean;

    function shouldexit:boolean;
    begin
    shouldexit:=done or carrier;
    end;

    procedure handlekey (k:char; beforeabout:boolean);
    begin
      b:=ord(k)-128;
      case b of
        availtogglechar:begin
          toggleavail;
          if not beforeabout then writeavail
        end;
	120,121,122,123,124,125,126,127,128,59,60,61,62,63,64,65,66,67,68:begin
          done:=true;
          SaveScreenOn:=False;
          statusscreen:=k
        end
      end
    end;

    function interrupted (beforeabout:boolean):boolean;
    begin
     if keypressed then begin
     k:=bioskey;
     handlekey (k,beforeabout)
     end;
     done:=done or carrier;
      interrupted:=done
    end;

{$I WFC.PAS}

    procedure sendstring (x:lstr);
    var cnt:integer;
        k:char;
    begin
      for cnt:=1 to length(x) do begin
				sendchar(x[cnt]);
        delay (20);
      end;
			delay (50);
			repeat k:=getchar until numchars=0;
    end;

    procedure phonesringing;
    begin
      sendstring ('  ATA'#13)
    end;

    procedure connectcode (k:char);
    var timer:word absolute $40:$6c;
        t:word;
        k2:char;
        bd:baudratetype;
    begin
      t:=timer+18;
      repeat
      until (timer>t) or carrier or (numchars>0);
      case k of
        '1':case k2 of
              #0:bd:=b300;
              '0':bd:=b2400;
              else exit
            end;
        '5':bd:=b1200;
        else exit
      end;
      if bd in configset.supportedrate then begin
        parity:=false;
        baudrate:=baudarray[bd];
        mustgetbaud:=false;
        t:=timer+18;
	repeat until carrier or (timer>t)
      end
    end;

   procedure writefreespace;
    var r:registers; tempfree:real; lp:integer; total:real;
        csize:real;

	function unsigned (i:integer):real;
	begin
	if i>=0 then unsigned:=i else unsigned:=65536.0+i
	end;

    begin
	total:=0;
	for lp:=3 to 15 do begin

      r.ah:=$1c;
      r.dl:=lp;
      intr ($21,r);

      if mem[r.ds:r.bx]=$f8 then begin
		  r.ah:=$36;
		  r.dl:=lp;
		  intr ($21,r);
		  csize:=unsigned(r.ax)*unsigned(r.cx);
		  tempfree:=(csize*unsigned(r.bx))/1000;
		  total:=total+tempfree/1000;
		  gotoxy(57,15);
			write(usr,streal(total)+' Megz ');
			end;

			end;
		end;

var tempoct:integer;
  begin
    updatenodestatus('þ Waiting For Call þ');
    while numchars > 0 do k:=getchar;
    statusscreen:=#0;
    window(1,1,80,25);
    done:=false;
    If Not SaveScreenOn then textcolor (15);
    clrscr;
    wasted.started:=false;
    wasted.startedat:=timer;
    wasted.total:=0;
    starttimer(wasted);
    gotoxy(0,0);
    if interrupted (true) then exit;
If Not SaveScreenOn then Begin
CursorOff;
DrawWFC;
    if interrupted (true) then exit;
    textcolor(12);
    writefreespace;
    gotoxy (1,1);
    textcolor (configset.normtopcolo);
    gotoxy(3,21);
    if registo = 'þ¹Â‘NÇ' then write ('[ Evaluation Copy ]') else
    write(usr,registo);
    gotoxy(3,23);
    textcolor(configset.normtopcolo);write(usr,registb);
    textcolor(14);
    gotoxy(51,16);
    write(usr,getlastcaller);
    gotoxy (23,14);
    numsmail:=getnummail(1)+numfeedback;
    writeln (usr,numsmail);
    gotoxy(57,11);
    write (usr,callstoday:0);
    gotoxy (57,8);
    writeln (usr,newcalls);
    gotoxy(23,16);
    write (usr,newposts);
    writeavail;
    gotoxy (1,1);
    gotoxy (23,17);
    writeln (usr,newuploads);
    gotoxy(23,13);
    writeln (usr,newfeedback);
    gotoxy(23,15);
    write (usr,newmail);
    End;
    repeat
      checkday;
      drawstatus;
      cnt:=0;
      repeat
        while configset.hashaye and (not carrier) and (numchars>0) do begin
	 k:=getchar;
	  case k of
	  '2':phonesringing;
	  '1','5':connectcode (k)
	   end
	  end;
	 cnt:=cnt+1
	 until (cnt>=10000) or interrupted (false) or done
	until done;
      CursorOn;
  end;

procedure gotodos;
  var status:word;
      tmp1:integer;
      st:mstr;
  begin
    ansicolor(15);
    window (1,1,80,25);
    gotoxy (1,25);
       clrscr; textcolor(1);
       write(usr,'®®');
       Textcolor(11); Write(usr,' ViSiON Dos Shell');
       Textcolor(1); WriteLn(usr,' ¯¯');
       Textcolor(14);
       write(usr,'Type ''');
       textcolor(10); Write(usr,'EXIT');
       Textcolor(14); WriteLn(usr,''' to return.');
       if not configset.maximumdosshell then begin
        swapvectors;
        exec(getenv('COMSPEC'),'');
        swapvectors;
       End Else Begin
         Textcolor(5);
         Write(Usr,'Allocated ');
         Textcolor(13);
         Write(usr,bytesswapped);
         Textcolor(5); WriteLn(usr,' bytes ',swaploc[EmsAllocated]);
         SwapVectors;
         Status:=ExecWithSwap(GetEnv('Comspec'),'');
         SwapVectors;
        End;
       st:=configset.forumdi;
       if st[length(st)]='\' then st[length(st)]:=#0;
       chdir(st);
    ClrScr;
  end;

procedure runconfig;
var status:word;
begin
 if configset.forumdi[length(configset.forumdi)]<>'\' then configset.forumdi:=configset.forumdi+'\';
 swapvectors;
 exec(getenv('COMSPEC'), '/C CONFIG.EXE');
 swapvectors;
 readconfig;
end;

procedure alt(i:integer);
begin
window(1,1,80,25);
clrscr;
ensureclosed;
closeport;
textmode (co80);
halt(i);
end;

var k:char;
label exit;
begin
  waitforacall:=false;
  SaveScreenOn:=False;
  aa:='sp';
  bb:='oo';
  setparam (configset.useco,configset.defbaudrat,false);
  setupmodem;
  starttimer (numminsidle);
  wscount:=0;
  local:=false;
  cc:='in';
  dd:='!?';
  ff:=aa+bb+cc+dd;
  clrscr;
  repeat
    doanswer;
    mustgetbaud:=true;
    k:=statusscreen;
    if carrier then begin
      receivecall;
      if carrier then goto exit;
    end;
    case ord(k)-128 of
      59:begin
              ensureclosed;
              closeport;
              alt(11);
         end;
      64:do_net_mail;
      61:begin
              sendchar('A');
              delay(20);
              sendchar('T');
              delay(20);
              sendchar('A');
              delay(20);
              sendchar(#13);
              delay(20);
       end;
       62:begin
          sendchar('A');
          delay(20);
          sendchar('T');
          delay(20);
          sendchar('H');
          delay(20);
          sendchar('1');
          delay(20);
          sendchar(' ');
          delay(20);
          sendchar('M');
          delay(20);
          sendchar('0');
          delay(20);
          sendchar(#13);
          delay(20);
          local:=true;
          online:=false;
          unum:=1;
          readurec;
          clrscr;
          settimeleft(500);
          emailmenu;
          seek(ufile,unum);
          writeurec;
          ensureclosed;
          alt(0);
          end;
       63:begin
          ClearScr;
          Write(usr,'Would You Like To Go OFF-HOOK? [y/N]: ');
          WriteStr('*');
          if yes then Begin
          sendchar('A');
          delay(20);
          sendchar('T');
          delay(20);
          sendchar('H');
          delay(20);
          sendchar('1');
          delay(20);
          sendchar(' ');
          delay(20);
          sendchar('M');
          delay(20);
          sendchar('0');
          delay(20);
          sendchar(#13);
          delay(20);
          end;
          local:=true;
          online:=false;
          unum:=1;
          readurec;
          clrscr;
          settimeleft(500);
          mainsysopcommands;
          seek(ufile,unum);
          writeurec;
          ensureclosed;
          alt(0);
        end;
      120:alt(110);
      121:alt(111);
      122:alt(112);
      123:alt(113);
      124:alt(114);
      125:alt(115);
      126:alt(116);
      127:alt(117);
      128:alt(118);
      66:gotodos;
      67:runconfig;
      68:begin
           doanswer;
           ClearScr;
           Write(usr,'Would You Like To Go OFF-HOOK? [y/N]: ');
           WriteStr('*');
           if yes then Begin
           sendchar('A');
           delay(20);
           sendchar('T');
           delay(20);
           sendchar('H');
           delay(20);
           sendchar('1');
           delay(20);
           sendchar(' ');
           delay(20);
           sendchar('M');
           delay(20);
           sendchar('0');
           delay(20);
           sendchar(#13);
           delay(100);
           end;
           local:=true;
           online:=false;
           newfeedback:=0;
           newuploads:=0;
           newcalls:=0;
           newposts:=0;
           newmail:=0;
           writestatus;
           goto exit
         end;
    60:begin
       ClrScr;
       Write(usr,'Would You like to go OFF-HOOK? [y/N]: ');
       WriteStr('*');
       If yes then begin
          sendchar('A');
           delay(20);
           sendchar('T');
           delay(20);
           sendchar('H');
           delay(20);
           sendchar('1');
           delay(20);
           sendchar(' ');
           delay(20);
           sendchar('M');
           delay(20);
           sendchar('0');
           delay(20);
           sendchar(#13);
           delay(100);
       End;
       exitprog;
    end;
    end
  until 0=1;
  exit:
  textcolor (configset.normbotcolo);
end;

begin
end.