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

unit overret1;

interface

uses crt,dos, windows,
gentypes,modem,configrt,gensubs,subs1,subs2,userret,textret,flags,mainr1;

(*procedure smartnews;*)
procedure help (fn:mstr);
procedure sendmodemstr (ss:anystr; endifcarrier:boolean);
function getlastcaller:mstr;
procedure infoform(num:integer);
Procedure UserFileListing;
Procedure NewVoteX;
Procedure CheckVot;
Procedure BoXFile;
Procedure ListingHelp;
Procedure newscanhelp;
function searchforfile (f:sstr):integer;
function allowbaud:boolean;
function allowxfer:boolean;
Procedure getstring(t:lstr;Var m);
Procedure getint(t:lstr;Var i:Integer);
Procedure getboo(t:lstr;Var b:Boolean);

implementation

  Function searchforfile(f:sstr):Integer;
    Var ud:udrec;
      cnt:Integer;
    Begin
      For cnt:=1 To filesize(udfile) Do Begin
        seek (udfile,cnt - 1);
        Read(udfile,ud);
        If match(ud.filename,f) Then Begin
          searchforfile:=cnt;
          exit
        End
      End;
      searchforfile:=0
    End;

   function allowbaud:boolean;
   var k:integer;
       cnt:baudratetype;
   begin
     for cnt:=firstbaud to lastbaud do if connectbaud=baudarray[cnt] then
       if not (cnt in configset.downloadrate) then begin
       writeln(^M^G'You may not download at ',connectbaud,' baud rate!');
       allowbaud:=false;
       exit;
     end;
   allowbaud:=true;
   end;

   Function allowxfer:Boolean;
    Begin
      allowxfer:=False;
      If Not carrier Then Begin
        WriteLn(^S'You may only transfer from remote!');
        exit
      End;
   {  if filesinbatch > 0 then begin
         writeln(^S'You must first either clear or download your BATCH que!');
         exit;
      end; }
      if not allowbaud then exit;
      allowxfer:=True
    End;

  Procedure getstring(t:lstr;Var m);
    Var q:lstr Absolute m;
      mm:lstr;
    Begin
      WriteLn('Old '^S,t,^R': ',q);
      writestr('Enter new '+^S+t+^P+' [CR for no change]:');
      mm:=Input;
      If Length(mm)<>0 Then q:=mm;
      WriteLn
    End;

  Procedure getint(t:lstr;Var i:Integer);
    Var s:sstr;
    Begin
      s:=strr(i);
      getstring(t,s);
      i:=valu(s)
    End;

  Procedure getboo(t:lstr;Var b:Boolean);
    Var s:sstr;
    Begin
      s:=yesno(b);
      getstring(t,s);
      b:=UpCase(s[1])='Y'
    End;


(*
procedure smartnews;
var nfile:file of newsrec;
    line:integer;
    ntemp:newsrec;
    cnt:integer;
    dt1,dt2:datetime;
    show:boolean;
begin
  assign(nfile,'News');
  reset(nfile);
  if ioresult<>0 then exit;
  if filesize(nfile)=0 then begin
    close(nfile);
    exit;
  end;
  cnt:=0;
  while not(eof(nfile) or break or hungupon) do begin
    read(nfile,ntemp);
    inc(cnt);
    if issysop or (ntemp.location>=0) and (ntemp.maxlevel>=urec.level) and (urec.level>=ntemp.level) then

     begin
     unpacktime(ntemp.when,dt1);
     unpacktime(laston,dt2);
     show:=false;
       if (ntemp.when>=laston) then show:=true;
       if show then
       begin
       if ansigraphics in urec.config then begin
       clearscr;
       blowup(1,1,80,4);
       printxy(2,2,' ViSiON Smart News Item #');
       printzy(2,28,strr(cnt)+' - '+ntemp.title+' from '+ntemp.from);
       writeln;
       printxy(3,2,' Date:           Time:           Level:');
       printzy(3,8,datestr(ntemp.when));
       printzy(3,24,timestr(ntemp.when));
       printzy(3,41,strr(ntemp.level)+' - '+strr(ntemp.maxlevel));
       end else begin
         writeln(^M'ViSiON Smart News Item #',cnt,' - ',ntemp.title,' From ',ntemp.from);
         writeln('Date: ',datestr(ntemp.when),' Time: ',timestr(ntemp.when),' Levels: ',ntemp.level,' - ',ntemp.maxlevel);
         end;
       writeln(^M);
       printtext(ntemp.location);
       buflen:=0;
       writestr(^P'Press '^S'[Return]'^P' to continue.&');
       end;
    end;
  end;
  close(nfile);
end;  *)

