{$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