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

unit others;

interface

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


procedure showuserstats(u:userrec);
procedure edituser (eunum:integer);
procedure printnews;
function selectspecs (var us:userspecsrec):boolean; { True if user aborts }
procedure editoldspecs;
procedure readfeedback;
procedure showallsysops;
procedure editusers;
procedure zapspecifiedusers;
Procedure RemoteDosShell;

implementation



procedure delallmail (n:integer);
var cnt,delled:integer;
    m:mailrec;
    u:userrec;
begin
  cnt:=-1;
  delled:=0;
  repeat
    cnt:=searchmail(cnt,n);
    if cnt>0 then begin
      delmail(cnt);
      cnt:=cnt-1;
      delled:=delled+1
    end
  until cnt=0;
  if delled>0 then writeln (^B'Mail deleted: ',delled);
  writeurec;
  seek (ufile,n);
  read (ufile,u);
  deletetext (u.infoform);
  deletetext (u.infoform2);
  deletetext (u.infoform3);
  deletetext (u.infoform4);
  deletetext (u.infoform5);
  deletetext (u.emailannounce);
  u.infoform:=-1;
  u.infoform2:=-1;
  u.infoform3:=-1;
  u.infoform4:=-1;
  u.infoform5:=-1;
  u.emailannounce:=-1;
  writeufile (u,n);
  readurec
end;

procedure deleteuser (n:integer);
var u:userrec;
begin
  delallmail (n);
  fillchar (u,sizeof(u),0);
  u.infoform:=-1;
  u.infoform2:=-1;
  u.infoform3:=-1;
  u.infoform4:=-1;
  u.infoform5:=-1;
  u.emailannounce:=-1;
  writeufile (u,n)
end;


function postcallratio (var u:userrec):real;
begin
  if u.numon=0
    then postcallratio:=0
    else postcallratio:=u.nbu/u.numon
end;

function fitsspecs (var u:userrec; var us:userspecsrec):boolean;
var days:integer;
    pcr:real;
    thisyear,thismonth,thisday,t:word;
    lastcall:datetime;

  function inrange (n,min,max:integer):boolean;
  begin
    inrange:=(n>=min) and (n<=max)
  end;

begin
  unpacktime (u.laston,lastcall);
  getdate (thisyear,thismonth,thisday,t);
  days:=(thisyear-lastcall.year)*365+(thismonth-lastcall.month)*30+
        (thisday-lastcall.day);
  pcr:=postcallratio (u);
  fitsspecs:=inrange (u.level,us.minlevel,us.maxlevel) and
             inrange (days,us.minlaston,us.maxlaston) and
             (pcr>=us.minpcr) and (pcr<=us.maxpcr);
  if (datepart(u.expdate)<datepart(Now)) and us.expired and (datepart(u.expdate)<>0)
  then fitsspecs:=true;
end;


procedure showuserstats(u:userrec);
var knter:integer;
    tpstr:lstr;
begin
  clearscr;
  blowup(1,1,47,11);
  printxy(1,3,^R'[ '^S'ViSiON User Status'^R' ]');
  printxy(2,3,^R'User Handle.: '^S+u.handle);
  printxy(3,3,^R'Real Name...: '^S+u.realname);
  printxy(4,3,^R'User Note...: '^S+u.usernote);
  printxy(5,3,^R'Main Level..: '^S+strr(u.level));
  printxy(6,3,^R'Phone Number: '^S+u.phonenum);
  if issysop then printxy(7,3,^R'Password....: '^S+u.password) else
  printxy(7,3,^R'Password....: '^S+'[CLASSIFIED]');
  printxy(8,3,^R'Last time On: '^S+datestr(u.laston));
  printxy(9,3,^R'Total Calls.: '^S+strr(u.numon));
  printxy(10,3,^R'Total Posts.: '^S+strr(u.nbu));

  blowup(1,50,28,8);
  printxy(1,52,^R'[ '^S'Xfer Status'^R' ]');
  printxy(2,52,^R'Level....: '^S+strr(u.udlevel));
  printxy(3,52,^R'Points...: '^S+strr(u.udpoints));
  printxy(4,52,^R'Uploads..: '^S+strr(u.uploads));
  printxy(5,52,^R'Downloads: '^S+strr(u.downloads));
  printxy(6,52,^R'U/L K....: '^S+strr(u.upkay));
  printxy(7,52,^R'D/L K....: '^S+strr(u.dnkay));

  blowup(13,1,56,5);
  tpstr:='';
  for knter:=1 to 10 do begin
    if knter<>1 then tpstr:=tpstr+',';
    if (u.confset[knter]>0) then tpstr:=tpstr+strr(knter) else
    tpstr:=tpstr+'0'
  end;
  printxy(14,3,^R'Sub-Conferences.: '^S);
  printxy(14,21,tpstr);
  tpstr:='';
  for knter:=11 to 20 do begin
    if knter<>11 then tpstr:=tpstr+',';
    if (u.confset[knter]>0) then tpstr:=tpstr+strr(knter) else
     tpstr:=tpstr+'0';
  end;
  printxy(15,21,tpstr);
  tpstr:='';
  for knter:=21 to 30 do begin
    if knter<>21 then tpstr:=tpstr+',';
    if (u.confset[knter]>0) then tpstr:=tpstr+strr(knter) else
      tpstr:=tpstr+'0';
  end;
  printxy(16,21,tpstr);
  printxy(20,1,'');