procedure help (fn:mstr);
var tf:text;
    htopic,cnt:integer;
begin
  fn:=configset.textfiledi+fn;
  assign (tf,fn);
  reset (tf);
  if ioresult<>0 then begin
    writestr ('Sorry, no help is availiable!');
    if issysop then begin
      writeln ('Sysop: To make help, create a file called ',fn);
      writeln ('Group the lines into blocks separated by periods.');
      writeln ('The first group is the topic menu; the second is the');
      writeln ('help for topic 1; the third for topic 2; etc.')
    end;
    exit
  end;
  repeat
    textclose (tf);
    assign (tf,fn);
    reset (tf);
    writeln (^M);
    printtexttopoint (tf);
    repeat
      writestr (^M'Topic number [CR quits]:');
      if hungupon or (length(input)=0) then
        begin
          textclose (tf);
          exit
        end;
      htopic:=valu (input)
    until (htopic>0);
    for cnt:=2 to htopic do
      if not eof(tf)
        then skiptopoint (tf);
    if eof(tf)
      then writestr ('Sorry, no help on that topic!')
      else printtexttopoint (tf)
  until 0=1
end;

procedure sendmodemstr (ss:anystr; endifcarrier:boolean);
var cnt,ptr:integer;
    k:char;
label exit;
begin
  ptr:=0;
  while ptr<length(ss) do
    begin
                        if keyhit or (carrier=endifcarrier) then goto exit;
      ptr:=ptr+1;
      k:=ss[ptr];
      case k of
                                '|':sendchar (^M);
        '~':delay (500);
        '^':begin
              ptr:=ptr+1;
              if ptr>length(ss)
                then k:='^'
                else k:=upcase(ss[ptr]);
              if k in ['A'..'Z']
                                                                then sendchar (chr(ord(k)-64))
                                                                else sendchar(k)
            end;
                                else sendchar (k)
      end;
      delay (50);
                        while numchars > 0 do writecon (getchar)
    end;
  cnt:=0;
  repeat
                while numchars > 0 do begin
      cnt:=0;
      writecon (getchar)
    end;
    cnt:=cnt+1
        until (cnt=1000) or keyhit or (carrier=endifcarrier);
  exit:
  break:=keyhit
end;

function getlastcaller:mstr;
var qf:file of lastrec;
    l:lastrec;
begin
  getlastcaller:='';
  assign (qf,'Callers');
  reset (qf);
  if ioresult=0 then
    if filesize(qf)>0
      then
        begin
          seek (qf,0);
          read (qf,l);
          getlastcaller:=l.name
        end;
  close (qf)
end;

procedure infoform(num:integer);
var ff:text;
    fn:lstr;
    k:char;
    me:message;
    i:integer;
    teleg:integer;
begin
  writeln;
  fn:=configset.textfiledi+'InfoForm.'+strr(num);
