Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FAQ-S.ZIP/WAITCALL.PAS

Pascal/Delphi Source File | 1991-05-04 | 43.7 KB | 1,656 lines

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

unit waitcall;

interface

uses dos,crt,main,netnew,video,
     gentypes,statret,configrt,modem,gensubs,subs1,subs2,mailret,overlay,
     overret1,mainr1,mainr2,mainmenu,getlogin,userret,protocol,Graph3,drivers,mousedlg;

function waitforacall:boolean;

implementation

function waitforacall:boolean;
  const statwindx=2;
        statwindy=1;
    firstcolx=17;
    firstline=1;
    secondcolx=41;
        thirdcolx=66;

  var wscount      :integer;
      modemoff     :boolean;
      mustgetbaud  :boolean;
      outf         :text;
      screen       :screens;
      screenblank  :boolean;
      nl           :netmailrec;
      nla          :netlistrec;
      msg          :string[40];
      anynum       :integer;
      msgnum       :integer;
      msgcount     :integer;
      color1,color2,color3,
      color4,color5,color6,
      color7,color8,color9,
      color10,color11,color12,
      color13,color14,color15:integer;
      blanker:minuterec;

    procedure cursor (b:boolean);
    var r:registers;
    begin
      with r do begin
        ah:=$01;
        if not b then begin
          ch:=$20; cl:=$20
        end else begin
        ch:=5; cl:=7
        end
      end;
      intr ($10,r)
    end;

    procedure col1;
    begin
    { window (statwindx+firstcolx,statwindy+firstline,80,25);
    }end;

    procedure col2;
    begin
     { window (statwindx+secondcolx,statwindy+firstline,80,25);
    }end;

    procedure col3;
    begin
     { window (statwindx+thirdcolx,statwindy+firstline,80,25);
    }end;

   procedure seeknmfile (n:integer);
   begin
     seek (nmfile,n-1);
   end;

   procedure seeknlifile (n:integer);
   begin
     seek (nlifile,n-1);
   end;

      function numbbs:integer;
   begin
    numbbs:=filesize (nmfile);
   end;


   function numnetfiles:integer;
   begin
     numnetfiles:=filesize(nlifile)
   end;