end;

procedure edituser (eunum:integer);
var eurec:userrec;
    ca:integer;
    k:char;
const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
      sectionnames:array [udsysop..databasesysop] of string[20]=
        ('File transfer','Bulletin section','Voting booths',
         'E-mail section','Doors','Main menu','Databases');

  procedure truesysops;
  begin
    writeln ('Sorry, you may not do that without true sysop access!');
    writelog (18,17,'')
  end;

  function truesysop:boolean;
  begin
    truesysop:=ulvl>=configset.sysopleve
  end;

  procedure getmstr (t:mstr; var mm);
  var m:mstr absolute mm;
  begin
    writeln ('Old ',t,': '^S,m);
    writestr ('New '+t+'? *');
    if length(input)>0 then m:=input
  end;

  procedure getsstr (t:mstr; var s:sstr);
  var m:mstr;
  begin
    m:=s;
    getmstr (t,m);
    s:=m
  end;

  procedure getint (t:mstr; var i:integer);
  var m:mstr;
  begin
    m:=strr(i);
    getmstr (t,m);
    i:=valu(m)
  end;

  procedure euwanted;
  begin
    writestr ('Wanted status: '^S+yesno(wanted in eurec.config));
    writestr ('New wanted status:');
    if yes
      then eurec.config:=eurec.config+[wanted]
      else eurec.config:=eurec.config-[wanted];
    writelog (18,1,yesno(wanted in eurec.config))
  end;

  procedure eudel;
  var fnt:text; dummystr:mstr;
  begin
    writestr (^R'Delete user '^F+eurec.handle+^R'?  ['^A'N'^R']:');
    if yes then begin
      writestr(^M'Add user to the System Blacklist? *');
      if yes then begin
       if not exist(configset.textfiledi+'Blacklst') then begin
       assign(fnt,configset.textfiledi+'Blacklst');
       rewrite(fnt);
       textclose(fnt);
       end;
       assign(fnt,configset.textfiledi+'Blacklst');
       append(fnt);
       writeln(fnt,eurec.handle);
       textclose(fnt);
       end;
      deleteuser (eunum);
      seek (ufile,eunum);
      read (ufile,eurec);
      writelog (18,9,'')
    end
  end;

  Procedure EuMainConference;
  Var I,J:Integer;
  Begin
    For I:=1 to 5 Do
       If Eurec.Conf[I] then WriteLn('Allowed in Main Conference #',I)
       Else WriteLn('Not allowed in Main Conference #',i);
    WriteStr(^M'Which Conference to Change:');
    If Input='' then Else Begin
    I:=Valu(Input);
    If (I>0) and (I<6) then
      Eurec.Conf[I]:=Not Eurec.Conf[I];
    End;
  End;

  procedure euname;
  var m:mstr;
  begin
    m:=eurec.handle;
    getmstr ('name',m);
    if not match (m,eurec.handle) then
      if lookupuser (m)<>0 then begin
        writestr ('Already exists!  Are you sure? *');
        if not yes then exit
      end;
    eurec.handle:=m;
    writelog (18,6,m)
  end;

  Procedure eurealname;
  var m:mstr;
  begin
    m:=eurec.realname;
    getmstr ('Real Name',m);
      If m>'' then eurec.realname:=m;
  end;

  Procedure euSpecialNote;
  var m:mstr;
  begin
    m:=eurec.SpecialSysopNote;
    getmstr ('Special SysOp Note',m);
      If m>'' then eurec.specialsysopnote:=m;
  End;

  procedure eupassword;
  begin
    if not truesysop
      then truesysops
      else begin
        getsstr ('password',eurec.password);
        writelog (18,8,'')
      end
  end;

  procedure eulevel;
  var n:integer;
  begin
    n:=eurec.level;
    getint ('level',n);
    if (n>=configset.sysopleve) and (not truesysop)
      then truesysops
      else begin
        eurec.level:=n;
        writelog (18,15,strr(n))
      end
  end;

  procedure eutimelimit;
  var n:integer;
  begin
    n:=eurec.timelimits;
    getint('time limit',n);
    eurec.timelimits:=n;
  end;

  procedure eudratio;
  var n:integer;
  begin
    n:=eurec.udratio;
    getint('Upload/Download Ratio',n);
    eurec.udratio:=n;
  end;

  procedure eudkratio;
  var n:integer;
  begin
       n:=eurec.udkratio;
       getint('Upload/Download K Ratio',n);
       eurec.udkratio:=n;
  end;

  procedure epcratio;
  var n:integer;
  begin
       n:=eurec.pcratio;
       getint('Post/Call Ratio',n);
       eurec.pcratio:=n;
  end;

  procedure eglevel;
  var n:integer;
  begin
  n:=eurec.glevel;
  getint('G-File level',n);
  if (n>=configset.sysopleve) and (not truesysop) then truesysops else eurec.glevel:=n;
  end;

  procedure egfpoints;
  var n:integer;
  begin
  n:=eurec.gpoints;
  getint('G-File points',n);
  eurec.gpoints:=n;
  end;

  procedure euconference;
  var k:integer;
  begin
    writehdr('User currently has the following conference flags set');
    for k:=1 to 20 do
        begin
          if (eurec.confset[k]>0) then write(k) else write('0');
          write(',');
        end;
        writeln('');
    for k:=21 to 31 do
      begin
        if (eurec.confset[k]>0) then write(k) else write('0');
        write(',');
        end;
    if (eurec.confset[32]>0) then writeln('32') else writeln('0');
    writestr(^M^P'Change which flag:*');
    if input='' then exit;
    K:=valu(input);
    if k>32 then begin
       writeln(^M'That is NOT a conference!');
       exit;
     end;
    if (eurec.confset[k]=1) then eurec.confset[k]:=0 else eurec.confset[k]:=1;
  end;

  procedure euusernote;
  var m:mstr;
      p:integer;
  begin
    m:=eurec.usernote;
    getmstr('Account note',m);
    eurec.usernote:=m;
  end;

  procedure euphone;
  var m:mstr;
      p:integer;
  begin
    m:=eurec.phonenum;
    buflen:=15;
    getmstr ('phone number',m);
    p:=1;
    while p<=length(m) do
      if (m[p] in ['0'..'9'])
        then p:=p+1
        else delete (m,p,1);
    if length(m)>7 then begin
      eurec.phonenum:=m;
      writelog (18,16,m)
    end
  end;

  procedure boardflags;
  var quit:boolean;

    procedure listflags;
    var bd:boardrec;
        cnt:integer;
    begin
      seek (bdfile,0);
      for cnt:=0 to filesize(bdfile)-1 do begin
        read (bdfile,bd);
        tab (bd.shortname,9);
        tab (bd.boardname,30);
        writeln (accessstr[getuseraccflag (eurec,cnt)]);
        if break then exit
      end
    end;

    procedure changeflag;
    var bn,q:integer;
        bname:mstr;
        ac:accesstype;
    begin
      buflen:=8;
      writestr ('Board to change access:');
      bname:=input;
      bn:=searchboard(input);
      if bn=-1 then begin
        writeln ('Not found!');
        exit
      end;
      writeln (^B^M'Current access: '^S,
               accessstr[getuseraccflag (eurec,bn)]);
      getacflag (ac,input);
      if ac=invalid then exit;
      setuseraccflag (eurec,bn,ac);
      case ac of
        letin:q:=2;
        keepout:q:=3;
        bylevel:q:=4
      end;
      writelog (18,q,bname)
    end;

    procedure allflags;
    var ac:accesstype;
    begin
      writehdr ('Set all board access flags');
      getacflag (ac,input);
      if ac=invalid then exit;
      writestr ('Confirm [Y/N]:');
      if not yes then exit;
      setalluserflags (eurec,ac);
      writelog (18,5,accessstr[ac])
    end;

  begin
    opentempbdfile;
    quit:=false;
    repeat
      repeat
        writestr (^M'L)ist flags, C)hange one flag, A)ll flags, or Q)uit:');
        if hungupon then exit
      until length(input)<>0;
      case upcase(input[1]) of
        'L':listflags;
        'C':changeflag;
        'A':allflags;
        'Q':quit:=true
      end
    until quit;
    closetempbdfile
  end;

  procedure defualt;
  begin
  eurec.level:=configset.defleve;
  eurec.usernote:=configset.defac;
  eurec.udpoints:=configset.deffp;
  eurec.udlevel:=configset.deffil;
  eurec.glevel:=configset.defgfil;
  eurec.gpoints:=configset.defgp;
  end;

  procedure specialsysop;

    procedure getsysop (c:configtype);
    begin
      writeln ('Section ',sectionnames[c],': '^S,
               sysopstr[c in eurec.config]);
      writestr ('Grant sysop access? *');
      if length(input)<>0
        then if yes
          then
            begin
              eurec.config:=eurec.config+[c];
              writelog (18,10,sectionnames[c])
            end
          else
            begin
              eurec.config:=eurec.config-[c];
              writelog (18,11,sectionnames[c])
            end
    end;

  begin
    if not truesysop then begin
      truesysops;
      exit
    end;
    writestr
