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

unit mycomman;

interface

uses crt,dos,
gentypes,configrt,modem,statret,gensubs,subs1,windows,subs2,textret,
     mailret,userret,flags,mainr1,ansiedit,lineedit,
     mainr2,overret1;

procedure nodelists;
procedure mycommand;
procedure localconfiguration;
procedure showsystemstatus;
procedure loozerlists;
procedure listusers;
procedure transfername;
procedure editnews;
procedure delerrlog;
procedure feedback;
procedure settime;
procedure changepwd;
procedure requestraise;
procedure leechlist;
procedure timebanks;
procedure makeuser;
procedure infoformhunt;
procedure donations;
procedure viewsyslog;
procedure delsyslog;
procedure showallforms;
procedure mainhelp;
procedure otherbbs;
procedure readerrlog;
procedure showad;
procedure setlastcall;
procedure removeallforms;
procedure showscreens;
Procedure showlastcallers;
Procedure JumpConference;
Procedure TopTen(eatshit:byte);
Procedure DisplayNodeInfo;
Procedure AddNews;
Procedure RumorMenu;
Procedure RandomRumor;
Procedure Get_Infoform;
Procedure UserCheck;

implementation

Procedure addnews;
		Var newline,r:Integer;
			nfile:File Of newsrec;
			ntmp,atmp:newsrec;
			numnews,cnt:Integer;
			m:message;
			t:text;
		Begin
			writehdr('Adding to the news');
			Writestr('Minimum Level to read news [1] :');
			If Input='' Then Input:='1';
			ntmp.level := Valu (input);
			Writestr('Maximum Level to read news [32767] :*');
			If Input='' Then Input:='32767';
			ntmp.maxlevel:=valu(Input);
			newline:=editor(m,false,true,'0','0');
			Ntmp.when:=now;ntmp.from:=unam;Ntmp.title:=m.title;
			ntmp.location:=newline;
			If newline<0 Then exit;
			r:=IOResult;
			Assign(nfile,'News');
			Reset(nfile);
			r:=IOResult;
			If r<>0
			Then
				Begin
					If r<>1 Then WriteLn('Error ',r,' opening news file; recreating.');
					Rewrite(nfile);
					Write(nfile,ntmp);
					numnews:=0
				End
			Else
				Begin
					numnews:=FileSize(nfile);
					For cnt:=numnews-1 Downto 0 Do
						Begin
							Seek(nfile,cnt);
							Read(nfile,atmp);
							Seek(nfile,cnt+1);
							Write(nfile,atmp)
						End;
					che;
					Seek(nfile,0);
					Write(nfile,Ntmp)
				End;
			WriteLn('News added.  News items: ',numnews+1);
			writelog(2,1,'');
			Close(nfile);
	end;

procedure mycommand;
begin
  clearscr;
  if ansigraphics in urec.config then begin
    blowup(4,2,60,7);
    printxy(4,4,^R'[ '^P'ViSiON BBS Credits'^R' ]');
    printxy(5,4,'ViSiON BBS Software is brought to you by:');
    printxy(6,4,'    Crimson Blade and The Elemental');
    printxy(8,4,' We can be contacted on the ViSiON Home Board:');
    printxy(9,4,'   Countdown to Chaos  -  (619)868-2025');
    blowup(11,20,50,11);
    printxy(12,22,'Alot of thanx to the following:');
    printxy(13,22,'  The Spectral Demon - Ideas/Menus/Doc''s');
    printxy(14,22,'  Melkor - Ideas/Beta Testing');
    Printxy(15,22,'  Xerxes - Beta Testing/Staff');
    Printxy(16,22,'  Amplitude - ViSiON Spittle');
    printxy(17,22,'  Sickler - Beta Testing');
    printxy(18,22,'  The Byter - Inspiration and CHAT!');
    printxy(19,22,'  THE SLAVELORD and Low Rider...');
    printxy(20,22,'  Thanx for making this happen....');
    goxy (1,23);
  end else begin
    writeln('                             -=-=-= ViSiON BBS Credits =-=-=-');
    writeln(^M'ViSiON BBS Software brought to you by:');
    writeln('   Crimson Blade & The Elemental');
    writeln(^M'Alot of Thanks to the following: (not in any particular ORDER!)');
    writeln('  The Spectral Demon - Ideas/Menus/Documentation');
    writeln('  Melkor             - Ideas/Beta Testing');
    writeln('  Sickler            - Beta Testing');
    writeln('  The Byter          - Inspiration and Chat');
    writeln('  THE SLAVELORD      - Ideas/Inspiration, and Thanx.'^M^M);
    writeln('               ViSiON can be seen/obtained on');
    writeln('           Countdown to Chaos - (619)868-2025 / ViSiON Home');
  end;
end;

procedure localconfiguration;
var tp1,tp2:lstr;
    q,tp:integer;
    fn:file of configsettype;

function sellitout(t2:lstr):lstr;
begin
writestr(^P'Enter the new '^R+t2+^P' for your BBS [Ret=No Change]:');
sellitout:=input;
end;

begin
repeat
q:=menu('Local Configuration','CONFIGL','SPMTUANHFCVLQ');
case q of
 1:begin
   tp1:=sellitout('SHORTNAME');
   if (tp1<>'') then configset.shortnam:=tp1;
   writelog(21,1,configset.shortnam);
   end;
 2:begin
   tp1:=sellitout('SYSTEM PASSWORD');
    if (TP1)<>'' then configset.systempasswor:=tp1;
    writelog(21,2,configset.systempasswor);
    end;
 3:begin
    writestr(^P'Enter your new Matrix Type (0=none,1=standard,2=DOS,3=Custom) [Ret=No Change]:');
    if input<>'' then tp:=valu(input) else tp:=configset.matrixtyp;
    if (tp<0) or (tp>3) then begin
       writeln(^M'Thats an invalid range!');
       tp:=configset.matrixtyp;
    end;
    configset.matrixtyp:=tp;
    writelog(21,3,strr(configset.matrixtyp));
    end;
 4:begin
    tp1:=sellitout('SYSOP PASSWORD');
    if (tp1<>'') then configset.sysop:=tp1;
    writelog(21,4,configset.sysop);
   end;
 5:Begin
   tp1:=sellitout('TIME REFUND');
    if (tp1<>'') then tp:=valu(tp1) else tp:=configset.timepercentbac;
    configset.timepercentbac:=tp;
    writelog(21,5,strr(tp));
   end;
 6:Begin
   writestr(^P'Allow new users ? *');
   if yes then configset.privat:=false else configset.privat:=true;
   if configset.privat then writelog(21,6,'No') else writelog(21,6,'Yes');
   end;
 7:Begin
   tp1:=sellitout('NEW USER PASSWORD');
   if (tp1<>'') then configset.newuserpas:=tp1;
   if match(tp1,'N') then configset.newuserpas:='';
   writelog(21,7,configset.newuserpas);
   end;
 8:Begin
    tp1:=sellitout('LOGIN HEADER');
    if (tp1<>'') then configset.loginheade:=tp1;
    writelog(21,8,configset.loginheade);
    end;
 9:Begin
    writestr(^P'Allow feedback from the Matrix ? *');
    configset.feedmatr:=yes;
    if yes then writelog(21,9,'Yes') else writelog(21,9,'No');
   end;
 10:begin
     writestr(^P'Allow paging from the matrix ? *');
     configset.chatmatr:=yes;
     if yes then writelog(21,10,'Yes') else writelog(21,10,'No');
     end;
 11:Begin
    clearscr;
    writeln(^P'Status for '+^R+configset.longnam+^P+' registered to '+^R+registo);
    writeln;
    Tab(^P'Shortname',30);
    writeln(':'^R+configset.shortnam);
    tab(^P'Matrix type',30);
    writeln(':'^R+strr(configset.matrixtyp));
    tab(^P'Upload Time back',30);
    writeln(':'^R+strr(configset.timepercentbac));
    tab(^P'System Password',30);
    writeln(':'^R+configset.systempasswor);
    tab(^P'SysOp Password',30);
    writeln(':'^R+configset.sysop);
    tab(^P'Allow New Users',30);
    write(':'^R); if configset.privat then writeln('No') else writeln('Yes');
    tab(^P'New User Password',30);
    writeln(':'^R+configset.newuserpas);
    tab(^P'Login Header',30);
    writeln(':'^R+configset.loginheade);
    tab(^P'Allow Feedback from Matrix',30);
    write(':'^R); if configset.feedmatr then writeln('Yes') else writeln('No');
    tab(^P'Allow Chat from Matrix',30);
    write(':'^R); if configset.chatmatr then writeln('Yes') else writeln('No');
    tab(^P'Leech Week active',30);
    write(':'^R); if configset.leechwee then writeln('Yes') else writeln('No');
    end;
12:begin
   writestr(^P'Make leech week active ? *');
   configset.leechwee:=yes;
   if yes then writelog(21,11,'Yes') else writelog(21,11,'No');
   end;
end  until (q=13) or hungupon;
   writestr(^M^P'Save the new configuration ? *');
                      if not yes then exit;
                      assign(fn,configset.forumdi+'CONFIG.BBS');
                      rewrite(fn);
                      write(fn,configset);
                      close(fn);
                      writeln(^M^P'New configuration saved!');
end;


procedure showsystemstatus;
var totalused,totalidle,totalup,totaldown,totalmins,callsday:real;
		 cnt:integer;