procedure delfile(laym:byte);
var i    :integer;
    n    :integer;
    cnt  :integer;
    c    :char;

 begin
  n:=laym;
  seeknlifile (n);
  read (nlifile,nla);
    for cnt:=n to numnetfiles-1 do
     begin
        seeknlifile (cnt+1);
        read (nlifile,nla);
        seeknlifile (cnt);
        write (nlifile,nla)
     end;
   seeknlifile (numnetfiles);
   truncate (nlifile);
 end;

   procedure topwin;
    begin;
    window(3,7,79,14);
    textcolor(statlinecolor);
    end;

   procedure botwin;
    begin;
    window(3,18,79,22);
    textcolor(splitcolor);
    end;

  procedure maybewritestatus;
  begin
  msgcount:=msgcount+1;
  anynum:=0;
  repeat
    color1:=color1+1;
    color2:=color2+1;
    color3:=color3+1;
    color4:=color4+1;
    color5:=color5+1;
    color6:=color6+1;
    color7:=color7+1;
    color8:=color8+1;
    color9:=color9+1;
    color10:=color10+1;
    color11:=color11+1;
    color12:=color12+1;
    color13:=color13+1;
    color14:=color14+1;
    color15:=color15+1;
    if color1=16 then begin
    color1:=color1-15;
    end;
    if color2=16 then begin
    color2:=color2-15;
    end;
    if color3=16 then begin
    color3:=color3-15;
    end;
    if color4=16 then begin
    color4:=color4-15;
    end;
    if color5=16 then begin
    color5:=color5-15;
    end;
    if color6=16 then begin
    color6:=color6-15;
    end;
    if color7=16 then begin
    color7:=color7-15;
    end;
    if color8=16 then begin
    color8:=color8-15;
    end;
    if color9=16 then begin
    color9:=color9-15;
    end;
    if color10=16 then begin
    color10:=color10-15;
    end;
    if color11=16 then begin
    color11:=color11-15;
    end;
    if color12=16 then begin
    color12:=color12-15;
    end;
    if color13=16 then begin
    color13:=color13-15;
    end;
    if color14=16 then begin
    color14:=color14-15;
    end;
    if color15=16 then begin
    color15:=color15-15;
    end;
    if not screenblank then begin
    gotoxy (13,11);
    textcolor (color1);
    write (usr,'F');
    textcolor (color2);
    write (usr,'A');
    textcolor (color3);
    write (usr,'Q ');
    textcolor (color4);
    write (usr,copy (ver,1,1));
    textcolor (color5);
    write (usr,copy (ver,2,1));
    textcolor (color6);
    write (usr,copy (ver,3,1));
    textcolor (color7);
    write (usr,copy (ver,4,1)+' ');
    textcolor (color8);
    write (usr,copy (date,1,1));
    textcolor (color9);
    write (usr,copy (date,2,1));
    textcolor (color10);
    write (usr,copy (date,3,1));
    textcolor (color11);
    write (usr,copy (date,4,1));
    textcolor (color12);
    write (usr,copy (date,5,1));
    textcolor (color13);
    write (usr,copy (date,6,1));
    textcolor (color14);
    write (usr,copy (date,7,1));
    textcolor (color15);
    write (usr,copy (date,8,1));
    end;
    delay(100{80});
    anynum:=anynum+1;
    textcolor(normtopcolor);
     until (carrier) or (keyhit) or (anynum>15);
   if msgcount>15 then begin
    textcolor(normtopcolor);
        msgnum:=msgnum+1;
        if msgnum>8 then begin
          msg:='                                     ';
          msgnum:=1;
        end;
        if msgnum=1 then begin
          msg:=' FAQ Communications/BBS Software     ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=2 then begin
          msg:=' Author: The Firegod                 ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=3 then begin
          msg:=' Co-Author: The Witch Doctor         ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=4 then begin
          msg:=' (C)Copyright BaseTwo Software, 1991 ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=5 then begin
          msg:=' FAQ - The BBS Software of the 90''s  ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=6 then begin
          msg:=' FAQ has been brought to you by      ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=7 then begin
          msg:=' The FAQ Development Team            ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
        if msgnum=8 then begin
          msg:=' Thank you for choosing FAQ!         ';
          gotoxy(3,17);
    textcolor(normtopcolor);
         end;
    if not screenblank then write (usr,msg);
    textcolor(normtopcolor);
    end;
    wscount:=wscount+1;
    if wscount>800 then begin
      writestatus;
      wscount:=0
    end;
  end;

Function checkforhayesreport:Boolean;
Var n:longint;
    q:lstr;
    p,b:Integer;
    k:Char;
    bd,brate:baudratetype;