('Section of M)ain, F)ile, B)ulletin, V)oting, E)mail, D)atabase, P)Doors:');
    if length(input)=0 then exit;
    case upcase(input[1]) of
      'M':getsysop (mainsysop);
      'F':getsysop (udsysop);
      'B':getsysop (bulletinsysop);
      'V':getsysop (votingsysop);
      'E':getsysop (emailsysop);
      'D':getsysop (databasesysop);
      'P':getsysop (doorssysop)
    end
  end;

  procedure getlogint (prompt:mstr; var i:integer; ln:integer);
  begin
    getint (prompt,i);
    writelog (18,ln,strr(i))
  end;

procedure IceCube;
var cpu:integer;
begin
ClearScr;
WriteLn(^R'?????????????????????????????????????????????????????????????????????????????');
WriteLn(^R'? '^P'Command '^S':                  '^O'('^U'Q'^O')uit               '^A'ViSiON v0.82 User Editor  '^R'?');
WriteLn(^R'?????????????????????????????????????????????????????????????????????????????');
Writeln('?????????????????????????????????????????????????????????????????????????????');
Writeln('?'^P' ('^S'H'^P') User Handle :'^R'                         '^P'                              '^R'  ?');
Writeln('?????????????????????????????????????????????????????????????????????????????');
Writeln('?'^P' ('^S'L'^P') Main Level   :'^R'                         '^P'('^S'C'^P') Conf 1 Access  :'^R'           ?');
Writeln('?'^P' ('^S'F'^P') File Level   :'^R'                         '^P'('^S'C'^P') Conf 2 Access  :'^R'           ?');
Writeln('?'^P' ('^S'O'^P') File Points  :'^R'                         '^P'('^S'C'^P') Conf 3 Access  :'^R'           ?');
Writeln('?'^P' ('^S'N'^P') Phone Number :'^R'                         '^P'('^S'C'^P') Conf 4 Access  :'^R'           ?');
Writeln('?'^P' ('^S'M'^P') Real Name    :'^R'                         '^P'('^S'C'^P') Conf 5 Access  :'^R'           ?');
Writeln('?'^P' ('^S'T'^P') Time Left    :'^R'                         '^P'('^S'W'^P') Wanted Status  :'^R'           ?');
Writeln('?'^P' ('^S'U'^P') User Note    :'^R'                         '^P'('^S'G'^P') Gfile Level    :'^R'           ?');
writeln('?'^P' ('^S'P'^P') Password     :'^R'                         '^P'('^S'+'^P') Grant Def Lvls  '^R'           ?');
writeLn('?'^P' ('^S'1'^P') Posted       :'^R'                         '^P'('^S'2'^P') # Of Uploads   :'^R'           ?');
WriteLn('?'^P' ('^S'3'^P') Uploaded K   :'^R'                         '^P'('^S'4'^P') # Of Downloads :'^R'           ?');
writeln('?'^P' ('^S'Z'^P') Private Note :'^R'                         '^P'('^S'5'^P') Required UDk Ratio:'^R'        ?');
WriteLn('?'^P' ('^S'6'^P') Required UD Ratio:'^R'                     '^P'('^S'7'^P') Required PCR:              '^R'?');
Writeln('?????????????????????????????????????????????????????????????????????????????');
Writeln(^R'?????????????????????????????????????????????????????????????????????????????');
Writeln(^R'? '^F'('^A'S'^F')ee User Stats ('^A'I'^F')nfoforms ('^A'B'^F')oard Flags ('^A'Y'^F') SysOp Privilages ('^A'D'^F+
 ')elete  '^R'?');