var tp1:string[3];
begin
  totalused:=numminsused.total+elapsedtime(numminsused);
  totalidle:=numminsidle.total;
  totalup:=totalidle+numminsused.total;
  totalmins:=1440.0*(numdaysup-1.0)+timer;
  totaldown:=totalmins-totalup;
  callsday:=round(10*numcallers/numdaysup)/10;
  ClearScr;
  mens:=true;
  Nobreak:=false;
  DontStop:=True;
  AnsiColor(Urec.StatusBoxColor);
  FuckXy(2,21,^P'[ ViSiON version '^A+VersionNum+^P' System Status ]');
  AnsiColor(Urec.StatusBoxColor);

  BoxIt(4,1,40,8);
  AnsiColor(Urec.STatusBoxColor);
  FuckXy(4,3,^R'[ '^P'Main Status'^R' ]');
  FuckXy(5,3,^R'Board Name...: '^S+ConfigSet.LongNam);
  FuckXy(6,3,^R'SysOps Name..: '^S+RegisTo);
  FuckXy(7,3,^R'Total Users..: '^S+Strr(NumUsers));
  FuckXy(8,3,^R'Total Callers: '^S+StReal(NumCallers));
  FuckXy(9,3,^R'Calls Today..: '^S+Strr(CallsToday));
  FuckXy(10,3,^R'Calls per Day: '^S);
  WriteLn(CallsDay:2:1);
  AnsiColor(Urec.StatusBoxColor);

  BoxIt(4,42,30,6);
  FuckXy(5,44,^R'Files Uploaded: '^S+StrLong(Gnuf)+^M);
  FuckXy(6,44,^R'Total Messages: '^S+StrLong(Gnup)+^M);
  FuckXy(7,44,^R'Final PCR.....: '^S+Strr(Ratio(Gnup,Trunc(NumCallers)))+^M);

  AnsiColor(Urec.StatusBoxColor);
  BoxIt(10,42,30,7);
  FuckXy(10,44,^R'[ '^P'Modem Status'^R' ]');
  FuckXy(11,44,^R'Default Baud: '^S+Strlong(BaudRate));
  FuckXy(12,44,^R'Comm Port...: '^S+Strr(ConfigSet.UseCo));
  FuckXy(13,44,^R'Buffer Size.: '^S'512 bytes');
  FuckXy(14,44,^R'Bytes Sent..: '^S+strr(totalsent));
  FuckXy(15,44,^R'Bytes Recv..: '^S+strr(totalrece));
  PrintXy(20,1,'');
end;

procedure tabul (n:anystr; np:integer);
var cnt:integer;
begin
  write (n);
  ColorFB (1,0);
  for cnt:=length(n) to np-1 do write ('.');
  ColorFB (9,0);
end;

procedure listusers;
var cnt,u1,u2:integer;
    u,uu : UserRec;
    areacode:anystr;
begin
  writehdr ('Listing Users');
  parserange (numusers,u1,u2);
  if u1=0 then exit;
  ClearScr; ANSiCOLOR(15);
    writeln ('ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ');ANSiCOLOR(7);
    write ('Û'); ColorFB(1,7);
    Write ('   Alias/User Handle          Main Level       User Note           Area Code ');
    ANSiCOLOR(7); WriteLn('Û'); ANSicolor(8);
    writeln ('ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß');
  if break then exit;
  for cnt:=u1 to u2 do begin
	  ColorFB (9,0);
    seek (ufile,cnt);
    read (ufile,uu);
    che;
      if length(uu.handle)>0 then begin
        if break then exit;
        tabul (uu.handle,32);
        if break then exit;
        if uu.level>=100 then begin
        	ColorFB (12,0);
        	tabul ('SysOp',9);
          ColorFB (9,0);
        end else
        if (uu.level>=90) and (uu.level<=99) then begin
        	ColorFB (4,0);
          tabul ('CoSysOp',9);
          ColorFB (9,0);
        end else
        if (uu.level<=1) then begin
        	ColorFB (4,0);
        	tabul ('NEW',9);
          ColorFB (9,0);
        end else
        if (uu.level>ulvl) then begin
          ColorFB (7,0);
	  tabul ('PRIV',9);
          ColorFB (9,0);
        end else begin
        Colorfb(13,0);
	tabul (strr(uu.level),9);
        end;
        if break then exit;
        Colorfb(3,0);
        tabul (uu.usernote,29);
        if break then exit;
        with uu do begin
          Colorfb(14,0);
          areacode:=uu.phonenum[1]+uu.phonenum[2]+uu.phonenum[3];
          tabul ('['+areacode+']',5);
            ColorFB (9,0);
        end;
        if break then exit;
       writeln;
      end
    end;
end;

procedure transfername;
var un,nlvl,ntime,tmp:integer;
    u:userrec;
begin
  if ulvl<configset.sysopleve then writeln(^M'You can''t do this without SysOp Access!');
  if ulvl>configset.sysopleve-1 then begin
  if tempsysop then begin
    writestr ('Disabling temporary sysop powers...');
    ulvl:=regularlevel;
    tempsysop:=false
  end;
  writestr ('Transfer to user name:');
  if length(input)=0 then exit;
  un:=lookupuser(input);
  if unum=un then begin
    writestr ('You can''t transfer to yourself!');
    exit
  end;
  if un=0 then begin
    writestr ('No such user.');
    exit
  end;
  seek (ufile,un);
  read (ufile,u);
  if ulvl<configset.sysopleve then if not checkpassword(u) then begin
    writelog (1,5,u.handle);
    exit
  end;
  writelog (1,4,u.handle);
  updateuserstats (false);
  ntime:=0;
  if datepart(u.laston)<>datepart(now) then begin
    tmp:=ulvl;
    if tmp<1 then tmp:=1;
    if tmp>100 then tmp:=100;
    ntime:=configset.usertim[tmp]
  end;
  if u.timetoday<10
    then if issysop or (u.level>=configset.sysopleve)
      then
        begin
          writestr ('The user has '+strr(u.timetoday)+' min(s) left!');
          writestr ('New time left:');
          ntime:=valu(input)
        end
      else
        if u.timetoday>0
          then writeln ('Warning: You have ',u.timetoday,' minutes left!')
          else
            begin
              writestr ('Sorry, that user doesn''t have any time left!');
              exit
            end;
  unum:=un;
  readurec;
  if ntime<>0 then begin
    urec.timetoday:=ntime;
    writeurec
  end;
 end;
end;

