(*****************************************************************************)
(*>                                                                         <*)
(*>  MISC2   .PAS -  Written by Eric Oman                                   <*)
(*>                                                                         <*)
(*>  Various miscellaneous functions used by the BBS.                       <*)
(*>                                                                         <*)
(*>                                                                         <*)
(*****************************************************************************)
{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit misc2;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  common,
  file2;

procedure pstat;
procedure bulletins(par:astr);
procedure abbs;
procedure ansig(x,y:integer);
procedure yourinfo;
procedure tfiles;
procedure ulist;

implementation

procedure pstat;
var c:char;
begin
  outkey(^L);
  with systat do begin
    print('New User Pass   : '+newuserpw);
    prompt('Board is        : '); if (closedsystem) then print('Closed') else print('Open');
    print('Number Users    : '+cstr(numusers));
    print('Number calls    : '+cstr(callernum));
    print('Date & Time     : '+dat);
    print('Active today    : '+cstr(systat.todayzlog.active));
    print('Calls today     : '+cstr(systat.todayzlog.calls));
    print('Messages today  : '+cstr(systat.todayzlog.pubpost));
    print('Email sent today: '+cstr(systat.todayzlog.privpost));
    print('Feed back today : '+cstr(systat.todayzlog.fback));
    print('Uploads today   : '+cstr(systat.todayzlog.uploads));
    prompt('Sysop           : '+aonoff(sysop,fstring.sysopin,fstring.sysopout));
    print('Disk free space : '+cstrl(freek(0))+'k');
    prompt('Sysop hours     : ');
    if (lowtime=hitime) then print('None')
    else
      print(tch(cstr(lowtime div 60))+':'+tch(cstr(lowtime mod 60))+' to '+
                tch(cstr(hitime div 60))+':'+tch(cstr(hitime mod 60)));

  end;
  if (not useron) then begin
    nl; nl; print('Hit any key');
    getkey(c);
  end;
end;

procedure bulletins(par:astr);
var filv:text;
    main,subs,s:astr;
    i:integer;
begin
  nl;
  if (par='') then
    if (systat.bulletprefix='') then
      par:='bulletin;bullet'
    else
      par:='bulletin;'+systat.bulletprefix;
  if (pos(';',par)<>0) then begin
    main:=copy(par,1,pos(';',par)-1);
    subs:=copy(par,pos(';',par)+1,length(par)-pos(';',par));
  end else begin
    main:=par;
    subs:=par;
  end;
  printf(main);
  if (not nofile) then
    repeat
      i:=8-length(subs); if (i<1) then i:=1;
      prt(fstring.bulletinline);
      input(s,i); s:=sqoutsp(s);
      if (not hangup) then begin
        if (s='') then s:='Q';
        if (s='?') then printf(main);
        if ((s<>'Q') and (s<>'?') and (s<>'')) then printf(subs+s);
      end;
    until ((s='Q') or (hangup));
end;

procedure abbs;
var filvar:text;
    s,i1,i2:astr;
    c:char;
    tf:text;
    there,abort,next:boolean;
begin
  abort:=FALSE; next:=FALSE;
  if (not (ramsg in thisuser.ac)) then begin
    nl;
    if pynq('Do you want to add to the BBS list? ') then begin
      repeat
        nl;
        print('Enter the phone number in the form:');
        sprint(#3#3+' '+systat.bbsphone);
        print(' ###-###-####');
        prt(':'); mpl(12); input(i1,12);
      until (length(i1)=12) or (i1='') or hangup;
      assign(tf,systat.afilepath+'bbslist.msg');
      {$I-} reset(tf); {$I+}
      nofile:=(ioresult<>0);
      there:=FALSE;
      if (not nofile) then begin
        while not eof(tf) do begin
          readln(tf,s);
          if (copy(s,1,12)=i1) then there:=TRUE;
        end;
        close(tf);
      end;
      if (there) then begin
        nl;
        if (i1<>'') then sprint(#3#5+'It''s already in there.');
        i1:='';
      end;
      s:=i1;
      if (s<>'') then begin
        nl;
        print('Enter the name of the BBS:');
        prt(':'); mpl(41); inputl(i1,41);
        s:=mln(s+'  '+#3#0+i1,56);

        nl;
        print('Enter max speed of system (ie, 300,1200,2400).');
        prt(':'); mpl(4); input(i2,4);
        if (i2='') then s:=s+'        '
        else
          s:=s+#3#4+'  ['+#3#3+i2+#3#4+']';
        if (i1<>'') then begin
          nl;
          print('Enter a 4-8 character BBS type.');
          prt(':');
          mpl(8);
          input(i1,8);
          if (i1<>'') then
            if copy(i1,1,3)<>'TAG' then s:=s+#3#7+' ('+#3#3+i1+#3#7+')'
                                   else s:=s+#3#7+' ('+#3#9+i1+#3#7+')';
          nl;
          printacr(s,abort,next);
          nl;
          if pynq('Is this correct? ') then begin
            assign(filvar,systat.afilepath+'bbslist.msg');
            {$I-} append(filvar); {$I+}
            if (ioresult<>0) then begin
              assign(filvar,systat.afilepath+'bbslist.msg');
              rewrite(filvar);
            end;
            writeln(filvar,s);
            close(filvar);
            sysoplog('Added to BBS list:');
            sl1(s);
          end;
        end;
      end;
    end;
  end
  else sprint(#3#7+'You are restricted from adding to the BBS list.');
end;

procedure ansig(x,y:integer);
begin
  if (spd<>'KB') then pr1(#27+'['+cstr(y)+';'+cstr(x)+'H');
  if (wantout) then gotoxy(x,y);
  pap:=0;
end;


procedure yourinfo;
var ddt,dt:datetimerec;
    i:integer;

  function istr(i:integer):astr;
  var s:astr;
  begin
    with thisuser do
      case i of
        1:s:=caps(name);
        2:s:=ph;
        3:s:=cstr(sl)+' SL';
        4:s:=cstr(dsl)+' DSL';
        5:s:=cstr(1+loggedon)+' calls';
        6:s:=cstr(ontoday)+' calls';
        7:s:=cstr(msgpost)+' posts';
        8:s:=cstr(emailsent+feedback)+' letters';
        9:begin
            s:=cstr(waiting)+' letter';
            if (waiting>1) then s:=s+'s';
          end;
       10:begin
            getdatetime(dt);
            timediff(ddt,timeon,dt);
            s:=ctim(dt2r(ddt));
          end;
       11:begin
            getdatetime(dt);
            timediff(ddt,timeon,dt);
            s:=cstrl(trunc(ttimeon+dt2r(ddt)))+' min.';
          end;
       12:s:=laston;
      end;
    istr:=s;
  end;

begin
  cls;
  if (okansi) then begin
    sprompt('��������������������������'+#3#4+'['+#3#6+' User Statistics '+#3#4+']');
      sprint(#3#1'������������������������Ŀ');
    print('� Your name    :                   � Public posts    :                �');
    print('� Phone number :                   � E-mail sent     :                �');
    prompt('� Sec Level    :                   � ');
    if (thisuser.waiting>0) then cl(5);
    prompt('Mail waiting');
      sprint(#3#1+'    :                �');
    print('� DL Sec Level :                   � Time on today   :                �');
    print('� # times on   :                   � Total time ever :                �');
    print('� On today     :                   � Last called     :                �');
    print('�����������������������������������������������������������������������');
    cl(3);
    for i:=1 to 12 do begin
      if i in [1..6] then ansig(17,i+1);
      if i in [7..12] then ansig(55,i-5);
      if (i<>9) or (thisuser.waiting=0) then prompt(istr(i))
      else sprompt(#3#5+istr(i)+#3#3);
    end;
    ansig(1,9);
    cl(1);
  end else begin
    with thisuser do begin
      print('Your name      : '+name);
      print('Phone number   : '+ph);
      print('Sec Level      : '+cstr(sl)+' SL');
      print('DL Sec Level   : '+cstr(dsl)+' DSL');
      print('# times on     : '+cstr(1+thisuser.loggedon));
      print('On today       : '+cstr(thisuser.ontoday));
      nl;
      print('Public posts   : '+cstr(thisuser.msgpost));
      print('E-mail sent    : '+cstr(thisuser.emailsent+thisuser.feedback));
      print('Mail waiting   : '+istr(9));
      print('Time on today  : '+istr(10));
      print('Total time ever: '+istr(11));
      print('Last called    : '+istr(12));
    end;
  end;
end;

(*
procedure yourinfo;
var s:string[90];
    c:char;
    abort,next:boolean;
    r:uflags;

  function mlnn(i,l:integer):string;
  begin
    mlnn:=mln(cstr(i),l);
  end;

  function mrnn(i,l:integer):string;
  begin
    mrnn:=mrn(cstr(i),l);
  end;

  function yesno(x:boolean):string;
  var s:string[8];
  begin
    s:=#3#3+' ';
    if (x) then s:=s+'Y' else s:=s+'N';
    s:=s+'  '+#3#1;
    yesno:=s;
  end;

begin
  cls;
	abort:=FALSE; next:=FALSE;
  printacr(#3#5+'Your user information (visible only to you):',abort,next);
  printacr('',abort,next);
  with thisuser do begin
    printacr(#3#1+' User Name: '+#3#3+mln(name,38)+#3#1+'SL: '+#3#3+mlnn(sl,3)+
      #3#1+'  DSL: '+#3#3+cstr(dsl),abort,next);
    printacr(#3#1+' Real Name: '+#3#3+mln(realname,38)+#3#1+'Phone: '+#3#3+
      ph,abort,next);
    printacr(#3#1+'   Address: '+#3#3+mln(street,38)+#3#1+'  Age: '+#3#3+sex+
      cstr(ageuser(bday))+' ('+bday+')',abort,next);
    printacr(#3#1+'City/State: '+#3#3+mln(citystate,35)+#3#1+'First on: '+
      #3#3+firston,abort,next);
    printacr(#3#1+'  Zip Code: '+#3#3+mln(zipcode,35)+#3#1+' Last on: '+#3#3+
      laston,abort,next);
    printacr('',abort,next);
    s:=mrnn(linelen,2)+'x'+mrnn(pagelen,2)+' (';
    if (avatar in ac) then s:=s+'AVATAR)'
      else if (ansi in ac) then s:=s+'ANSI)'
        else s:=s+'TTY)';
    printacr(#3#1+'Pause:'+yesno(pause in ac)+'OneKey:'+yesno(onekey in ac)+
      'ClrScr:'+yesno((clsmsg=1))+'Novice:'+yesno(novice in ac)+'Color:'+
      yesno(color in ac)+'Screen: '+#3#3+s,abort,next);
    s:=#3#1+'Mailbox Status: '+#3#3;
    if (nomail in ac) then s:=s+'Closed                ' else begin
      if (forusr=0) then s:=s+'Open                  '
        else s:=s+'Fowarded to user '+mlnn(forusr,4);
    end;
    s:=s+#3#1+'      File List Type: '+#3#3+cstr(flistopt);
    printacr(s,abort,next);
    printacr('',abort,next);
    printacr(#3#1+'Calls Today: '+#3#3+mlnn(ontoday,5)+#3#1+
      '      Public Sent: '+#3#3+mlnn(msgpost,5)+#3#1+'      Total ULs: '+#3#3+
      cstr(uploads)+#3#1+'/'+#3#3+cstrl(uk)+'K',abort,next);
    str(nsl/60.0:5:0,s);
    s:=mln(sqoutsp(s),5);
    printacr(#3#1+'  Time Left: '+#3#3+s+#3#1+'       Email Sent: '+#3#3+
      mlnn(emailsent,5)+#3#1+'      Total DLs: '+#3#3+cstr(downloads)+#3#1+
      '/'+#3#3+cstrl(dk)+'K',abort,next);
    printacr(#3#1+'Total Calls: '+#3#3+mlnn(loggedon,5)+#3#1+'    Feedback '+
      'Sent: '+#3#3+mlnn(feedback,5)+#3#1+'    File Points: '+#3#3+
      cstr(filepoints),abort,next);
    s:=#3#1+' Total Time: '+#3#3+mlnn(ttimeon,5)+#3#1+'    ';
    if (waiting<>0) then s:=s+#3#5;
    s:=s+'Email Waiting: ';
    if (waiting<>0) then s:=s+#3#8 else s:=s+#3#3;
    s:=s+mlnn(waiting,5)+#3#1+'      Time Bank: '+#3#3+cstr(timebank);
    printacr(s,abort,next);
  end;
  pausescr;
end;
*)
procedure tfiles;
var gfil:file of tfilerec;
    b:tfilerec;
    gftit:array[1..150] of record
      tit:string[40];
      arn:integer;
      gfile:boolean;
      acs:acstring;
{      arreq:acrq;}
      gdaten:integer;
    end;
(*
    gftit:array[1..150] of record
      tit:string[40];
      filen:string[12];
      arn:integer;
      gfile:boolean;
      acs,ulacs:acstring;
      gdate:string[8];
    end;
*)
    titl,s:astr;
    t,c,lgftn,lgftnt,numgft:integer;
    abort,next,deep,xexit:boolean;

  procedure gettit(n:integer);
  var b:tfilerec;
      r:integer;
  begin
    numgft:=0;
    if n>0 then begin
      seek(gfil,n); read(gfil,b); titl:=b.title;
    end else titl:='[ Main Section ]';
    r:=n+1;
    if r<=t then begin
      seek(gfil,r); read(gfil,b);
      while (r<=t) and (b.filen[1]<>#1) do begin
        if (aacs(b.acs)) then begin
          inc(numgft);
          with gftit[numgft] do begin
            tit:=b.title;
            arn:=r;
            gfile:=TRUE;
            gdaten:=b.gdaten;
          end;
        end;
        inc(r);
        if (r<=t) then begin seek(gfil,r); read(gfil,b); end;
      end;
    end;
    if n=0 then
      while (r<=t) do begin
        seek(gfil,r); read(gfil,b);
        if ((b.filen[1]=#1) and (aacs(b.acs))) then begin
          inc(numgft);
          with gftit[numgft] do begin
            tit:=b.title;
            arn:=r;
            gfile:=FALSE;
            gdaten:=b.gdaten;
          end;
        end;
        inc(r);
      end;
  end;

  procedure lgft;
  var abort,next:boolean; c:integer;
  begin
    nl; sprint(#3#3+titl); nl;
    if numgft=0 then print('No Tfiles.') else begin
      abort:=FALSE; next:=FALSE; c:=1;
      while (c<=numgft) and (not abort) do begin
        s:=#3#5+cstr(c)+#3#7+': '+#3#3+gftit[c].tit;
        if (gftit[c].gdaten>=daynum(thisuser.laston)) then s:=#3#8+'*'+s
          else s:=' '+s;
        printacr(s,abort,next);
        inc(c);
      end;
    end;
  end;

  procedure scaninput(var s:string; allowed:string);
  var os:string;
      i:integer;
      c:char;
      gotcmd:boolean;
  begin
    gotcmd:=FALSE; s:='';
    repeat
      getkey(c); c:=upcase(c);
      os:=s;
      if ((pos(c,allowed)<>0) and (s='')) then begin gotcmd:=TRUE; s:=c; end
      else
      if (pos(c,'0123456789')<>0) then begin
        if (length(s)<5) then s:=s+c;
      end
      else
      if ((s<>'') and (c=^H)) then s:=copy(s,1,length(s)-1)
      else
      if (c=^X) then begin
        for i:=1 to length(s) do prompt(^H' '^H);
        s:=''; os:='';
      end
      else
      if (c=#13) then gotcmd:=TRUE;

      if (length(s)<length(os)) then prompt(^H' '^H);
      if (length(s)>length(os)) then prompt(copy(s,length(s),1));
    until ((gotcmd) or (hangup));
    nl;
  end;

  procedure extracttfile;
  var dirinfo:searchrec;
      s,s2:string;
      lng,numfiles,tsiz:longint;
      i:integer;
      found,nospace,ok:boolean;
  begin
    nl;
    print('Extract text-file to temporary directory -');
    nl;
    prompt('Already in TEMP: ');
    numfiles:=0; tsiz:=0;
    findfirst(systat.temppath+'3\*.*',anyfile-dos.directory,dirinfo);
    found:=(doserror=0);
    while (found) do begin
      inc(tsiz,dirinfo.size);
      inc(numfiles);
      findnext(dirinfo);
      found:=(doserror=0);
    end;
    if (numfiles=0) then print('Nothing.')
      else print(cstrl(numfiles)+' files totalling '+cstrl(tsiz)+' bytes.');

    if (not fso) then begin
      print('The limit is '+cstrl(systat.maxintemp)+'k bytes.');
      lng:=systat.maxintemp; lng:=lng*1024;
      if (tsiz>lng) then begin
        nl;
        print('You have exceeded this limit.');
        nl;
        print('Please remove some files from the TEMP directory using');
        print('the user-archive command to free up some space.');
        exit;
      end;
    end;

    nl;
    prt('T-file #: ');
    scaninput(s,'');
    if ((hangup) or (s='')) then exit;
    i:=value(s);
    if ((i>=1) and (i<=numgft)) then
      if (gftit[i].gfile) then begin
        seek(gfil,gftit[i].arn); read(gfil,b);
        s:=systat.tfilepath+b.filen;
        s2:=systat.temppath+'3\'+b.filen;
        sprompt(#3#5+'Progress: ');
        copyfile(ok,nospace,TRUE,s,s2);
        if (ok) then
          sprint(#3#5+' - Copy successful.')
        else
          if (nospace) then
            sprint(#3#7+'Copy unsuccessful - insufficient space!')
          else
            sprint(#3#7+'Copy unsuccessful!');
        sysoplog('User copied t-file "'+b.filen+'" into TEMP directory.');
(*        if (ok) then didsomething:=TRUE;*)
      end;
  end;

begin
  nl;
  assign(gfil,systat.gfilepath+'gfiles.dat');
  {$I-} reset(gfil); {$I+}
  if ioresult<>0 then begin
    rewrite(gfil);
    b.gdaten:=0;
    write(gfil,b);
  end;
  seek(gfil,0); read(gfil,b); t:=b.gdaten;
  abort:=FALSE; next:=FALSE;
  if (t=0) then print('No Tfiles available today.')
  else begin
    gettit(0); xexit:=FALSE;
    lgft; lgftn:=0; deep:=FALSE; lgftnt:=0;
    repeat
      nl;
      if (next) then begin
        next:=FALSE; s:='';
        sprint(#3#5+'==Skipped to next==');
        nl;
      end else begin
        sprompt(#3#5+'['+cstr(lgftn)+'] '+#3#3+'Tfiles: (1-'+cstr(numgft)+',?,Q) : ');
        cl(5); scaninput(s,'QX?');
        nl;
      end;
      if (s='') then
        if (lgftn=numgft) then s:='Q' else s:=cstr(lgftn+1);
      if (s='?') then lgft;
      if (s='Q') then
        if (deep) then begin
          deep:=FALSE;
          gettit(0);
          lgft;
          lgftn:=lgftnt;
        end else
          xexit:=TRUE;
      if (s='X') then extracttfile;

      c:=value(s);
      if ((c>0) and (c<=numgft)) then begin
        if (gftit[c].gfile) then begin
          seek(gfil,gftit[c].arn);
          read(gfil,b);
          if (pos('.',b.filen)<>0) then
            pfl(systat.tfilepath+b.filen,abort,next,TRUE)
          else printf(systat.tfilepath+b.filen);
          lgftn:=c;
        end else begin
          gettit(gftit[c].arn);
          lgftn:=c;
          if (numgft>0) then begin
            lgft;
            lgftnt:=c; lgftn:=0;
            deep:=TRUE;
          end else begin
            gettit(0);
            nl; print('No Tfiles there.');
          end;
        end;
      end;
    until ((xexit) or (hangup));
  end;
  close(gfil);
end;

procedure ulist;
const sepr2=#3#4+':'+#3#3;
var u:userrec;
    sr:smalrec;
    s:astr;
    i,j:integer;
    abort,next,sfo:boolean;
begin
  sfo:=(filerec(sf).mode<>fmclosed);
  if (not sfo) then reset(sf);
  nl;
  loadboard(board);
  sprint(#3#9+'Users with access to "'+#3#5+memboard.name+#3#9+'"');
  nl;
  sprint(#3#3+'User Name                 '+sepr2+
         'Computer Type                '+sepr2+'Sex'+sepr2+'Last on');
  sprint(#3#4+'==========================:==============================:=:=========');
  reset(uf);
  i:=0; j:=0;
  abort:=FALSE;
  while (not abort) and (i<filesize(sf)-1) do begin
    inc(i);
    seek(sf,i); read(sf,sr); seek(uf,sr.number); read(uf,u);
    if (aacs1(u,sr.number,memboard.acs)) then begin
      printacr(#3#3+mln(caps(sr.name)+' #'+cstr(sr.number),26)+' '+
               mln(u.computer,30)+#3#3+' '+u.sex+'  '+u.laston,abort,next);
      inc(j);
    end;
  end;
  if (not abort) then begin
    nl;
    s:=' User';
    if (j<>1) then s:=s+'s';
    s:=s+'.';
    printacr(#3#7+' ** '+#3#5+cstr(j)+s,abort,next);
  end;
  close(uf);
  if (not sfo) then close(sf);
end;

end.