(*  if num>1 then fn:=fn+'.'+strr(num); *)
  if not exist (fn) then begin
    writestr ('There isn''t an information form right now.');
    if issysop then
      writeln ('Sysop: To make an information form, create a text file',
             ^M'called ',fn,'.  Use * to indicate a pause for user input.');
    exit
  end;
  if ((urec.infoform<>-1) and (num=1)) or ((urec.infoform2<>-1) and (num=2)) or
     ((urec.infoform3<>-1) and (num=3)) or ((urec.infoform4<>-1) and (num=4)) or
     ((urec.infoform5<>-1) and (num=5)) then begin
    writestr ('You have an existing information form!  Replace it? *');
    if not yes then exit;
    if num=1 then teleg:=urec.infoform else if num=2 then teleg:=urec.infoform2 else
    if num=3 then teleg:=urec.infoform3 else if num=4 then teleg:=urec.infoform4 else
    if num=5 then teleg:=urec.infoform5;
    deletetext (teleg);
    if num=1 then urec.infoform:=-1 else if num=2 then urec.infoform2:=-1 else
    if num=3 then urec.infoform3:=-1 else if num=4 then urec.infoform4:=-1 else
    if num=5 then urec.infoform5:=-1;
    writeurec
  end;
  assign (ff,fn);
  reset (ff);
  me.numlines:=1;
  me.title:='';
  me.anon:=false;
  me.text[1]:='Filled out on: '+datestr(now)+' at '+timestr(now);
  while not eof(ff) do begin
    if hungupon then begin
      textclose (ff);
      exit
    end;
    read (ff,k);
    if k='|' then begin
      i:=0;
      read(ff,k);
      i:=valu(k)*10;
      read(ff,k);
      i:=i+valu(k);
      ansicolor(i);
      read(ff,k)
    end;
    if k='*' then begin
       nochain:=true;
       getstr;
       me.numlines:=me.numlines+1;
       me.text[me.numlines]:=input;
       read(ff,k)
    end;
    if k='@' then begin
      repeat
      NoChain:=True;
      getstr;
       if (length(input)=0) and not hungupon then write(^M^G^P'Please Respond!'^G^R':');
      until length(input)<>0;
      me.numlines:=me.numlines+1;
      me.text[me.numlines]:=input
    end else writechar (k)
  end;
  textclose (ff);
  if num=1 then urec.infoform:=maketext (me) else if num=2 then urec.infoform2:=maketext(me) else
  if num=3 then urec.infoform3:=maketext(me) else if num=4 then urec.infoform4:=maketext(me) else
  if num=5 then urec.infoform5:=maketext(me);
  writeurec
end;

Procedure UserFileListing;
Var IT:Char;
    tot,Total,frees:Integer;
    Leave:Boolean;

    Procedure c9;
    Begin
      ColorFB(9,1);
    End;

    Procedure c8;
    Begin
      ColorFB(0,1);
    End;

    Procedure c1;
    Begin
      ColorFb(11,1);
    End;

    Procedure c4;
    Begin
      ColorFb(4,1);
    End;

    Procedure BG;
    Begin
    Ansicolor(9);
    WriteLn('?');
    c1;
    End;

    Procedure BC;
    Begin
    Ansicolor(9);
    write('?');
    c1;
    end;

    Procedure TooBad;
    Begin
    goxy(17,2);
    WriteLn(^R'You do not have enough '^S'Free Space'^R' for that option!');
    end;

    Procedure fspace;
    begin
    Goxy(52,16);
    c8;
    Write(strr(frees)+'  ');
    end;

Procedure ShowIt;
Begin
  ClearScr;
  goxy(20,4);
  bc;ColorFb(9,1);Write('???????????????????????????????????????');bg;goxy(20,5);
  bc;c9;Write('   ViSiON Configurable File Listings   ');bg;goxy(20,6);c1;
  bc;Write('                                       ');bg;goxy(20,7);c1;
  bc;Write('    1) File Name............           ');bg;goxy(20,8);
  bc;Write('    2) File Extension.......           ');bg;goxy(20,9);
  bc;Write('    3) File Cost............           ');bg;goxy(20,10);
  bc;Write('    4) Size Of File.........           ');bg;goxy(20,11);
  bc;Write('    5) File Description.....           ');bg;goxy(20,12);
  bc;Write('    6) Date Uploaded........           ');bg;goxy(20,13);
  bc;WRite('    7) Popularity...........           ');bg;goxy(20,14);
  bc;Write('    8) Who Uploaded.........           ');bg;goxy(20,15);ColorFb(1,7);
  bc;WRite('???????????????????????????????????????');bg;goxy(20,16);c4;
  bc;c9;Write('    Total Spaces Used (77/Max)         ');bg;goxy(20,17);
  bc;colorfb(9,1);Write('???????????????????????????????????????');bg;