Writeln(^R'?????????????????????????????????????????????????????????????????????????????');
printxy(5,21,eurec.handle);
printxy(7,23,strr(eurec.level));
printxy(8,23,strr(eurec.udlevel));
printxy(9,23,strr(eurec.udpoints));
printxy(10,23,eurec.Phonenum);
Printxy(11,23,eurec.realname);
printxy(12,23,strr(eurec.timetoday));
printxy(13,23,eurec.usernote);
if local Then printxy(14,23,eurec.Password) Else Printxy(14,23,'[Classified]');
Printxy(15,23,strr(eurec.nbu));
PrintXy(16,23,strr(eurec.upkay));
PrintXy(17,23,eurec.specialsysopnote);
If eurec.udratio=0 then Printxy(18,26,'N/A') Else Printxy(18,26,strr(eurec.udratio)+'%');
if eurec.conf[1] then
printxy(7,69,'Yes') else
printxy(7,69,'No');
if eurec.conf[2] then
printxy(8,69,'Yes') else
printxy(8,69,'No');
if eurec.conf[3] then
printxy(9,69,'Yes') else
printxy(9,69,'No');
if eurec.conf[4] then
printxy(10,69,'Yes') else
printxy(10,69,'No');
if eurec.conf[5] then
printxy(11,69,'Yes') else
printxy(11,69,'No');
printxy(12,69,yesno(wanted in eurec.config));
Printxy(13,69,strr(Eurec.glevel));
Printxy(15,69,strr(eurec.uploads));
PrintXy(16,69,strr(eurec.downloads));
If eurec.UDKratio=0 then printxy(17,70,'N/A') Else Printxy(17,70,strr(eurec.UDKratio)+'%');
If eurec.pcratio=0 then printxy(18,64,'N/A') Else Printxy(18,64,strr(eurec.Pcratio)+'%');
goxy(2,2);
Write(^P' Command'^S' :');
end;