Begin
  delay (50);
  q:='';k:=' ';
  bd:=b110;
  While (numchars>0) And (Length(q)<99) Do Begin
    k:=getchar;q:=q+k;
  End;
  delay (500);
  While (numchars>0) And (Length(q)<150) Do Begin
    k:=getchar;
    q:=q+k;
  End;
  If Not carrier Then exit;
  if (Pos('ARQ',q)>0) or (Pos('MNP',q)>0) then arq:=true else arq:=false;
  {if (defbaudrate=19200) or (defbaudrate=38400) and (lockport) then begin
    writeln (usr,'[Locking the COM Port in 38400]');
    bd:=b38400 end else} begin
    If ((Pos('1',q)>0) or (Pos('CONNECT',q)>0)) and (defbaudrate>=300) Then bd:=b300;
    If ((Pos('5',q)>0) or (Pos('CONNECT 1200',q)>0)) and (defbaudrate>=1200) Then bd:=b1200;
    If ((Pos('10',q)>0) or (Pos('CONNECT 2400',q)>0)) and (defbaudrate>=2400) Then bd:=b2400;
    If ((Pos('18',q)>0) or (Pos('CONNECT 4800',q)>0)) and (defbaudrate>=4800) Then bd:=b4800;
    If ((Pos('13',q)>0) or (Pos('CONNECT 9600',q)>0)) and (defbaudrate>=9600) Then bd:=b19200;
    If ((Pos('50',q)>0) or (Pos('CONNECT 19200',q)>0)) and (defbaudrate>=19200) Then bd:=b38400;
    if bd=b110 then begin
    if defbaudrate=300 then bd:=b300;
    if defbaudrate=1200 then bd:=b1200;
    if defbaudrate=2400 then bd:=b2400;
    if defbaudrate=4800 then bd:=b4800;
    if defbaudrate=9600 then bd:=b9600;
    if defbaudrate=19200 then bd:=b19200;
    if defbaudrate=38400 then bd:=b38400;
   end;
  end;
  If (bd>b110) Then Begin
    parity:=False;
    baudrate:=baudarray[bd];
    mustgetbaud:=False;
    checkforhayesreport:=True;
  End Else Checkforhayesreport:=False;
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);
      if numchars=0 then exit else k:=getchar;
      if (k=#13) and (length(q)>0) then begin
        val (q,b,p);
        brate:=b300;
        while (brate<=b38400) and
              ((b<>baudarray[brate])
                or (not (brate in supportedrates)))
              do brate:=succ(brate);
        if brate<=b38400 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 q:=q+k 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;

    procedure nextrate (var b:baudratetype);
    var ob:baudratetype;
    begin
      ob:=b;
      repeat
        b:=succ(b);
        if b>b38400 then b:=b300;
        if b=ob then exit
      until b in supportedrates
    end;

    procedure disconnect;
    begin
      if (carrier or local) then hangupmodem;
      baudrate:=defbaudrate;
      parity:=false;
      setparam(usecom,baudrate,parity);
      setupmodem
    end;

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

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

    procedure nextrate (var b:baudratetype);
    var ob:baudratetype;
    begin
      ob:=b;
      repeat
        b:=succ(b);
        if b>b38400 then b:=b300;
        if b=ob then exit
      until b in supportedrates
    end;

    procedure disconnect;
    begin
      if carrier then hangupmodem;
      baudrate:=defbaudrate;
      parity:=false;
      setparam (usecom,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 return:string;
  begin
    local:=false;
    online:=false;
    textcolor (normbotcolor);
    window (1,1,80,25);
    clrscr;
    window (1,1,80,24);
    if checkforhayesreport then goto connected;
    if not mustgetbaud then goto connected;
    writeln;
    brate:=b300;
    parity:=false;
    timeout:=timer+2;
    repeat
      nextrate (brate);
      baudrate:=baudarray[brate];
      textcolor (outlockcolor);
      textbackground (0);
      writeln (usr,^M^J'Trying [',baudrate,']:');
      online:=true;
        if numchars=0 then begin
        return:=^B+^M+'-Press Return';
        for b:=1 to length(return) do begin
        sendchar (return[b]); write (usr,return[b]);
        if  numchars>0 then b:=length(return);
        end;
        end;
      while numchars>0 do k:=getchar;
      autoswitch:=seconds+3;
      if autoswitch>59 then autoswitch:=autoswitch-60;
      repeat until (not carrier) or (numchars>0) or (keyhit) 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
          begin
            if numchars>0 then begin
              b:=ord(getchar);
            end else b:=0;
            if b<>13
              then if b=141
                then parity:=true
                else
                  begin
                    delay (200);
                    while numchars>0 do b:=ord(getchar)
                  end
          end
    until (b=13) or (b=141) or (timer>timeout);
    if timer<=timeout then begin
      connected:
      setparam (usecom,baudrate,parity);
      if parity
        then baudstr:='E,7'
        else baudstr:='N,8';
      baudstr:=strr(baudrate)+','+baudstr+',1';
      online:=true;
      urec.config:=[lowercase,linefeeds,eightycols];
      newcalls:=newcalls+1;
      delay (750);
      cursor (true);
      if carrier then exit
    end;
    abort:
    disconnect
  end;

  procedure exitprog;
  Begin
    sendmodemstr ('~~ATS0=0Q0M1V1X7|',true);
    dontanswer;
    TextMode(80);
    window (1,1,80,25);
    clrscr;
    textbackground (0);
    textcolor (normbotcolor);
    gotoxy (1,1);
    writeln (usr,'  ┌──────────────────────────────────────────────────────────────────────────┐');
    gotoxy (1,2);
    write   (usr,'  │');
    textcolor (outlockcolor);
    write   (usr,'                          FAQ '+ver+' - '+date+'                             ');
    textcolor (normbotcolor);
    writeln (usr,'│');
    textcolor (normbotcolor);
    gotoxy (1,3);
    write   (usr,'  │');
    textcolor (normtopcolor);
    write   (usr,'                  FAQ "F-A-Q" - Functional and Quick.                     ');
    textcolor (normbotcolor);
    writeln (usr,'│');
    textcolor (normbotcolor);
    gotoxy (1,4);
    write   (usr,'  │');
    textcolor (outlockcolor);
    write   (usr,'                Authors - The Firegod and The Witch Doctor                ');
    textcolor (normbotcolor);
    writeln (usr,'│');
    gotoxy (1,5);
    write   (usr,'  │');
    textcolor (outlockcolor);
    write   (usr,'                          of BaseTwo Software                             ');
    textcolor (normbotcolor);
    writeln (usr,'│');
    textcolor (normbotcolor);
    gotoxy (1,6);
    writeln (usr,'  └──────────────────────────────────────────────────────────────────────────┘');
  ensureclosed;
  ClosePort;
  ansicolor (7);
  textcolor (7);
  halt (4);
  end;

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

  procedure useredit;
  {$M 8192,0,0}           { Leave memory for child process }
var
  Command: string[127];

begin
    Command:=('Uedit');
    begin
      SwapVectors;
      Exec(GetEnv('COMSPEC'), '/C ' + Command);
      SwapVectors;
    end;
   TextMode(80);
   Clrscr;
end;

 procedure Futil;
var
  Command2: string[127];

begin
    TextMode(80);
    ClrScr;
    Command2:=('Futil');
    begin
      SwapVectors;
      Exec(GetEnv('COMSPEC'), '/C ' + Command2);
      SwapVectors;
    end;
   TextMode(80);
   Clrscr;
end;

 procedure Run_Config;
var
  Command2: string[127];

begin
    TextMode(80);
    ClrScr;
    Command2:=('SETUP');
    begin
      SwapVectors;
      Exec(GetEnv('COMSPEC'), '/C ' + Command2);
      SwapVectors;
    end;
   TextMode(80);
   Clrscr;
end;

 procedure Run_Prot_Config;
var
  Command2: string[127];

begin
    TextMode(80);
    ClrScr;
    Command2:=('Protedit');
    begin
      SwapVectors;
      Exec(GetEnv('COMSPEC'), '/C ' + Command2);
      SwapVectors;
    end;
   TextMode(80);
   Clrscr;
end;

 procedure Run_Sound;
var
  Command2: string[127];

begin
    TextMode(80);
    ClrScr;
    Command2:=('Sound.Bat');
    begin
      SwapVectors;
      Exec(GetEnv('COMSPEC'), '/C ' + Command2);
      SwapVectors;
    end;
   TextMode(80);
   Clrscr;
end;

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

  procedure donetworkevent;
  var tf:text;
  begin
    window (1,1,80,25);
    clrscr;
    writeln (usr,'Executing network call: ',netstart);
    writeln (usr);
    repeat
    if usemouse then hidemouse;
    NewNetSend;
    until (timestr(now)=netend);
  end;

  function statusscreen:char;

    procedure percent (r1,r2:real);
    begin
      if (r2<1) then exit;
      r2:=round((r1/r2)*1000)/10;
      writeln (usr,r2:0:1,'%')
    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(67,5);
                  textcolor(normtopcolor);
          write(usr,streal(total)+' meg(s)');
          end;

      end;
    end;

    procedure drawstatus;
    var totalidle,totalup,totalmins,r:real;
        tmp,nettmp:integer;

    begin
      if screenblank then exit;
     {col1;}
      tmp:=timetillevent;
      if (tmp<=30) then begin
        gotoxy (4,18);
        write (usr,'Event scheduled in ',tmp,' min.');
        if (tmp<=5) then begin
          dontanswer;
          if tmp<=2 then dotimedevent;
        end
      end;
      nettmp:=timenetworkevent;
      if (nettmp<=30) and (usenet) then begin
        gotoxy (4,19);
        write (usr,'Network Event scheduled in ',nettmp,' min.');
        if (nettmp<=5) and (usenet) then begin
          dontanswer;
          if (nettmp<=2) and (usenet) then donetworkevent;
        end
      end;
      if carrier or keyhit then exit;
      gotoxy (4,20);
      if getenv ('DSZLOG')<>dszlogname then write (usr,'DSZ Log not set') else
      write(usr,'DSZ Log: '+dszlogname);
      gotoxy (11,22); write(usr,timestr(now));
      gotoxy (20,22); write(usr,datestr(now));
      gotoxy (14,13); write(usr,netnum);
      gotoxy (23,15); if usenet then write(usr,'Yes') else write(usr,'No ');
      gotoxy (18,4);
      writeln (usr,callstoday);
      gotoxy (42,5);
      tmp:=elapsedtime (numminsidle);
      write (usr,tmp);
      writefreespace;
      gotoxy (67,4);
      writeln (usr,numdaysup);
      r:=round(10*numcallers/numdaysup)/10;
      gotoxy (18,5);
      writeln (usr,r:0:1);
{      col2;
      gotoxy (1,3);
      totalidle:=numminsidle.total+elapsedtime(numminsidle);
      writeln (usr,totalidle:0:0);
      totalup:=totalidle+numminsused.total;
      writeln (usr,totalup:0:0);
      totalmins:=1440.0*(numdaysup-1.0)+timer;
      if (totalup<1) or (totalmins<1) then exit;
      percent (numminsused.total,totalmins);
      percent (numminsxfer.total,totalmins);
      percent (totalidle,totalmins);
      percent (totalup,totalmins);
      percent (totalmins-totalup,totalmins);}
     {col1;}
      gotoxy (1,1);
      maybewritestatus
    end;

    procedure writeavail;
    var ChatM:sstr; m:sstr;
    begin
      gotoxy (63,22);
{TEST for chat
      ChatM:=Timestr(Now);
      If Chatm=Availtime then SysopAvailstr='YES';}
      m:=sysopavailstr;
      while length(m)<13 do m:=m+' ';
      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;
        35:sendmodemstr ('+++~~~ATH|',true);
        48,59,60,61,62,63,64,65,66,67,68:begin
          done:=true;
          statusscreen:=k
        end
      end
    end;

    procedure writeboardname;
    var xcoord:integer; nm:string[50];
    begin
    nm:=longname;
    xcoord:=39-(length(nm) div 2);
        textcolor (normtopcolor);
    gotoxy(xcoord,24); write(usr,nm);
    end;

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

    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);
      while numchars>0 do k:=getchar;
      clearoutput;
      clearinput;
   end;
procedure phonesringing;
    begin
       {col2;}
    gotoxy(37,22);
          textcolor (normtopcolor);
        write(usr,'Answering Call  ');
      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);
    k2:=getchar;{ Will be #0 if no chars }
    Case k Of
     '1' : Case k2 Of
             #0 :bd:=b300;
             '0' :bd:=b2400;
             '6' :bd:=b9600;
             Else exit
            End;
     '5' :bd:=b1200;
     Else exit
    End;
    If bd In supportedrates Then Begin
      parity:=False;
      baudrate:=baudarray[bd];
      mustgetbaud:=False;
      t:=timer+18;
      Repeat Until carrier Or (timer>t)
    End;
  End;

  var setlog:string[50];
      i,iiii:byte;
  begin
    while numchars>0 do k:=getchar;
    clearoutput;
    clearinput;
    statusscreen:=#0;
    done:=false;
    window (1,1,80,25);
    textcolor (normbotcolor);
    clrscr;
    {setcursor(cursoroff);}cursor(false);
    window (statwindx,statwindy,80,25);
    if elapsedtime (blanker)>=1 then screenblank:=true;
    if not screenblank then begin
    gotoxy (1,1);
{writeln(usr,'┌─────────────────────────────────────┬────────────────────────────────────┐');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'          ');
textcolor (normbotcolor);
write  (usr,'                          │');
textcolor (outlockcolor);
write  (usr,'             ');
textcolor (normbotcolor);
writeln(usr,'                       │');
writeln(usr,'├────────────────────────┬────────────┴───────────┬────────────────────────┤');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'           │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'            │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
writeln(usr,'            │');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'           │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'            │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
writeln(usr,'            │');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'           │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'            │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
writeln(usr,'            │');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'           │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
write  (usr,'            │');
textcolor (outlockcolor);
write  (usr,'            ');
textcolor (normbotcolor);
writeln(usr,'            │');
writeln(usr,'├────────────────────────┴────────────┬───────────┴────────────────────────┤');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'           ');
textcolor (normbotcolor);
write  (usr,'                         │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'       ');
textcolor (normbotcolor);
write  (usr,'                             │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'        ');
textcolor (normbotcolor);
write  (usr,'                            │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│                                     │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│                                     │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│                                     │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│                                     │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│                                     │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'  ');
textcolor (outlockcolor);
write  (usr,'                             ');
textcolor (normbotcolor);
writeln(usr,'│');
writeln(usr,'├──────────────────────────┬──────────┴──────────────┬─────────────────────┤');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'                    │');
textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
write  (usr,'                    │');
textcolor (outlockcolor);
write  (usr,'     ');
textcolor (normbotcolor);
writeln(usr,'                │');
writeln(usr,'├──────────────────────────┴─────────────────────────┴─────────────────────┤');
writeln(usr,'│                                                                          │');
write  (usr,'└──────────────────────────────────────────────────────────────────────────┘');
gotoxy (1,1);}
writeln(usr,'┌─────────────────────────────────────┬────────────────────────────────────┐');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Registered');
textcolor (normbotcolor);
write  (usr,':                         │');
textcolor (outlockcolor);
write  (usr,'Serial Number');
textcolor (normbotcolor);
writeln(usr,':                      │');
writeln(usr,'├────────────────────────┬────────────┴───────────┬────────────────────────┤');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Calls Today ');
textcolor (normbotcolor);
write  (usr,':          │');
textcolor (outlockcolor);
write  (usr,'Total Calls ');
textcolor (normbotcolor);
write  (usr,':           │');
textcolor (outlockcolor);
write  (usr,'Total Days  ');
textcolor (normbotcolor);
writeln(usr,':           │');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Calls / Day ');
textcolor (normbotcolor);
write  (usr,':          │');
textcolor (outlockcolor);
write  (usr,'Mins Idle   ');
textcolor (normbotcolor);
write  (usr,':           │');
textcolor (outlockcolor);
write  (usr,'Free Space  ');
textcolor (normbotcolor);
writeln(usr,':           │');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'New Calls   ');
textcolor (normbotcolor);
write  (usr,':          │');
textcolor (outlockcolor);
write  (usr,'New Posts   ');
textcolor (normbotcolor);
write  (usr,':           │');
textcolor (outlockcolor);
write  (usr,'New Uploads ');
textcolor (normbotcolor);
writeln(usr,':           │');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'New Feedback');
textcolor (normbotcolor);
write  (usr,':          │');
textcolor (outlockcolor);
write  (usr,'New Mail    ');
textcolor (normbotcolor);
write  (usr,':           │');
textcolor (outlockcolor);
write  (usr,'Sysop Mail  ');
textcolor (normbotcolor);
writeln(usr,':           │');
writeln(usr,'├────────────────────────┴────────────┬───────────┴────────────────────────┤');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Last Caller');
textcolor (normbotcolor);
write  (usr,':                        │');
textcolor (outlockcolor);
write  (usr,'F1   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Force Net Call               ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write  (usr,'F2   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Exit FAQ                     ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Version');
textcolor (normbotcolor);
write  (usr,':                            │');
textcolor (outlockcolor);
write  (usr,'F3   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Send Carrier                 ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write  (usr,'F4   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Send Off Hook                ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Net Node');
textcolor (normbotcolor);
write  (usr,':                           │');
textcolor (outlockcolor);
write  (usr,'F5   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Run Protocol Setup Program   ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write  (usr,'F6   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Run Setup Program            ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Using CelerityNet');
textcolor (normbotcolor);
write  (usr,':                  │');
textcolor (outlockcolor);
write  (usr,'F7   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Terminal Program             ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write  (usr,'F8   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Read Feedback                ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'                                     ');
textcolor (normbotcolor);
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'F9   ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Sysop Functions              ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'                                     ');
textcolor (normbotcolor);
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'F10  ');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Login Local                  ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'                                     ');
textcolor (normbotcolor);
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'ALT-A');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Toggle Chat Status           ');
textcolor (normbotcolor);
writeln(usr,'│');
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'                                     ');
textcolor (normbotcolor);
write  (usr,'│');
textcolor (outlockcolor);
write  (usr,'ALT-H');
textcolor (normbotcolor);
write  (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write  (usr,'Hang Up Modem                ');
textcolor (normbotcolor);
writeln(usr,'│');
writeln(usr,'├──────────────────────────┬──────────┴──────────────┬─────────────────────┤');
write  (usr,'│ ');
textcolor (outlockcolor);
write  (usr,'Clock');
textcolor (normbotcolor);
write  (usr,':                   │');
textcolor (outlockcolor);
write  (usr,'Modem');
textcolor (normbotcolor);
write  (usr,':                   │');
textcolor (outlockcolor);
write  (usr,'Avail');
textcolor (normbotcolor);
writeln(usr,':               │');
writeln(usr,'├──────────────────────────┴─────────────────────────┴─────────────────────┤');
writeln(usr,'│                                                                          │');
write  (usr,'└──────────────────────────────────────────────────────────────────────────┘');
    if interrupted (true) then exit;
    window (1,1,80,25);
    textcolor (outlockcolor);
 if jshutup then begin
  if length(getenv('JMODEM'))<1 then
    begin
    Assign (outf,'SETJ.BAT');
    rewrite(outf);
    WriteLn(outf,'cls');
    WriteLn(outf,'echo                 Telling Jmodem to shut its mouth - please wait');
    writeln(outf,'SET JMODEM=SHUTUP');
    WriteLn(outf,'MAIN.BAT');
    textclose(outf);
  end;
 end;
   {If timeStr(Now)=Bytime then Sysopavail:=TRUE;}
    if interrupted (true) then exit;
    writeboardname;
   {setupmodem;}
    numsmail:=getnummail(1)+numfeedback;
    tmp:=getlastcaller;
   {col1;}
    gotoxy (17,9);
    textcolor (normtopcolor);
    write (usr,copy(tmp,1,23));
    gotoxy (13,11);
    textcolor (color1);
    write (usr,'F');
    textcolor (color2);
    write (usr,'A');
    textcolor (color3);
    write (usr,'Q ');
    textcolor (color4);
    write (usr,copy (ver,1,1));
    textcolor (color5);
    write (usr,copy (ver,2,1));
    textcolor (color6);
    write (usr,copy (ver,3,1));
    textcolor (color7);
    write (usr,copy (ver,4,1)+' ');
    textcolor (color8);
    write (usr,copy (date,1,1));
    textcolor (color9);
    write (usr,copy (date,2,1));
    textcolor (color10);
    write (usr,copy (date,3,1));
    textcolor (color11);
    write (usr,copy (date,4,1));
    textcolor (color12);
    write (usr,copy (date,5,1));
    textcolor (color13);
    write (usr,copy (date,6,1));
    textcolor (color14);
    write (usr,copy (date,7,1));
    textcolor (color15);
    write (usr,copy (date,8,1));
    textcolor (normtopcolor);
    gotoxy (42,4);
    write (usr,numcallers:0:0);
    writeavail;
   {gotoxy(1,7); write(usr,dszlogname);
    gotoxy(1,8); write(usr,sklog);
    col2;}
    gotoxy (18,6);
    writeln (usr,newcalls);
    gotoxy (42,6);
    writeln (usr,newposts);
{    writeln (usr,numminsused.total:0:0);
    write (usr,numminsxfer.total:0:0);
    gotoxy (1,10);}
    gotoxy (67,6);
    writeln(usr,newuploads);
    gotoxy (18,7);
    writeln(usr,newfeedback);
    gotoxy (42,7);
    writeln(usr,newmail);
    gotoxy (67,7);
    writeln(usr,numsmail);
    gotoxy (16,2);
    writeln(usr,reg.handle);
    gotoxy (56,2);
    writeln(usr,strlong(reg.serial));
    gotoxy(37,22);
    textcolor (normtopcolor);
    writeln(usr,'Waiting for Call');
    end;
    if usemouse then
    showmouse;
    repeat
      checkday;
      drawstatus;
      cnt:=0;
      if screenblank then begin
      cursor (false);
      {for iiii:=1 to 15 do begin
      gotoxy (10,iiii+1);
      textcolor (iiii);
      write (usr,'[Screen Saver ON - Press ALT-B to turn off Screen Saver]');
      gotoxy (1,iiii+1);
      delay (100);
      clreol;
      end;}
      end;
      repeat
{         while (answerring<1) and (not carrier) and (numchars>0) do begin
          k:=getchar;
          case k of
            '2':phonesringing;
            '1','3','5':connectcode(k)
          end
        end; }
         cnt:=cnt+1
      until (cnt>=500) or interrupted (false) or done;
    until done;
   end;

var k:char; time,num:integer;
    mi:minuterec;
label exit;
begin
  waitforacall:=false;
  {arq:=false;}
  doanswer;
  setparam (usecom,defbaudrate,false);
  if offcall then sendmodemstr ('~~ATM0H1|',true);
  setupmodem;
  if (offcall) or (offlocal) then sendmodemstr ('~~ATH|',true);
  starttimer (numminsidle);
  starttimer (blanker);
  color1:=1;
  color2:=2;
  color3:=3;
  color4:=4;
  color5:=5;
  color6:=6;
  color7:=7;
  color8:=8;
  color9:=9;
  color10:=10;
  color11:=11;
  color12:=12;
  color13:=13;
  color14:=14;
  color15:=15;
  wscount:=0;
  local:=false;
  screenblank:=false;
  clrscr;
  repeat
    doanswer;
    if not carrier Then Begin
      clearoutput;
      clearinput;
    End;
    mustgetbaud:=true;
    k:=statusscreen;
    if carrier then begin
      receivecall;
      if carrier then goto exit;
    end;
    case ord(k)-128 of
      48:{if not screenblank then screenblank:=true else}
         begin
         screenblank:=false;
         stoptimer2 (blanker);
         end;
      59:if usenet then begin if usemouse then hidemouse; clrscr; NewNetSend; end;
      60:begin
        if usemouse then hidemouse;
    gotoxy(37,22);
          textcolor (normtopcolor);
          write(usr,'Exiting FAQ     ');
           writestatus;
           exitprog;
         end;
      61:begin
      writestatus;
      gotoxy(37,22);
          textcolor (normtopcolor);
      write(usr,'Modem Carrier On');
          sendmodemstr('ATA|',true);
         end;
      62:begin
      writestatus;
      gotoxy(37,22);
          textcolor (normtopcolor);
      if not modemoff then write(usr,'Modem Off Hook  ') else
          write (usr,'Modem On Hook   ');
          if modemoff then begin
          sendmodemstr('ATH|',true);
          modemoff:=false end else begin
          sendmodemstr('ATH1|',true);
          modemoff:=true;
          end
         end;
      63:begin
         if usemouse then hidemouse;
         cursor (true);
         Run_Prot_Config;
         end;
      64:Begin
         if usemouse then hidemouse;
         cursor (true);
         Run_Config; Readconfig;
         End;
      65:begin
         if usemouse then hidemouse;
           clrscr;
           writestatus;
           ClosePort;
           cursor (true);
  ansicolor (7);
  textcolor (7);
           halt (121);
         end;
      66:begin
          if usemouse then hidemouse;
          window (1,1,80,25);
          clrscr;
           unum:=lookupuser (sysopname);
             if unum=0 then begin
               writeln ('No Sysop Created.');
               delay (1000);
              end;
            readurec;
           urec.timetoday:=10000;
           cursor (true);
       readfeedback;
       newfeedback:=0;
          urec.timetoday:=time;
          writeurec;
          clrscr;
          end;
      67:begin
          if usemouse then hidemouse;
          window (1,1,80,25);
          clrscr;
           unum:=lookupuser (sysopname);
             if unum=0 then begin
               writeln ('No Sysop Created.');
               delay (1000);
              end;
            readurec;
           urec.timetoday:=10000;
           cursor (true);
           mainsysopcommands;
          urec.timetoday:=time;
          writeurec;
          clrscr;
          end;
      68:begin
           if usemouse then hidemouse;
       dontanswer;
           modeminlock:=true;
           modemoutlock:=true;
           local:=true;
           online:=false;
           if (offlocal) and (local) and (not online) then begin
           sendmodemstr ('~~ATM0H1|',true);
           end;
           if newfeedback<>0 then newfeedback:=0;
           if newuploads<>0 then newuploads:=0;
           if newcalls<>0 then newcalls:=0;
           if newposts<>0 then newposts:=0;
       if newmail<>0 then newmail:=0;
           writestatus;
       {setcursor(cursoron);}cursor(true);
           goto exit
         end
    end;
  until 0=1;
  exit:
  if usemouse then hidemouse;
  textcolor (normbotcolor);
  window (1,1,80,25);
  clrscr;
end;

begin
end.