End;

Procedure ShowCurStats;
Begin
  Total:=0;
  tot:=93;
  goxy(49,7); If urec.use1=false then Begin tot:=tot-8; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+8; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,8); If urec.use2=false then Begin tot:=tot-4; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+4; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,9); If urec.use3=false then Begin tot:=tot-8; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+8; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,10); If urec.use4=false then Begin tot:=tot-10; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=Total+10; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,11); If urec.use5=false then Begin tot:=tot-39; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+39; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,12); If urec.use6=false then Begin tot:=tot-10; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+10; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,13); If urec.use7=false then Begin tot:=tot-4; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+4; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(49,14); If urec.use8=false then Begin tot:=tot-20; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin Total:=total+20; c9; Write('ON!'); c4; Write(' ?'); End;
  goxy(52,16);
  frees:=total;
  Write(strr(frees)+'  ');
  End;

Procedure GetuserInput;
Begin
  IT:=' ';
  Repeat
    Repeat
      If hungupon then exit;
      Until Charready or hungupon;
    It:=ReadChar;
    If Length(it)=0 then it:=' ';
    It:=Upcase(It)
    Until (Pos(It,'12345678Q')>0) or hungupon;
    If It='1' then Begin
      If urec.use1=false then urec.use1:=True Else urec.use1:=False;
      goxy(49,7); If urec.use1=false then Begin frees:=frees-8; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+8; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then begin urec.use1:=False; frees:=frees-8; TooBad; ShowCurstats; End;
      fspace;
    End;
    If It='2' then Begin
      If urec.use2=false then urec.use2:=True Else urec.use2:=False;
      goxy(49,8); If urec.use2=false then Begin frees:=frees-4; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+4; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then begin urec.use2:=False; frees:=frees-4; toobad; showcurstats;End;
      fspace;
    End;
    If It='3' then Begin
      If urec.use3=false then urec.use3:=True Else urec.use3:=False;
      goxy(49,9); If urec.use3=false then Begin frees:=frees-8; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+8; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then begin urec.use3:=False; frees:=frees-8; toobad; showcurstats;End;
      fspace;
    End;
    If It='4' then Begin
      If urec.use4=false then urec.use4:=True Else urec.use4:=False;
      goxy(49,10); If urec.use4=false then Begin frees:=frees-10; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+10; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then Begin urec.use4:=False; frees:=frees-10; toobad; showcurstats;End;
      fspace;
    End;
    If It='5' then Begin
      If urec.use5=false then urec.use5:=True Else urec.use5:=False;
      goxy(49,11); If urec.use5=false then Begin frees:=frees-39; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+39; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then Begin urec.use5:=False; frees:=frees-39; toobad; showcurstats;End;
      fspace;
    End;
    If It='6' then Begin
      If urec.use6=false then urec.use6:=True Else urec.use6:=False;
      goxy(49,12); If urec.use6=false then Begin frees:=frees-10; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+10; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then Begin urec.use6:=False; frees:=frees-10; toobad; showcurstats;End;
      fspace;
    End;
    If It='7' then Begin
      If urec.use7=false then urec.use7:=True Else urec.use7:=False;
      goxy(49,13); If urec.use7=false then Begin frees:=frees-4; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+4; c9; Write('ON!'); c4; Write(' ?'); End;
      If frees>77 then Begin urec.use7:=False; frees:=frees-4; toobad; showcurstats;End;
      fspace;
    End;
    If It='8' then Begin
      If urec.use8=false then urec.use8:=True Else urec.use8:=False;
      goxy(49,14); If urec.use8=false then Begin frees:=frees-20; c9; Write('OFF'); c8; Write(' ?');
      End Else Begin frees:=frees+20; c9; Write('ON!'); c4; Write(' ?'); End;
      if frees>77 then Begin urec.use8:=False; frees:=frees-20; toobad; showcurstats;End;
      fspace;
    End;
    If it='Q' then Begin
      Leave:=True;
      WriteUrec;
    End;
  End;