procedure choose;
var
gg:char;
tmp,cpu:integer;
imdone:boolean;
    procedure gox;
       Begin
       GoXY(1,23);
       End;
      Begin
      Repeat
      icecube;
        GG:=' ';
        Repeat
          Repeat
          If hungupon Then exit;
          Until charready Or hungupon;
          gg:=readchar;If Length(GG)=0 Then GG:=' ';GG:=UpCase(GG);
        Until (Pos(GG,'HDLFONMTUPSBIYCWGZ1234567+Q')>0) or hungupon;
        if gg='H' then begin
        gox;
        euname;
        end;
       if gg='D' then begin
       gox;
       eudel;
       end;
       if gg='L' then  begin
       gox;
       eulevel;
       end;
       if gg='F' then begin
       gox;
       getlogint('u/d level',eurec.udlevel,14);
       end;
       if gg='O' then begin
       gox;
       Getlogint('u/d points',eurec.udpoints,7);
       end;
       if gg='N' then begin
       gox;
       euphone;
       end;
       if gg='M' then begin
       gox;
       eurealname;
       end;
       if gg='T' then begin
       gox;
        getlogint('time for today',eurec.timetoday,12);
        end;
        if gg='U' then  begin
        gox;
        euusernote;
        end;
        if gg='P' then  begin
        gox;
        if local Then eupassword;
        if unum=1 then eupassword;
        end;
        if gg='S' then  begin
        gox;
        ShowUserStats(eurec);
        WriteSTr(^O'Press '^F'['^A'Enter'^F']:*');
        end;
        if gg='B' then  begin
        gox;
       boardflags;
       end;
       if gg='I' then begin
       gox;
       begin
          writestr(^M^P'Which infoform to view [1-5] ['^A'1'^P']:*');
          if input='' then input:='1';
          tmp:=valu(input);
          if (tmp>