Procedure editnews;
  Var nn,numnews:Integer;
    nf:File Of newsrec;
    News:newsrec;
  Procedure getnn(txt:mstr);
    Begin
      writestr(^S+'News number to '+^R+txt+^S+':');
      nn:=valu(Input);
      If (nn<1) Or (nn>numnews) Then nn:=0
    End;

  Procedure delnews;
    Var cnt:Integer;
      r:Integer;
      NTmp:newsrec;
    Begin
      If nn=0 Then getnn('delete');
      If nn<>0 Then Begin
        Seek(nf,nn-1);
        Read(nf,Ntmp);che;
        deletetext(Ntmp.Location);
        numnews:=FileSize(nf)-1;
        For cnt:=nn To numnews Do
          Begin
            Seek(nf,cnt);
            Read(nf,nTmp);
            Seek(nf,cnt-1);
            Write(nf,Ntmp)
          End;
        Seek(nf,numnews);
        Truncate(nf)
      End
    End;

  Procedure listnews;
    Var cnt:Integer;
      r,sector:Integer;
      q:buffer;
      l:anystr;
      k:Char;
      Ntmp:newsrec;
    Begin
      clearbreak;
      WriteLn (^S'  News    Min    Max          Title ' ) ;
      WriteLn (^S' Number  Level  Level' ) ;
      WriteLn ;

      For cnt:=1 To numnews Do Begin
        Seek(nf,cnt-1);
        Read(nf,ntmp);
        r:=ntmp.location;
        Seek(tfile,r);
        Read(tfile,q);

        Write( Cnt:5 , '    ' , ntmp.level:5,'  ',ntmp.maxlevel:5, ' ');
        r:=1;
        k:=' ';
        l:='';
        Writeln (ntmp.title);
        If break Then exit
      End;
    End;

  Procedure viewnews;
    Var r:Integer;
      Ntmp:newsrec;
    Begin
      If nn=0 Then getnn('view');
      If nn<>0 Then Begin
        Seek(nf,nn-1);
        Read(nf,nTmp);che;
        r:=ntmp.location;
        WriteLn('News #',nn,' ''',ntmp.title,''' From :',ntmp.from);
        WriteLn('Date: ',Datestr(ntmp.when),' Level [',ntmp.level,'-',ntmp.maxlevel,']');
        WriteLn('__________________________');
        printtext(r);
        writestr(^P^M'Press [Return] to continue.*')
      End
    End;


  Procedure adddnews;
    Begin
      Close(nf);
      addnews;
      Assign(nf,'News');
      Reset(nf)
    End;

  Var q:Integer;
  Begin
    Assign(nf,'News');
    Reset(nf);
    If IOResult<>0 Then writestr('No news!  Use [A] to add some!') Else Begin
      Repeat
        numnews:=FileSize(nf);
        Write(^B^M'News entries: ',numnews);
        q:=menu('News edit','NEWS','ADLVQE');
        nn:=valu(Copy(Input,2,255));
        If (nn<1) Or (nn>numnews) Then nn:=0;
        Case q Of
          1:adddnews;
          2:delnews;
          3:listnews;
          4:viewnews;
        End;
        If numnews=0 Then Begin
          Close(nf);
          Erase(nf);
          q:=5
        End
      Until (q=5) Or hungupon
    End;
    Close(nf)
  End;



procedure delerrlog;
var e:text;
    i:integer;
begin
  writestr ('Delete error log:  Confirm:');
  if not yes then exit;
  assign (e,'errlog');
  reset (e);
  i:=ioresult;
  if ioresult=1
    then writeln (^M'No error log!')
    else begin
      textclose (e);
      erase (e);
      writestr ('Error log deleted.');
      if ioresult>1
        then writeln ('I/O error ',i,' deleting error log!');
      writelog (2,2,'')
    end
end;

procedure feedback;
var m:mailrec;
    me:message;
begin
  writestr (^P'Leave '^R+configset.Sysopnam+^P' feedback? *');
  if not yes then exit;
  m.line:=editor(me,false,true,'0','0');
  if m.line<0 then exit;
  m.title:=me.title;
  m.sentby:=unam;
  m.anon:=false;
  m.when:=now;
  addfeedback (m);
  writestr ('Feedback sent.')
end;

procedure settime;
var t:integer;
    n:longint;
    r:registers;
    d:datetime;
    ken:integer;
begin
ken:=timeleft;
  writestr ('Current time: '+timestr(now));
  writestr ('Current date: '+datestr(now));
  writestr ('Enter new time:');
  if length(input)<>0
    then begin
      t:=timeleft;
      unpacktime (timeval(input),d);
      r.ch:=d.hour;
      r.cl:=d.min;
      r.dh:=0;
      r.dl:=0;
      r.ah:=$2d;
      intr ($21,r);
      if r.al=$ff then writestr ('Invalid time!');
      settimeleft (t)
    end;
  writestr ('Enter new date:');
  if length(input)<>0
    then begin
      unpacktime (dateval(input),d);
      r.dl:=d.day;
      r.dh:=d.month;
      r.cx:=d.year;
      r.ah:=$2b;
      intr ($21,r);
      if r.al=$ff then writestr ('Invalid date!')
    end;
    settimeleft(ken);
  writelog (2,4,'')
end;

procedure changepwd;
var t:sstr;
begin
  writehdr ('Password Change');
  dots:=true;
  buflen:=15;
  write ('Enter new password: ');
  if getpassword
    then begin
      writeurec;
      writestr ('Password changed.');
      writelog (1,1,'')
    end else
      writestr ('No change.')
end;

procedure requestraise;
var t:text;
    q:lstr;
    p,l1,l2:integer;
    s1,s2:sstr;
    me:message;
    m:mailrec;
label nope,found;
begin
  assign (t,configset.textfiledi+'RAISEREQ');
  reset (t);
  if ioresult<>0 then goto nope;
  printtexttopoint (t);
  while not eof(t) do begin
    readln (t,q);
    p:=pos('-',q);
    if p>0
      then
        begin
          s1:=copy(q,1,p-1);
          s2:=copy(q,p+1,255)
        end
      else
        begin
          s1:=copy(q,1,15);
          s2:=s1
        end;
    val (s1,l1,p);
    if p=0 then val (s2,l2,p);
    if p<>0 then begin
      textclose (t);
      error ('Invalid range in RAISEREQ: %1','',q);
      exit
    end;
    if (ulvl>=l1) and (ulvl<=l2) then goto found;
    skiptopoint (t)
  end;
  nope:
  error ('No text for level %1','',strr(ulvl));
  textclose (t);
  p:=ioresult;
  exit;
  found:
  printtexttopoint (t);
  textclose (t);
  if hungupon then exit;
  m.line:=editor (me,false,true,'0','0');
  if m.line<0 then exit;
  m.anon:=false;
  m.title:='Raise request; now lvl='+strr(ulvl);
  m.sentby:=unam;
  m.when:=now;
  addfeedback (m);
end;

procedure leechlist;
var u:userrec;
    f,l:integer;
    x1,x2,x3,ud,udk:longint;
    y1,y2,y3:real;
    worsud,worsudk:longint;
    w1,w2:mstr;
    beenaborted:boolean;
begin
f:=1;
l:=numusers;
seek(ufile,f);
clearscr;
beenaborted:=false;
writehdr(' Leech List ');
writeln(^R'Name');
writeln(^U'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
w1:='Yer Momma';
w2:=w1;
worsud:=10000;
worsudk:=10000;
write(^B);
for f:=1 to l do begin
read(ufile,u);
if break then beenaborted:=true;
x1:=u.uploads;
x2:=u.downloads;
if x1<1 then x1:=1;
if x2<1 then x2:=1;
y1:=int(x1);
y2:=int(x2);
y3:=y1/y2;
y3:=y3*100;
x3:=trunc(y3);
ud:=x3;
x1:=u.upkay;
x2:=u.dnkay;
if x1<1 then x1:=1;
if x2<1 then x2:=1;
y1:=int(x1);
y2:=int(x2);
y3:=y1/y2;
y3:=y3*100;
x3:=trunc(y3);
udk:=x3;
if not beenaborted then
if ((configset.leechud>=ud) or (configset.leechk>=udk)) and (u.level<configset.exemptpc) then begin
write(^B);
writeln(u.handle);
if udk<worsudk then begin
worsudk:=udk;
w1:=u.handle;
end;
if ud<worsud then begin
worsud:=ud;
w2:=u.handle;
end;
end;
end;
writeln(^M^P'The worst offenders are:');
writeln(^R'For U/D Ratio it goes to ',w2,' with a ',worsud,'% ratio!');
writeln(^R'For U/D K it goes to ',w1,' with a ',worsudk,'% ratio!');
writeln(^M^P'If your handle is above here, you should do something to clear it up!');
end;


procedure timebanks;
var tm,tm2,tm3,tmp:integer;
    ke:string[1];
begin
if not configset.usetimebank then begin
clearscr;
writeln(^R'Sorry, but the Time Bank is closed right now!');
exit;
end;
if urec.level<configset.levelusetb then begin
clearscr;
writeln(^R'Sorry, you do not have enough access to use the time-bank!');
exit;
end;
repeat
clearscr;
writehdr(' The Time Bank ');
writeln(^M^R'You have ',timeleft,' min(s) left online today.');
writeln(^M^R'You have ',urec.timebank,' min(s) in your bank account.');
writestr(^M^P'[W]ithdraw, [D]eposit, [Q]uit :*');
ke:=upstring(input);
if match(ke,'D') then begin
  if (urec.timebank>=configset.totalallowed) then
  writeln('I''m sorry, but you already have the maximum allowed in your account!')
  else begin
  tm:=configset.totalallowed-urec.timebank;
  if tm>timeleft then tm:=timeleft;
  writestr(^P'You may deposit up to '+strr(tm)+' minutes. How much do you wish to deposit? *');
  tm2:=valu(input);
  if tm2<0 then writeln('That was invalid!') else
  if tm2>tm then writeln('Sorry, you have broken the maximum limit!') else
  if tm2>timeleft then writeln('Sorry, you don''t have that much time left!')
  else begin
     urec.timebank:=urec.timebank+tm2;
     settimeleft(timeleft-tm2);
     writeln(Tm2,' minutes have been deposited in your account!');
  end;
 end;
 end;
 if match(input,'W') then begin
  if urec.timebank<1 then writeln('I''m sorry, but you have no time in your account to withdraw!')
  else begin
    writestr(^M'You may withdraw up to '+strr(urec.timebank)+' minutes. How much to withdraw?*');
    tm:=valu(input);
    if tm<0 then writeln('Invalid choice!') else
    if tm>urec.timebank then writeln('Yes, that would be nice, but you don''t have that kind of time!')
    else  begin
    urec.timebank:=urec.timebank-tm;
    settimeleft(timeleft+tm);
    writeln(^M,tm,' minutes have been withdrawn from your account!');
    end;
  end;
  end;
  delay(500);
until match(ke,'Q') or hungupon;
end;




procedure rumormenu;
var rfile:file of rumorrec;
    r,ar:rumorrec;

  function numrumors:integer;
  begin
    numrumors:=filesize(rfile)
  end;

  procedure seekrfile (n:integer);
  begin
    seek (rfile,n-1)
  end;

  procedure openrfile;
  var n:integer;
  begin
    n:=ioresult;
    assign (rfile,'Rumors.Dat');
    reset (rfile);
    if ioresult<>0 then begin
      close (rfile);
      n:=ioresult;
      rewrite (rfile)
    end
  end;

procedure showit (n:integer);
var rr:rumorrec;
    x:integer;
    p:byte;
    a,sex,horndogz,fuck:string;
begin
   seekrfile (n);
   read (rfile,rr);
   if ulvl<rr.level then exit;
   writeln;
   x:=1;
  while x <= length(rr.rumor) do begin
  case rr.rumor[x] of
    '|':begin
    x:=x + 1;
    sex:=copy(rr.rumor,x,1);
    horndogz:=copy(rr.rumor,x+1,1);
    a:=(upcase(sex[1]))+(upcase(horndogz[1]));
    if x <= length(rr.rumor) then begin
    If
    a='01' then ansicolor(1) else If
    a='02' then ansicolor(2) else if
    a='03' then ansicolor(3) else if
    a='04' then ansicolor(4) else if
    a='05' then ansicolor(5) else if
    a='06' then ansicolor(6) else if
    a='07' then ansicolor(7) else if
    a='08' then ansicolor(8) else if
    a='09' then ansicolor(9) else if
    a='10' then ansicolor(10) else if
    a='11' then ansicolor(11) else if
    a='12' then ansicolor(12) else if
    a='13' then ansicolor(13) else if
    a='14' then ansicolor(14) else if
    a='15' then ansicolor(15);
    end;
    x:=x + 2;
    end else begin
    write (rr.rumor[x]);
    x:=x + 1;
    end
  end;
end;
ansireset;
If urec.prompttype=1 then WriteLn(^M^M);
If urec.prompttype=2 then WriteLn(^M^M);
end;

  procedure listrumors;
  var cnt:integer;
      b:boolean;
      t,n1,n2:integer;
  begin
    writeln;
    ansireset;
    if numrumors<1 then begin
     writeln ('There are no Rumors!');
     exit;
    end;
    b:=true;
    seekrfile (1);
    writehdr ('Rumors List');
    parserange (numrumors,n1,n2);
    if n1=0 then exit;
    t:=n1-1;
    for cnt:=n1 to n2 do begin
        t:=t+1;
        seek (rfile,t-1);
        read (rfile,r);
        if b then begin
         writeln
         (^P'#'^S'   Title                         '^U'Date      '^R'Author');
         writeln(^S'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'^M^R);
         b:=false
        end;
        ansicolor (urec.promptcolor);
        tab (strr(cnt),4);
        ansicolor (urec.statcolor);
        tab (r.title,30);
        ansicolor (urec.inputcolor);
        tab (datestr(r.when),10);
        ansicolor (urec.regularcolor);
        if r.author='...!@ANON#$...' then
        begin
         write ('[Anonymous]');
         if ulvl>=configset.anonymousleve then write (^R,' ('^S,r.author2,^R')');
         writeln;
        end
        else writeln (^S,r.author);
        ansireset;
        if break then exit;
        ansicolor (urec.regularcolor);
    end;
    if b then writestr ('There are no Rumors!')
  end;

  function getrnum (txt:mstr):integer;
  var n:integer;
  begin
    getrnum:=0;
    repeat
      writeln;
      writestr ('Rumor Number to '+txt+' [?/List]:');
      if length(input)=0 then exit;
      if upcase(input[1])='?'
        then listrumors
        else begin
          n:=valu(input);
          if (n<1) or (n>numrumors) then begin
            writestr (^M'Number out of range!');
            exit
          end;
          seekrfile (n);
          read (rfile,r);
          if (ulvl<r.level) and (not issysop) then exit;
          getrnum:=n;
          exit
        end
    until hungupon
  end;

procedure showrumor (n:integer);
var rr:rumorrec;
begin
   seekrfile (n);
   read (rfile,rr);
   if ulvl<rr.level then exit;
   writeln;
   showit(n);
   ansireset;
end;

  procedure addrumor;
  var x,b:boolean;
      y,t:text;
      cdir,cddir:lstr;
      n:integer;
      z:anystr;
      apecks:rumorrec;

  function matchtitle (f:sstr):integer;
  var cnt:integer;
      monark:rumorrec;
  begin
    for cnt:=1 to numrumors do begin
      seekrfile (cnt);
      read (rfile,monark);
      if match (monark.title,f) then begin
        matchtitle:=cnt;
        ansireset;
        exit
      end
    end;
    matchtitle:=0
  end;

    begin
    if ulvl<2 then begin
     reqlevel (2);
     exit
    end;
    if numrumors>=999 then begin
     writeln;
     writeln ('Sorry, there are too many rumors now!');
     writeln ('Ask your Sysop to delete some.');
     exit
    end;
    ansireset;
  writehdr('Add a Rumor');
    buflen:=30;
    writeln (^U'      '^S'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-'^U'');
    writestr('Title: &');
    apecks.title:=input;
    if length(input)=0 then exit;
    if matchtitle(apecks.title)>0 then begin
     writeln;
     writeln ('Sorry, that Rumor already exists! Try another Title!');
     exit
    end;
    apecks.level:=1;
    apecks.author:=unam;
    apecks.author2:=unam;
    writeln;
    if ulvl>=configset.anonymousleve then begin
     writestr ('Post Rumor Anonymous [y/n]? *');
     if yes then apecks.author:='...!@ANON#$...' else
     apecks.author:=unam;
    end;
    apecks.when:=now;
    ansireset;
    writeln;
    writestr ('Level required to read Rumor [CR/1]: *');
    if length(input)=0 then apecks.level:=1 else
    apecks.level:=valu(input);
    writeln;
    writeln ('Enter Rumor [CR to Abort] Use |01 - |15 For Color');
    buflen:=78;
    writeln (^U' '^S'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-'^U'');
    writestr('> &');
    if input='' then exit;
    b:=true;
    apecks.rumor:=input;
    seekrfile (numrumors+1);
    write (rfile,apecks);
    if b then writeln (^M'Rumor created!');
    if not b then begin
    exit
    end;
  end;

  procedure deleterumor;
  var cnt,n:integer;
      f:file;
  begin
    n:=getrnum ('Delete');
    if n=0 then exit;
    seekrfile (n);
    read (rfile,r);
    if not issysop then
    if not match(r.author2,unam) then
    begin
     writeln;
     writeln ('You didn''t post that!!');
     writeln;
     exit
    end;
    writeln;
    seekrfile(n);
    showit(n);
    writeln;
    writestr ('Delete this Rumor [y/n]? *');
    if not yes then exit;
    for cnt:=n+1 to numrumors do begin
     seekrfile (cnt);
     read (rfile,r);
     seekrfile (cnt-1);
     write (rfile,r);
    end;
    seekrfile (numrumors);
    truncate (rfile);
    writelog (1,8,r.title)
  end;

  const beenaborted:boolean=false;

  function aborted:boolean;
  begin
    if beenaborted then begin
      aborted:=true;
      exit
    end;
    aborted:=xpressed or hungupon;
    if xpressed then begin
      beenaborted:=true;
      writeln (^B'Newscan aborted!')
    end
  end;

  procedure rumorsnewscan;
  var first,cnt:integer;
      nd:boolean;
      re:rumorrec;
  begin
    writehdr ('Rumors Newscan');
    if numrumors<1 then exit;
    for cnt:=1 to numrumors do begin
     seekrfile (cnt);
     read (rfile,re);
     if (re.when>laston) and (ulvl>=re.level) then begin
      ansicolor (urec.inputcolor);
      tab (strr(cnt)+'.',4);
      ansicolor (urec.promptcolor);
      write  (re.title);
      ansicolor (urec.regularcolor);
      write (' by ');
      ansicolor (urec.inputcolor);
      if re.author='...!@ANON#$...' then
      write ('<Anonymous>') else write (re.author2);
      writeln;
      showit(cnt)
     end;
    end;
  end;

  procedure searchfortext;
  var x:integer;
      mixmasterfag:boolean;
      s:anystr;
      rr:rumorrec;
  begin
   if numrumors<1 then begin
    writeln (^M'No Rumors Exist!'^M);
    exit;
   end;
   writehdr ('Search for Text in all Rumors');
   writeln ('Enter Text to search for:');
   writestr ('-> &');
   writeln;
   if length(input)=0 then exit;
   s:=input;
   s:=upstring(s);
   for x:=1 to numrumors do begin
    mixmasterfag:=false;
    seekrfile (x);
    read (rfile,rr);
    if pos(s,upstring(rr.title))>0 then mixmasterfag:=true;
    if pos(s,upstring(rr.rumor))>0 then mixmasterfag:=true;
    if pos(s,upstring(rr.author))>0 then mixmasterfag:=true;
    if ((ulvl>=configset.anonymousleve) and (pos(s,upstring(rr.author2))>0)) then mixmasterfag:=true;
    if (mixmasterfag=true) and (ulvl>=rr.level) then begin
     ansicolor (urec.inputcolor);
     tab (strr(x)+'.',4);
     ansicolor (urec.promptcolor);
     write  (rr.title);
     ansicolor (urec.regularcolor);
     write (' by ');
     ansicolor (urec.inputcolor);
     if rr.author='...!@ANON#$...' then
     write ('<Anonymous>') else write (rr.author2);
     writeln;
     write (' "');
     ansicolor (urec.statcolor);
     write (rr.rumor);
     ansicolor (urec.regularcolor);
     writeln ('"');
    end;
   end;
  end;

label later;
var prompt:lstr;
    n,q,b:integer;
    k:char;
    mp:boolean;
begin
  if not configset.userume then begin
   writeln;
   writeln ('Rumors are not in use!');
   writeln;
   exit;
  end;
  openrfile;
  mp:=moreprompts in urec.config;
  if mp then urec.config:=urec.config-[moreprompts];
  repeat
    q:=menu ('Rumors','RUMOR','LAD#EQNS');
    writeln;
    if q<0 then begin
     b:=-q;
     if (b<0) or (b>numrumors) then
     writeln (^M'Number out of range!') else
     showrumor (b);
    end else
    case q of
     1:listrumors;
     2:addrumor;
     3:deleterumor;
     7:rumorsnewscan;
     8:searchfortext;
    end;
  until (q=6) or (hungupon);
  later:
  close (rfile);
  if mp then urec.config:=urec.config+[moreprompts];
end;

procedure randomrumor;
var rfile:file of rumorrec;

  function numrumors:integer;
  begin
    numrumors:=filesize(rfile)
  end;

  procedure seekrfile (n:integer);
  begin
    seek (rfile,n-1)
  end;

  procedure openrfile;
  var n:integer;
  begin
    n:=ioresult;
    assign (rfile,'Rumors.Dat');
    reset (rfile);
    if ioresult<>0 then begin
      close (rfile);
      n:=ioresult;
      rewrite (rfile)
    end
  end;

procedure showit (n:integer);
var rr:rumorrec;
    x:integer;
    p:byte;
    a,sex,horndogz,fuck:string;
begin
   seekrfile (n);
   read (rfile,rr);
   if ulvl<rr.level then exit;
   writeln;
   x:=1;
  while x <= length(rr.rumor) do begin
  case rr.rumor[x] of
    '|':begin
    x:=x + 1;
    sex:=copy(rr.rumor,x,1);
    horndogz:=copy(rr.rumor,x+1,1);
    a:=(upcase(sex[1]))+(upcase(horndogz[1]));
    if x <= length(rr.rumor) then begin
    If
    a='01' then ansicolor(1) else If
    a='02' then ansicolor(2) else if
    a='03' then ansicolor(3) else if
    a='04' then ansicolor(4) else if
    a='05' then ansicolor(5) else if
    a='06' then ansicolor(6) else if
    a='07' then ansicolor(7) else if
    a='08' then ansicolor(8) else if
    a='09' then ansicolor(9) else if
    a='10' then ansicolor(10) else if
    a='11' then ansicolor(11) else if
    a='12' then ansicolor(12) else if
    a='13' then ansicolor(13) else if
    a='14' then ansicolor(14) else if
    a='15' then ansicolor(15);
    end;
    x:=x + 2;
    end else begin
    write (rr.rumor[x]);
    x:=x + 1;
    end
  end;
end;
ansireset;
If urec.prompttype=1 then WriteLn(^M^M);
If urec.prompttype=2 then WriteLn(^M^M);
end;

var x:integer;
begin
 if not configset.userume then exit;
 openrfile;
 if numrumors<1 then begin
  writeln;
  ansicolor (11);
  write ('"');
  ansicolor (12);
  write ('Press ''R'' to make a Rumor...');
  ansicolor (11);
  writeln ('"');
  ansireset;
 end else
 begin
  seekrfile (1);
  randomize;
  x:=random (numrumors+1);
  showit (x);
 end;
 close (rfile);
 ansireset;
end;


procedure loozerlists;
var fn:text;
    Num:Integer;
    Loozers:Array[1..500] of Mstr;
    dummystr:mstr;
    Ch:Char;

  Procedure ShowLoozers;
  Var Cnt:Integer;
  Begin
  ClearScr;
  WriteHdr('Loozer Lists');
  For Cnt:=1 to Num Do
    WriteLn(^S'[',Cnt,'] '^R+Loozers[Cnt]);
  End;

  Procedure AddLoozers;
  Begin
    WriteStr(^M^R'Enter name of Loozer to Add:');
    if Input<>'' then Begin
      Inc(Num);
      Loozers[Num]:=Input;
    End;
  End;

  Procedure DeleteLoozer;
  Var Cnt:Integer;
  Begin
    WriteStr(^M^R'Enter the # of the Loozer to Delete:');
    If (Input='') or (valu(Input)<1) or (Valu(Input)>Num) then Exit;
    If Valu(Input)=Num then  Else
      For Cnt:=Valu(Input) to Num-1 do Loozers[Cnt]:=Loozers[Cnt+1];
      Dec(Num);
    End;

  Procedure SaveLoozers;
  Var Cnt:Integer;
  Begin
   Assign(Fn,ConfigSet.TextFileDi+'BlackLst');
   ReWrite(Fn);
   For Cnt:=1 to Num Do WriteLn(Fn,Loozers[Cnt]);
   TextClose(Fn);
   End;

  Procedure ReadLoozers;
  Begin
    Assign(Fn,ConfigSet.TextFileDi+'BlackLst');
    Reset(Fn);
    Num:=0;
    While Not Eof(Fn) do
      Begin
        ReadLn(Fn,DummyStr);
        Inc(Num);
        Loozers[Num]:=DummyStr;
      End;
    TextClose(Fn);
   End;

begin
if not exist(configset.textfiledi+'Blacklst') then begin
writestr(^M+'There is no loozer list, do you wish to create one now? *');
if not yes then exit;
assign(fn,configset.textfiledi+'Blacklst');
rewrite(fn);
textclose(fn);
end;
  ReadLoozers;
  Repeat
    ShowLoozers;
    WriteStr(^M^R'[A]dd a loozer, [D]elete a Loozer, [Q]uit:');
    If Input='' then Input:='L';
    Ch:=UpCase(Input[1]);
      If Ch='A' then AddLoozers;
      If Ch='D' then DeleteLoozer;
  Until (Ch='Q') or HungUpOn;
  saveloozers;
end;

procedure nodelists;
Var Node:NodeNetRec;
    FN:File of NodeNetRec;
    I,J,CNT:Integer;
    C:Char;

    Procedure ShowNode;
    Begin
      ClearScr;
      WriteLn(^R'Node #'^S,I);
      Tab(^R+'Node Password',30);
      WriteLn(':'^S,Node.Pass);
      Tab(^R+'Node Name',30);
      WriteLn(':'^S,Node.Name);
      Tab(^R+'Node Phone Number',30);
      WriteLn(':'^S,Node.Phone);
      Tab(^R+'Node Baud Rate',30);
      WriteLn(':'^S,Node.Baud);
      Tab(^R+'Node ID Number',30);
      WriteLn(':'^S,Node.Node);
      WriteStr(^M^P'Press '^R'[Return]'^P' to see networked Bases:');
      ClearScr;
      Cnt:=1;
      Repeat
          If Node.BaseSelection[Cnt] then WriteLn('Base ID #',Cnt,' is networked!');
          Inc(Cnt);
      Until (Cnt=256) or HungUpOn;
      WriteStr(^M^P'Press '^R'[Return]:');
    End;

    Procedure DisplayNodeInformation;
    Begin
         If FileSize(Fn)=0 then Exit;
         Seek(Fn,0);
         I:=0;
         While Not Eof(Fn) do
           Begin
             Inc(I);
             Read(Fn,Node);
             ShowNode;
           End;
         WriteStr(^M^P'Press '^R'[Return]:');
    End;

    Procedure InitializeThisStuff;
    Begin
         Assign(Fn,ConfigSet.ForumDi+'NodeList.BBS');
         If Exist(ConfigSet.ForumDi+'NodeList.BBS') then Reset(FN)
            Else
         ReWrite(Fn);
    End;

    Procedure AddNode;
    Begin
         ClearScr;
         WriteHdr('Add a node');
         FillChar(Node,SizeOf(Node),0);
         WriteStr('Enter the Node Password:');
         If input='' then Exit;
         Node.Pass:=Input;
         WriteStr('Enter the Node Name:');
         If Input='' then Exit;
         Node.Name:=Input;
         WriteLn(^M^S^G'Do NOT include any "-"''s or "("''s for the phone number!'^G^M);
         WriteStr('Enter the Node Phone Number:');
         If Input='' then Exit;
         Node.Phone:=Input;
         WriteStr('Enter the Node''s Baud Rate (ex: 38400) :');
         If Input='' then Exit;
         If Input='1200' then Node.baud:=1200;
         If input='2400' then Node.baud:=2400;
         If Input='4800' then Node.baud:=4800;
         if Input='9600' then Node.Baud:=9600;
         If Input='19200' then Node.Baud:=19200;
         If Input='38400' then Node.baud:=38400;
         WriteLn(^M^S'The node ID address is your NETWORK id. It will be something like');
         WriteLn(^S'1:100, or something along those lines. (NOTE: Hub ID is same as each Node)'^M);
         WriteStr('Enter Node ID Address:');
         If Input='' then Exit;
         Node.Node:=Input;
         ClearScr;
         WriteLn(^S'Now we are going to pick the Base ID''s to be networked. Each message base');
         WriteLn(^S'That is networked will have a UNIQUE Base ID. This ID tells ViSiON Which Bases');
         WriteLn(^S'to network. Enter each base ID, when you are done, enter a "0".'^M);
         Repeat
               WriteStr('Base ID:');
               I:=Valu(Input);
               If (I>0) and (I<256) then Node.BaseSelection[I]:=True
                  Else
               If I<>0 then WriteLn(^M^S^G'Invalid Range! Valid Ranges are from 1-255!'^M);
         Until (I=0) or HungUpOn;
         Write(^M'Adding Node to List...');
         Seek(Fn,FileSize(Fn));
         Write(Fn,Node);
         WriteLn('Completed!');
         WriteStr(^M^R'Press '^R'[Return]:');
    End;

    Procedure DeleteNode;
    Begin
         ClearScr;
         WriteStr('Which Node to Delete [1-'+strr(FileSize(Fn))+']:');
         I:=Valu(Input);
         If (I<1) or (I>FileSize(Fn)) then Exit;
         Write(^M'Deleting Node...');
         Dec(i);
         Cnt:=I;
         While Cnt<FileSize(Fn)-1 Do
         Begin
              Seek(Fn,Cnt+1);
              Read(Fn,Node);
              Seek(Fn,Cnt);
              Write(Fn,Node);
              Inc(Cnt);
         End;
         Seek(Fn,FileSize(Fn)-1);
         Truncate(Fn);
         Close(Fn);
         Assign(Fn,ConfigSet.ForumDi+'NodeList.BBS');
         Reset(Fn);
         WriteLn('Deleted!');
         WriteStr(^M^R'Press '^P'[Return]:');
    End;

    Procedure EditNode;
    Var NodeNum:Integer;

    Procedure GetPhoneNum;
    Begin
         ClearScr;
         WriteStr('Enter the New Phone Number:');
         If Input<>'' then Node.Phone:=Input;
    End;

    Procedure GetBaud;
    Begin
         ClearScr;
         WriteStr('Enter the NEW baud rate for this board:');
         If Input='1200' then Node.Baud:=1200
            Else
         if Input='2400' then Node.baud:=2400
            Else
         If Input='4800' then Node.Baud:=4800
            Else
         If Input='9600' then Node.Baud:=9600
            Else
         If Input='19200' then Node.baud:=19200
            Else
         If Input='38400' then Node.Baud:=38400;
    End;

    Procedure GetName;
    Begin
         ClearScr;
         WriteStr('Enter the New Node Name:');
         If Input<>'' then Node.Name:=Input;
    End;

    Procedure NodePassword;
    Begin
         ClearScr;
         WriteStr('Enter the New Node Password:');
         If Input<>'' then Node.Pass:=Input;
    End;

    Procedure NodeIdNumber;
    Begin
         ClearScr;
         WriteStr('Enter the NEW Node ID Number:');
         If Input<>'' then Node.Node:=Input;
    End;

    Procedure NetBases;
    Begin
         ClearScr;
         WriteLn(^S'To change the status of a networked base, enter the BASE ID that you wish');
         WriteLn(^S'to change. I.e. if Base 1 was networked, and you wish to not carry it anymore');
         WriteLn(^S'then you would enter a "1". Enter a "0" when you are done.'^M);
         Repeat
               WriteStr('Base ID to Change:');
               I:=Valu(Input);
               If (I>0) and (I<256) then
                  Begin
                       Node.BaseSelection[I]:=Not Node.BaseSelection[I];
                       If Node.BaseSelection[I] then Writeln('Base ID:',I,' WILL be networked.')
                       Else
                       WriteLn('Base ID:',i,' will NOT be networked.');
                  End;
         Until (I=0) or HungUpOn;
    End;

    Begin
         ClearScr;
         WriteStr('Enter the Node to Edit [1-'+strr(FileSize(Fn))+']:');
         I:=Valu(Input);
         If (I<1) or (I>FileSize(Fn)) then Else
          Begin
               Seek(Fn,I-1);
               Read(Fn,Node);
               NodeNum:=I-1;
                 Repeat
                   ClearScr;
                   WriteHdr('Node Editing');
                   WriteLn(^P'P) Phone Number'^M^P'B) Baud Rate'^M^P'N) Node Name');
                   WriteLn(^P'V) View Node'^M^P'W) Node Password'^M^P'I) Node ID Number');
                   WriteLn(^P'S) Net bases'^M^P'Q) Quit Editing'^M);
                   WriteStr('Choice:');
                   If Input='' then Input:='Q';
                   C:=UpCase(Input[1]);
                   Case C Of
                     'P':GetPhoneNum;
                     'B':GetBaud;
                     'N':GetName;
                     'V':ShowNode;
                     'W':NodePassword;
                     'I':NodeIDNumber;
                     'S':NetBases;
                   End;
                 Until (C='Q') or HungUpOn;
               Seek(Fn,NodeNum);
               Write(Fn,Node);
          End;
          C:='U';
         End;

Begin
     InitializeThisStuff;
     Repeat
           ClearScr;
           WriteHdr('Node List Maintenance');
           WriteLn(^P'S) Show All Nodes');
           WriteLn(^P'E) Edit a node');
           WriteLn(^P'D) Delete a Node');
           WriteLn(^P'A) Add a node');
           WriteLn(^P'Q) Quit Node Editor'^M);
           WriteStr('Choice:');
           If Input='' then Input:='Q';
           C:=UpCase(Input[1]);
           Case C of
             'S':DisplayNodeInformation;
             'E':EditNode;
             'D':DeleteNode;
             'A':AddNode;
           End;
     Until (C='Q') or HungUpOn;
     Close(Fn);
End;


procedure makeuser;
var u:userrec;
    un,ln,txx:integer;
begin
  writehdr ('Add a user');
  writestr ('Name:');
  if length(input)=0 then exit;
  if lookupuser(input)<>0 then begin
    writestr ('Sorry!  Already exists!');
    exit
  end;
  u.handle:=input;
  u.realname:='';
  writestr ('Password:');
  u.password:=input;
  writestr ('Level:');
  if length(input)=0 then exit;
  u.level:=valu(input);
  for txx:=1 to 32 do u.confset[txx]:=0;
  u.phonenum:='8005551212';
  u.usernote:='New User';
  un:=adduser(u);
  if un=-1 then begin
    writestr ('Sorry, no room for new users!');
    exit
  end;
  ln:=u.level;
  if ln<1 then ln:=1;
  if ln>100 then ln:=100;
  u.timetoday:=configset.usertim[ln];
  writeufile (u,un);
  writestr ('User added as #'+strr(un)+'.');
  writelog (2,8,u.handle)
end;

procedure infoformhunt;
var tp:mstr;
    info:integer;
begin
  writestr ('User to search for [CR=all users]:');
  writeln (^M);
  tp:=input;
  writestr('Infoform # view [1-5]: [1]:*');
  if input='' then input:='1';
  info:=valu(input);
  if (info>0) and (info<6) then
  showinfoforms (tp,info)
end;

procedure donations;
var fn:lstr;
begin
  fn:=configset.textfiledi+'Donation';
  if exist (fn)
    then printfile (fn)
    else begin
      writestr ('I''m sorry, no information is currently available.');
      if issysop
        then writestr (
'Sysop:  To create donation information text, make a file called '+fn)
    end
end;

procedure viewsyslog;
var n:integer;
    l:logrec;

  function lookupsyslogdat (m,s:integer):integer;
  var cnt:integer;
  begin
    for cnt:=1 to numsyslogdat do with syslogdat[cnt] do
      if (menu=m) and (subcommand=s) then begin
        lookupsyslogdat:=cnt;
        exit
      end;
    lookupsyslogdat:=0
  end;

  function firstentry:boolean;
  begin
    firstentry:=(l.menu=0) and (l.subcommand in [1..2])
  end;

  procedure backup;
  begin
    while n<>0 do begin
      n:=n-1;
      seek (logfile,n);
      read (logfile,l);
      if firstentry then exit
    end;
    n:=-1
  end;

  procedure showentry (includedate:boolean);
  var q:String;
      p:integer;
  begin
    q:=^S+'[ '+^R+syslogdat[lookupsyslogdat(l.menu,l.subcommand)].text;
    p:=pos('%',q);
    if p<>0 then q:=copy(q,1,p-1)+l.param+copy(q,p+1,255);
    repeat
      q:=q+'.';
    until length(q)>48;
    q:=q+^S+' ]   '+^P+'[ '+^A;
    if includedate then q:=q+datestr(l.when)+' at '+TimeStr(L.When)+^P' ]'
    Else
    q:=q+timestr(l.when)+^P+' ]';
    writeln (q)
  end;

var b:boolean;
begin
  writehdr ('View system log');
  writeln ('Press space to advance to the previous caller, X to abort.');
  writeln;
  writelog (2,6,'');
  n:=filesize(logfile);
  repeat
    clearbreak;
    writeln (^M);
    backup;
    if n=-1 then exit;
    seek (logfile,n);
    read (logfile,l);
    showentry (true);
    b:=false;
    while not (eof(logfile) or break or xpressed or b) do begin
      read (logfile,l);
      b:=firstentry;
      if not b then showentry (false);
    end
  until xpressed
end;

procedure delsyslog;
begin
  writestr ('Delete system log: Confirm:');
  if not yes then exit;
  if (not local) then begin
    writeln(^M'You may only delete the System log locally!'^M);
    exit;
  end;
  close (logfile);
  rewrite (logfile);
  writeln (^M'System log deleted.');
  writelog (2,7,unam)
end;

procedure showallforms;
var info:integer;
begin
  writestr('Which infoform to view [1-5]: [1]:*');
  if input='' then input:='1';
  info:=valu(input);
  if (info>0) and (info<6) then
  showinfoforms ('',info)
end;

procedure mainhelp;
begin
  help ('Mainmenu.hlp')
end;

procedure otherbbs;
var blfile:file of bbsrec;
    card,ugbot,p:lstr;
    b:bbsrec;

   function numbbses:integer;
   begin
     numbbses:=filesize(blfile)
   end;

   procedure seekblfile (n:integer);
   begin
     seek (blfile,n-1);
   end;

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

   procedure getstring (t:lstr; var m; buf:integer);
   var q:lstr absolute m;
       mm:lstr;
   begin
     writeln (^R'Old '^V,t,^R': '^S,q,^R);
     buflen:=buf;
     writestr ('Enter new '+^V+t+^P+' [CR/no change]:');
     mm:=input;
     if length(mm)<>0 then q:=mm;
     writeln
   end;

    procedure listbbs;
    var cnt,b1,b2:integer;
        showedz:boolean;
    begin
     writehdr ('BBS List');
     reset (blfile);
     if ioresult<>0 then begin
      writeln ('There are no bbs! you may add your own!');
      exit;
     end
     else begin
     parserange (numbbs,b1,b2);
    {writestr ('Display complete Description [y/n]? *');
     writeln;
     howedz:=true;
     if upcase(input[1])='N' then showedz:=false;}
     cls;
     writehdr ('ViSiON BBS Listing');
      colorfb(3,0);
      writeln (^R'ÕÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸');
      writeln (^R'³'^A'Software '^R'³'^A' Phone Number '^R'³'^A' Max BPS '^R'³               '^A+
'Board Name               '^R'³');
      writeln (^R'ÆÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵');
      if b1>0 then
      for cnt := b1 to b2 do
      begin
      if xpressed then exit;
      seekblfile(cnt);
      read(blfile,b);
        tab (^R'³ '^S+b.ware,12);
        tab (^R'³ '^U+b.phone,17);
        tab (^R'³ '^P+b.baud,12);
        tab (^R'³ '^U+b.name,43);
        writeln (^R'³');

        If break Then begin
      writeln (^R'ÔÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;');

        	exit
        end;
      End;
      writeln (^R'ÔÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;');

    End;


      end;

     Procedure SD;
     Begin
      ANSiColor(8);
      WriteLn('Û');
     End;

    procedure addbbs;
    begin
     ClearScr;
     WriteLn(^R'ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ'^P'['^U'Add a BBS Entry'^P']'^R'ÍÍ͸');
     Write(^R'³  '^S'BBS Name                                          '^R'³');SD;
     write(^R'³  '^P':                                                 '^R'³');SD;
     Write(^R'³  '^S'BBS Number                                        '^R'³');sd;
     Write(^R'³  '^P':                                                 '^R'³');sd;
     write(^R'³  '^S'Highest Baud Rate                                 '^R'³');sd;
     Write(^R'³  '^P':                                                 '^R'³');sd;
     Write(^R'³  '^S'Software ('^U'ViSiON'^S')!                                '^R'³');sd;
     Write(^R'³  '^P':                                                 '^R'³');sd;
     Write(^R'ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;');sd;
     WriteLn('  ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß');
     GoXy(6,3);
     buflen:=40;
     writestr ('*');
     b.name:=input;
     GoXy(6,5);
     buflen:=12;
     writestr ('*');
     b.phone:=input;
     GoXy(6,7);
     buflen:=5;
     writestr ('*');
     b.baud:=input;
     GoXy(6,9);
     buflen:=8;
     writestr ('*');
     b.ware:=input;
     writeln;
     b.leftby:=unam;
     if (length(b.phone)>0) and (length(b.name)>0) and (length(b.baud)>0)
     and (length(b.ware)>0) then begin
      if not exist ('BBSLIST.DAT') then rewrite (blfile) ;
      seekblfile (numbbses+1);
      write (blfile,b);
      writeln (^M^S'Entry Added!'^R^M);
     end else
     writeln (^M^S'Bad Entry!'^R^M);
     end;

  procedure changebbs;
  var q,spock:integer;
      doodzdomain:char;

   procedure showbbs (b:bbsrec);
   begin
   writeln (^M^R'[1]... Name:     '^S,b.name,
            ^M^R'[2]... Number:   '^S,b.phone,
            ^M^R'[3]... Max Baud: '^S,b.baud,
            ^M^R'[4]... Software: '^S,b.ware,
            ^M^R'[Q]... Quit');
   end;

   begin
       writehdr ('Change an Entry');
       writestr (^M^R'Entry to Change ['^S'?'^R']: &');
       if input[1]='?' then listbbs;
       spock:=valu(input);
       if spock<1 then exit;
       if spock>numbbs then exit;
       seekblfile (spock);
       read (blfile,b);
       if not (match (b.leftby,unam)) then begin
        writeln (^M'You didn''t make the entry!'^M);
        exit;
       end;
       repeat
       showbbs (b);
       writestr ('Edit Command: *');
       doodzdomain:=upcase(input[1]);
       case doodzdomain of
        '1':getstring ('Name',b.name,48);
        '2':getstring ('Number',b.phone,12);
        '3':getstring ('Max Baud',b.baud,4);
        '4':getstring ('Software',b.ware,4);
        'Q':;
       end;
       until doodzdomain='Q';
       seek (blfile,spock-1);
       write (blfile,b);
       close (blfile);
      end;

    Procedure Deletebbs;
      Var bud,cnt,n:Integer;
        f:File;
        KKOOL:bbsrec;
      Begin
      Writehdr ('Delete a BBS');
       Writestr ('BBS record # to delete? :');
       if input='' then exit;
       bud:=valu(input);
       if bud>numbbs then exit;
       n:=bud;
        If n=0 Then exit;
     seek (blfile,n-1);
     read (blfile,kkool);

        writestr('Delete '+^S+kkool.name+^P+'? *');
        if ((match (unam,kkool.leftby))=false) and (issysop=false) then exit;

        If Not yes Then exit;
        For cnt:=n+1 To numbbs Do Begin
          seekblfile(cnt);
          Read(blfile,kkool);
          seekblfile(cnt-1);
          Write(blfile,kkool)
        End;
        seekblfile(numbbs);
        Truncate(blfile);
        writestr(^M'Deleted.');
      End;


  procedure bbslistsysop;
  begin
     writeln;
     repeat
      ugbot:=' ';
      writeln  (^R'('^S'D'^R')elete an Entry');
      writeln  (^R'('^S'C'^R')hange an Entry');
      writeln  (^R'('^S'Q'^R')uit'^M);
      writestr ('[BBS List Sysop Command]:');
      ugbot:=upstring(input);
      case ugbot[1] of
       'D':deletebbs;
       'C':changebbs;
       'S':begin
           end;
       'T':begin
           end;
       'Q':;
      end;
     until (ugbot[1]='Q');
    end;

label exit;
var q:integer;
begin
    assign (blfile,'BBSLIST.DAT');
    WriteHdr('BBS Listings...');
    repeat
     q:=menu ('BBS List','BBSLIST','LADC%QI');
     writeln;
     case q of
      1:listbbs;
      2:addbbs;
      3:deletebbs;
      4:changebbs;
      5:bbslistsysop;
      6:goto exit;
     end;
     until (hungupon) or (q=6);
    exit:
    close (blfile);
end;

procedure readerrlog;
begin
  if exist (configset.forumdi+'Errlog')
    then printfile (configset.forumdi+'Errlog.')
    else writestr ('No error file!')
end;

procedure showad;
var fn:lstr;
begin
  fn:=configset.textfiledi+'VISION.AD';
  if exist (fn) then printfile (fn)
end;

procedure setlastcall;

  function digit (k:char):boolean;
  begin
    digit:=ord(k) in [48..57]
  end;

  function validtime (inp:sstr):boolean;
  var c,s,l:integer;
      d1,d2,d3,d4:char;
      ap,m:char;
  begin
    validtime:=false;
    l:=length(inp);
    if (l<7) or (l>8) then exit;
    c:=pos(':',inp);
    if c<>l-5 then exit;
    s:=pos(' ',inp);
    if s<>l-2 then exit;
    d2:=inp[c-1];
    if l=7
      then d1:='0'
      else d1:=inp[1];
    d3:=inp[c+1];
    d4:=inp[c+2];
    ap:=upcase(inp[s+1]);
    m:=upcase(inp[s+2]);
    if d1='1' then if d2>'2' then d2:='!';
    if (d1>='0') and (d1<='1') and digit(d2) and (d3>='0') and (d3<='5')
       and digit(d4) and ((ap='A') or (ap='P')) and (m='M')
         then validtime:=true
  end;

  function validdate (inp:sstr):boolean;
  var k,l:char;

    function gchar:char;
    begin
      if length(inp)=0 then begin
        gchar:='?';
        exit
      end;
      gchar:=inp[1];
      delete (inp,1,1)
    end;

  begin
    validdate:=false;
    k:=gchar;
    l:=gchar;
    if not digit(k) then exit;
    if l='/'
      then if k='0'
        then exit
        else
      else begin
        if k>'1' then exit;
        if not digit(l) then exit;
        if (l>'2') and (k='1') then exit;
        l:=gchar;
        if l<>'/' then exit
      end;
    k:=gchar;
    l:=gchar;
    if l='/'
      then if k='0'
        then exit
        else
      else begin
        if k>'3' then exit;
        if not digit(l) then exit;
        if (k='3') and (l>'1') then exit;
        l:=gchar;
        if l<>'/' then exit
      end;
    if digit(gchar) and digit(gchar) then validdate:=true
  end;

begin
  writeln (^M'Your last call was: '^S,datestr(laston),' at ',timestr(laston));
  writestr (^M'Enter new date (mm/dd/yy):');
  if length(input)>0
    then if validdate (input)
      then laston:=dateval(input)+timepart(laston)
      else writestr ('Invalid date!');
  writestr (^M'Enter new time (hh:mm am/pm):');
  if length(input)>0
    then if validtime(input)
      then laston:=timeval(input)+datepart(laston)
      else writestr ('Invalid time!')
end;

procedure removeallforms;
var cnt,ndel:integer;
    u:userrec;
begin
  writestr ('Erase ALL info-forms:  Are you sure? *');
  if not yes then exit;
  writeurec;
  writestr (^M'Erasing... please stand by...');
  ndel:=0;
  for cnt:=1 to numusers do begin
    if (cnt mod 10)=0 then write (cnt,', ');
    seek (ufile,cnt);
    read (ufile,u);
    if u.infoform>=0 then
      deletetext (u.infoform);
      u.infoform:=-1;
      if u.infoform2>=0 then deletetext(u.infoform2);
      u.infoform2:=-1;
      if u.infoform3>0 then deletetext(u.infoform3);
      u.infoform3:=-1;
      if u.infoform4>0 then deletetext(u.infoform4);
      u.infoform4:=-1;
      if u.infoform5>0 then deletetext(u.infoform5);
      u.infoform5:=-1;
      seek (ufile,cnt);
      write (ufile,u);
  end;
  writeln ('done.');
  writestr (^M'All '+strr(numusers)+' forms erased.');
  readurec
end;

procedure showscreens;
var i:integer;
begin
repeat
      clearscr;
      writehdr('The Ansi Gallery');
      writeln(^M^P'[A] - '^A'Show ASCII Welcome Screen');
      writeln(^P'[1-',configset.numwelcome,'] - '^A'Show Ansi Welcome Screen #xx');
      writeln(^P'[Q] - '^A'Exit this section');
      writestr(^M^R'Selection:');
      if input='' then input:='Q';
      if match(input,'A') then printfile(configset.textfiledi+'Welcome.Asc') else
        if not match(input,'Q') then begin i:=valu(input);
        if (i>0) and (i<=configset.numwelcome) then printfile(configset.textfiledi+'Welcome.'+strr(i))
        else writeln(^M^S'Invalid Screen!');
        end;
        if not match(input,'Q') then begin
           buflen:=0;
           writestr(^M^R'Press [Return]*');
        end;
      until match(input,'Q') or hungupon;
end;

 Procedure showlastcallers;
    Var qf:File Of lastrec;
      cnt:Integer;
      l:lastrec;
    Begin
      If ConfigSet.LastLeve>Ulvl then Exit;
      Assign(qf,'Callers');
      Reset(qf);
      If IOResult=0 Then Begin
        ClearScr;
        writehdr('Recent Caller List');
	writehdr('       User''s Name                    Date        Time        Speed     ');
        For cnt:=0 To FileSize(qf)-1 Do begin
          Read(qf,l);
          Write('  ');
          ANSiCOLOR(11);
          Tabul(l.name,39);
          ansicolor(3);
          Tabul(datestr(l.when),12);
          ansicolor(3);
          Tabul(timestr(l.when),12);
          ansicolor(9);
          Tabul(strr(l.lastbps)+' Bps',12);
          WriteLn;
          if Break then Begin
             Close(qf);
             Exit;
             End;
	      End;
	      Close(qf)
	    End;
		End;

Procedure JumpConference;
Var I:Integer;
Begin
   If configset.numconfs<2 then Begin
    exit;
    end;
   Urec.Conf[1]:=True;
   WriteHdr('Conference Selections');
   WriteLn(^P'['^R'1'^P'] '^S+ConfigSet.Conf1);
   If (ConfigSet.NumConfs>1) and Urec.Conf[2] then
   WriteLn(^P'['^R'2'^P'] '^S+ConfigSet.Conf2);
   If (ConfigSet.NumConfs>2) and Urec.Conf[3] then
   WriteLn(^P'['^R'3'^P'] '^S+ConfigSet.Conf3);
   If (ConfigSet.NumConfs>3) and Urec.Conf[4] then
   WriteLn(^P'['^R'4'^P'] '^S+ConfigSet.Conf4);
   If (ConfigSet.NumConfs>4) and Urec.Conf[5] then
   WriteLn(^P'['^R'5'^P'] '^S+ConfigSet.Conf5);
   WriteStr(^M^R'Conference '^P'['^A'1'^P']'^R':');
   If Input='' then Input:='1';
   I:=Valu(Input);
   If (I<1) or (I>ConfigSet.NumConfs) or not Urec.Conf[I] then
     WriteLn(^M^G'Invalid Choice!')
     Else
   Begin
     CurrentConference:=I;
     Case I of
       1:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf1+' #'+strr(currentconference)+^P']'^R' Joined...');
       2:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf2+' #'+strr(currentconference)+^P']'^R' Joined...');
       3:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf3+' #'+strr(currentconference)+^P']'^R' Joined...');
       4:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf4+' #'+strr(currentconference)+^P']'^R' Joined...');
       5:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf5+' #'+strr(currentconference)+^P']'^R' Joined...');
     End;
   End;
   Urec.LastConf:=CurrentConference;
End;

procedure TopTen(eatshit:byte);

      type HighestPCR=record
             Name:mstr;
             PCR:longint;
             end;

      Type Tp=Array[1..10] of HighestPCR;
  Var done:boolean;
      TMPrec:userrec;
      Uploaders,LameUploaders,Downloaders,LameDownloaders,Posters,GoodUls,
      BadUls,GoodDls,BadDls,LamePosters,GoodPosts,BadPosts,GoodCalls,
      BadCalls:Tp;
      TmpPost:highestpcr;
      X1:Integer;

 Procedure InitIt(where:byte);
 Var A,B,C,D,E,Cnt,UpToDown:LongInt;

     Procedure SortIt(Var ArofIt:Tp; Tempo:LongInt; UpOrDown:Boolean);
     Var Cnt,I,quick:Integer;
     Begin
     If where=0 then quick:=10 Else Quick:=5;
       Done:=False;
       For Cnt:=1 to quick Do
       Begin
         If UpOrDown then
           Begin
           If not Done and (Tempo>ArofIt[Cnt].Pcr) then
           Begin
             If Cnt<quick then
               For I:=quick-1 downto Cnt do ArofIt[I+1]:=ArofIt[I];
             ArofIt[Cnt].Name:=TmpRec.Handle;
             ArofIt[Cnt].PCR:=Tempo;
             Done:=True;
           End;
           End
         Else
           If Not Done and (Tempo<ArofIt[Cnt].PCR) then
           Begin
            If Cnt>1 then
              For I:=quick-1 downto cnt do ArofIt[I+1]:=ArofIt[I];
              ArofIt[Cnt].Name:=TmpRec.Handle;
              ArofIt[Cnt].PCR:=Tempo;
              Done:=True;
            End;
       End;
     End;

     begin
     ClearScr;
     If eatshit=0 then Writehdr ('Calculating Statistics');
     If eatshit=1 then writehdr ('Highest/Lowest Posts');
     If eatshit=2 then writehdr ('Highest Uploads/Downloads');
       for cnt:=1 to 10 do begin
        Posters[cnt].pcr:=0;
        posters[cnt].name:='';
        lamePosters[cnt].pcr:=maxint;
        lameposters[cnt].name:='';
        GoodPosts[Cnt].Name:='';
        GoodPosts[Cnt].PCR:=0;
        BadPosts[Cnt].Name:='';
        BadPosts[Cnt].Pcr:=MaxInt;
        GoodCalls[Cnt].Name:='';
        GoodCalls[Cnt].Pcr:=0;
        BadCalls[Cnt].Name:='';
        BadCalls[Cnt].Pcr:=MaxInt;
        Downloaders[cnt].pcr:=0;
        downloaders[cnt].name:='';
        lamedownloaders[cnt].pcr:=maxint;
        lamedownloaders[cnt].name:='';
               uploaders[cnt].pcr:=0;
        uploaders[cnt].name:='';
        lameuploaders[cnt].pcr:=maxint;
        lameuploaders[cnt].name:='';
        GoodUls[Cnt].Name:='';
        GoodUls[Cnt].PCR:=0;
        BadUls[Cnt].Name:='';
        BadUls[Cnt].PCR:=MaxInt;
        GoodDls[Cnt].Name:='';
        GoodDls[Cnt].PCR:=0;
        BadDls[Cnt].Name:='';
        BadDls[Cnt].PCR:=MaxInt;
       end;
     for cnt:=3 to numusers do begin
      seek(ufile,cnt-1);
      read(ufile,TmpRec);
      If where=0 then Begin
        if tmprec.numon>1 then
        begin
	  D:=Ratio(TmpRec.Nbu,TmpRec.NumOn);
	   Sortit(Posters,D,True);
	   SortIt(LamePosters,D,False);
	  d:=tmprec.UpKay;
	   SortIt(Uploaders,D,True);
	   SortIt(LameUploaders,D,False);
	  d:=tmprec.DnKay;
	   SortIt(Downloaders,D,True);
	   SortIt(LameDownloaders,D,False);
	  D:=TmpRec.Uploads;
	   SortIt(GoodUls,D,True);
	   SortIt(BadUls,D,False);
	  D:=TmpRec.Downloads;
	   SortIt(GoodDls,D,True);
	   SortIt(BadDls,D,False);
	   SortIt(GoodPosts,TmpRec.Nbu,True);
	   SortIt(BadPosts,TmpRec.Nbu,False);
	   End;
	   SortIt(GoodCalls,TmpRec.NumOn,True);
	   SortIt(BadCalls,TmpRec.NumOn,False);
		 End Else
                 If Where=1 then Begin
                 if tmprec.numon>1 then Begin
                   D:=Ratio(TmpRec.Nbu,TmpRec.NumOn);
                    SortIt(GoodPosts,TmpRec.Nbu,True);
		    SortIt(BadPosts,TmpRec.Nbu,False);
                   End;
                 End Else
                 If Where=2 then Begin
                 if tmprec.numon>1 then Begin
                 d:=tmprec.UpKay;
	          SortIt(Uploaders,D,True);
	         d:=tmprec.DnKay;
	          SortIt(Downloaders,D,True);
                   End;
                  End;
		 End;
           End;

     Procedure ShowSomething(TempOr:Tp; ToSay:Mstr; SayK:Byte);
     Var Cnt:Integer;
     Begin
       ClearScr;
       WriteHdr(ToSay);
       For Cnt:=1 to 10 Do
         Begin
           Tab(Strr(Cnt)+'.',4);
           Tab(TempOr[Cnt].Name,37);
           Write(TempOr[Cnt].PCR);
           if SayK=1 then Write('%');
           If SayK=2 then Write('K');
           WriteLn;
         End;
       WriteStr(^M^R'Press [Return]:');
     End;

     Procedure ViZWaY(TempOr:Tp; Tosay:Mstr; SayK:Byte; Whatit:Mstr); (* The Only Way *)
     Var number:Integer;
     Begin
       WriteLn(^S+ToSay+^M);
       For Number:=1 To 5 Do Begin
       Tabul(^P+Strr(number)+^S'. ',4);
       Tabul(^F+TempOr[number].Name,37);
       Write(^A);
       Write(TempOr[number].PCR);
         If sayK=1 then Write('%');
         If sayk=2 then Write('K');
       WriteLn(' '+whatit);
       End;
       WriteLn;
     End;

     Begin
     If eatshit=0 then Begin
     InitIt(0);
     Repeat
       ClearScr;
       WriteHdr('Top 10 Listing');
       WriteLn(^R'[1] '^P'Best Uploaders');
       WriteLn(^R'[2] '^P'Worst Uploaders');
       WriteLn(^R'[3] '^P'Best Downloaders');
       WriteLn(^R'[4] '^P'Worst Downloaders');
       WriteLn(^R'[5] '^P'Best Post/Call Ratios');
       WriteLn(^R'[6] '^P'Worst Post/Call Ratios');
       WriteLn(^R'[7] '^P'Best Uploaders in K-Bytes');
       WriteLn(^R'[8] '^P'Worst Uploaders in K-Bytes');
       WriteLn(^R'[9] '^P'Best Downloaders in K-Bytes');
       WriteLn(^R'[10] '^P'Worst Downloaders in K-Bytes');
       WriteLn(^R'[11] '^P'Best Message Posters');
       WriteLn(^R'[12] '^P'Worst Message Posters');
       WriteLn(^R'[13] '^P'Best Callers');
       WriteLn(^R'[14] '^P'Worst Callers');
       WriteLn(^R'[15] '^P'Show all Statistics');
       WriteStr(^M^P'Selection:');
       If Input='' then Input:='0';
       X1:=Valu(Input);
       Case X1 of
         1:ShowSomething(GoodUls,'Top 10 Uploaders',0);
         2:ShowSomething(BadUls,'Lowest 10 Uploaders',0);
         3:ShowSomething(GoodDls,'Top 10 Downloaders',0);
         4:ShowSomething(BadDls,'Lowest 10 Downloaders',0);
         5:ShowSomething(Posters,'Top 10 Post/Call Ratios',1);
         6:ShowSomething(LamePosters,'Lowest 10 Post/Call Ratios',1);
         7:ShowSomething(Uploaders,'Top 10 Uploaders in K-Bytes',2);
         8:ShowSomething(LameUploaders,'Lowest 10 Uploaders in K-Bytes',2);
         9:ShowSomething(Downloaders,'Top 10 Downloaders in K-Bytes',2);
         10:ShowSomething(LameDownloaders,'Lowest 10 Downloaders in K-Bytes',2);
         11:ShowSomething(GoodPosts,'Top 10 Message Posters',0);
         12:ShowSomething(BadPosts,'Lowest 10 Message Posters',0);
         13:ShowSomething(GoodCalls,'Top 10 Callers',0);
         14:ShowSomething(BadCalls,'Lowest 10 Callers',0);
         15:Begin
            ShowSomething(GoodUls,'Top 10 Uploaders',0);
            ShowSomething(BadUls,'Lowest 10 Uploaders',0);
            ShowSomething(GoodDls,'Top 10 Downloaders',0);
            ShowSomething(BadDls,'Lowest 10 Downloaders',0);
            ShowSomething(Posters,'Top 10 Post/Call Ratios',1);
            ShowSomething(LamePosters,'Lowest 10 Post/Call Ratios',1);
            ShowSomething(Uploaders,'Top 10 Uploaders in K-Bytes',2);
            ShowSomething(LameUploaders,'Lowest 10 Uploaders in K-Bytes',2);
            ShowSomething(Downloaders,'Top 10 Downloaders in K-Bytes',2);
            ShowSomething(LameDownloaders,'Lowest 10 Downloaders in K-Bytes',2);
            ShowSomething(GoodPosts,'Top 10 Message Posters',0);
            ShowSomething(BadPosts,'Lowest 10 Message Posters',0);
            ShowSomething(GoodCalls,'Top 10 Callers',0);
            ShowSomething(BadCalls,'Lowest 10 Callers',0);
         End;
       End;
     Until HungUpOn or (X1=0);
     End;
     If eatshit=1 then begin
     Initit(1);
      VizWay(GoodPosts,'Top 5 Message Posters',0,'Posts');
      Vizway(BadPosts,'Lowest 5 Message Posters',0,'Posts');
      WriteStr(^M^R'Press '^S'['^P'Enter'^S']:*');
     End;
     If eatshit=2 then Begin
     Initit(2);
      VizWay(Uploaders,'5 Best Uploaders',2,'Uploaded');
      Vizway(Downloaders,'5 Biggest Leeches',2,'Downloaded');
      WriteStr(^M^R'Press '^S'['^P'Enter'^S']:*');
     end;
   end;

Procedure DisplayNodeInfo;
Var T:Text;
    I:Integer;
    Done:Boolean;
    Ls:Lstr;
Begin
  if not configset.multinodebbs then exit;
  I:=0;
  ClearScr;
  WriteHdr('Who''s Online Right Now');
  Repeat
    Inc(I);
    Done:=Not Exist(ConfigSet.ForumDi+'NDST'+STRR(I));
    If Not Done then
      Begin
      Assign(T,ConfigSet.ForumDi+'NDST'+STrr(I));
      ReSet(T);
      ReadLn(T,Ls);
      TextClose(T);
      WriteLn(^S'[',I,'] '^R,Ls);
    End;
  Until Done;
End;

procedure get_infoform;
var empty:boolean;

  procedure listavailable;
  var cnt,num:integer;
      f:file;
  begin
    num:=0;
    for cnt:=1 to 5 do
     if (length(configset.inf[cnt]) > 0) and (not match(configset.inf[cnt],'UNUSED')) then begin
       If exist(configset.textfiledi+'INFOFORM.'+strr(cnt)) then Begin
         num:=num + 1;
         if num = 1 then writehdr ('Available Infoforms');
         tab (^R'['^U+strr(cnt)+^R'] '^P+configset.inf[cnt],34);
         case cnt of
          1:if (configset.iman[cnt]) and (urec.infoform  < 0) then
             write (^S'Required');
          2:if (configset.iman[cnt]) and (urec.infoform2 < 0) then
             write (^S'Required');
          3:if (configset.iman[cnt]) and (urec.infoform3 < 0) then
             write (^S'Required');
          4:if (configset.iman[cnt]) and (urec.infoform4 < 0) then
             write (^S'Required');
          5:if (configset.iman[cnt]) and (urec.infoform5 < 0) then
             write (^S'Required');
         end;
         writeln;
       end;
     end;
  end;

  function anyneeded:boolean;
  var cnt,locate,num:integer;
      f:file;
  begin
    empty:=false;
    anyneeded:=true;
    num:=0;
    close (f);
    for cnt:=1 to 5 do
       if (length(configset.inf[cnt]) > 0) then begin
       if exist(configset.textfiledi+'INFOFORM.'+strr(cnt)) then begin
         num:=9;
         if (configset.iman[cnt]) then begin
           case cnt of
            1:locate:=urec.infoform;
            2:locate:=urec.infoform2;
            3:locate:=urec.infoform3;
            4:locate:=urec.infoform4;
            5:locate:=urec.infoform5;
           end;
           if locate < 0 then exit;
         end;
       end;
     end;
    empty:=num < 1;
    anyneeded:=false;
  end;

var boo:boolean;
    s:string;
begin
  if configset.totform < 1 then exit;
  if ansigraphics in urec.config then
   write (#27'[J') else
  write (^L);
  boo:=anyneeded;
  repeat
   if empty then begin
     writeln ('Sorry, No Infoforms Available');
     exit;
   end;
   listavailable;
   if not boo then
    writestr (^M'Select Infoform to Fill Out [1..5][CR/Quit]:') else
   writestr (^M'Select Infoform to Fill Out [1..5]:');
   s:=input;
   if (valu(s) > 0) and (valu(s) < 6) then begin
     infoform (valu(s));
     boo:=anyneeded;
   end;
  until (valu(s)<1) and (boo = false);
end;

Procedure Usercheck;
Begin
if not (urec.use1) and not (urec.use2) and not (urec.use3) and not (urec.use4) and
    not (urec.use5) and not (urec.use6) and not (urec.use7) and not (urec.use8) then
    UserFileListing;
    topten(2);
End;

begin
end.