Begin
  Leave:=False;
  ShowIt;
  ShowCurStats;
  PrintXy(19,23,^R'Please Configure '^S'Your'^R' File Listings');
  Repeat
    goxy(30,20);
    Write(^R'Choice (Q/uit)'^P':');
    GetUserInput;
  Until Leave=True;
End;

function checit(num:integer;name:anystr):boolean;
   var
     x:integer;
   begin
     checit:=true;
(*     for x:=1 to 50 do
     if urec.newvoteit[x]=num then checit:=false; *)
     If urec.nuv1=name then checit:=false;
     If urec.nuv2=name then checit:=false;
     if urec.nuv3=name then checit:=false;
     If urec.nuv4=name then checit:=false;
     if urec.nuv5=name then checit:=false;
(*     if urec.nuv6=name then checit:=false;
     if urec.nuv7=name then checit:=false;
     if urec.nuv8=name then checit:=false;
     if urec.nuv9=name then checit:=false;
     if urec.nuv10=name then checit:=false; *)
   end;

procedure newvotex;
var u:userrec;
    n,cnt1,cnt:integer;
    cv,alv:boolean;
    info,name:Mstr;
    quit:boolean;

  procedure look;
  var cntz:integer;
   begin
   cnt1:=0;
   alv:=false;
   for cntz:=1 to 50 do begin
    if urec.newvoteit[cntz]=n then begin
     alv:=true;
     cntz:=50;
     end;
    end;
   end;

   Procedure addnuv;
     Procedure throwup;
     begin
     urec.nuv9:=urec.nuv10;
     urec.nuv8:=urec.nuv9;
     urec.nuv7:=urec.nuv8;
     urec.nuv6:=urec.nuv7;
     urec.nuv5:=urec.nuv6;
     urec.nuv4:=urec.nuv5;
     urec.nuv3:=urec.nuv4;
     urec.nuv2:=urec.nuv3;
     urec.nuv1:=u.handle;
     End;
   Begin
   if urec.nuv1='' then urec.nuv1:=u.handle else
   if urec.nuv2='' then urec.nuv2:=u.handle else
   if urec.nuv3='' then urec.nuv3:=u.handle else
   if urec.nuv4='' then urec.nuv4:=u.handle else
   if urec.nuv5='' then urec.nuv5:=u.handle else
   if urec.nuv6='' then urec.nuv6:=u.handle else
   if urec.nuv7='' then urec.nuv7:=u.handle else
   if urec.nuv8='' then urec.nuv8:=u.handle else
   if urec.nuv9='' then urec.nuv9:=u.handle else
   if urec.nuv10='' then urec.nuv10:=u.handle else throwup;
   end;

procedure showuser;
  begin
    writeln;
    If alv then begin
ClearScr;
WriteLn(^U'ViSiON - New User Voting'^M);
Writeln(^P'User Handle : '^R+u.handle);
Writeln;
Writeln(^P'Number of '^U'YES'^P' Votes Recieved'^R'.. '^S+strr(u.newvoteyes));
Writeln(^P'Number of '^U'NO'^P' Votes Recieved'^R'... '^S+strr(u.newvoteno));
Writeln(^P'# of Votes to be Validated'^R'.... '^S+strr(configset.vonum));
WriteLn(^P'# of Votes to be Deleted'^R'...... '^S+strr(configset.vonumNo));
Writeln(^P'# of Yes Votes User Needs'^R'..... '^S+strr(configset.vonum-u.newvoteyes));
writeln;
    cv:=False;
    repeat
    Input[1]:=' ';
    WriteStr(^R'New User Voting '^P'- ['^S'?/Help'^P']:*');
    If Upcase(Input[1])='' then Input[1]:=' ';
    info:=Upcase(Input[1]);
    If info='Y' then begin
         cv:=false;
         cnt:=