{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit common2;

interface

uses
  crt, dos,
  myio,
  tmpcom;

procedure showudstats;
procedure skey1(c:char);
procedure savesystat;
procedure remove_port;
procedure openport(comport:byte; baud:longint; parity:char; databits,stopbits:byte);
{procedure initthething;}
procedure iport;
procedure gameport;
procedure sendcom1(c:char);
function recom1(var c:char):boolean;
procedure term_ready(ready_status:boolean);
function getwindysize(wind:integer):integer;
procedure inuserwindow;
procedure commandline(s:string);
procedure sclearwindow;
procedure schangewindow(needcreate:boolean; newwind:integer);
procedure topscr;
procedure tleft;
procedure readinmacros;
procedure changeuserdatawindow;
procedure saveuf;

implementation

uses
  common, common1, common3;

procedure cpr(c1,c2:byte; u:userrec);
var r:uflags;
begin
  for r:=rlogon to rmsg do begin
    if (r in u.ac) then textattr:=c1 else textattr:=c2;
    write(copy('LCVBA*PEKM',ord(r)+1,1));
  end;
  textattr:=c2; write('/');
  for r:=fnodlratio to fnodeletion do begin
    if (r in u.ac) then textattr:=c1 else textattr:=c2;
    write(copy('1234',ord(r)-19,1));
  end;
end;

procedure showudstats;
begin
  commandline('U/L: '+cstr(thisuser.uploads)+'/'+cstr(trunc(thisuser.uk))+'k'+
           ' ³ D/L: '+cstr(thisuser.downloads)+'/'+cstr(trunc(thisuser.dk))+'k'+
           ' File Points:' +cstr(thisuser.filepoints));
end;

procedure skey1(c:char);
var s:string[50];
    cz,i:integer;
    cc:char;
    b,savwantout:boolean;
begin
  case ord(c) of
    ALT_1..ALT_9:globat((ord(c)-ALT_1)+1);
    ALT_MINUS:begin
      writeln;
      writeln('Stack space left : ',sptr,' bytes');
      writeln;
    end;
    ALT_EQUAL:begin doneafternext:=not doneafternext; tleft; end;
    CTRL_PRTSC:exiterrorlevel;
  end;
  if (not inwfcmenu) then
  begin
    case ord(c) of
      ALT_F:showsysfunc;
      ALT_G:
        begin
          commandline('Log options - [T]rap activity [C]hat buffering');
          cc:=upcase(readkey);
          with thisuser do
            case cc of
              'C':begin
                    commandline('Auto chat buffering - [O]ff [S]eperate [M]ain (CHAT.MSG)');
                    cc:=upcase(readkey);
                    if (cc in ['O','S','M']) then chatfile(FALSE);
                    case cc of
                      'O':begin chatauto:=FALSE; chatseperate:=FALSE; end;
                      'S':begin chatauto:=TRUE; chatseperate:=TRUE; end;
                      'M':begin chatauto:=TRUE; chatseperate:=FALSE; end;
                    end;
                    if (cc in ['S','M']) then chatfile(TRUE);
                    topscr;
                  end;
              'T':begin
                    commandline('Activity trapping - [O]ff [S]eperate [M]ain (TRAP.MSG)');
                    cc:=upcase(readkey);
                    if (cc in ['O','S','M']) then
                      if (trapping) then begin
                        close(trapfile);
                        trapping:=FALSE;
                      end;
                    case cc of
                      'O':begin trapactivity:=FALSE; trapseperate:=FALSE; end;
                      'S':begin trapactivity:=TRUE; trapseperate:=TRUE; end;
                      'M':begin trapactivity:=TRUE; trapseperate:=FALSE; end;
                    end;
                    if (cc in ['S','M']) then inittrapfile;
                    topscr;
                  end;
            end;
          commandline('');
        end;
      ALT_L:cls;
      ALT_T:
        if (cwindowon) then begin
          i:=systat.curwindow;
          sclearwindow;
          systat.istopwindow:=not systat.istopwindow;
          cwindowon:=TRUE;
          schangewindow(TRUE,i);
        end;
      ALT_V:
        begin
          autovalidate(thisuser,usernum);
          topscr; commandline('User Validated.');
        end;
      F1:if (useron) then begin
          wait(TRUE);
          changeuserdatawindow;
          wait(FALSE);
        end;
      SHIFT_F1:if (useron) then changeuserdatawindow;
      F2:
        if (useron) then begin
          i:=systat.curwindow;
          if (systat.windowon) then begin
            inc(i);
            if (i>2) then i:=1;
          end else
            systat.windowon:=TRUE;
          schangewindow(TRUE,i);
        end;
      SHIFT_F2:
         if (useron) then
           if (not systat.windowon) then begin
             systat.windowon:=TRUE;
             cwindowon:=TRUE;
             schangewindow(TRUE,systat.curwindow);
           end else begin
             sclearwindow;
             systat.windowon:=FALSE;
           end;
      F3:
        if (not com_carrier) then commandline('No carrier detected!')
        else begin
          if (outcom) then
            if (incom) then incom:=FALSE else
              if (com_carrier) then incom:=TRUE;
          if (incom) then commandline('User keyboard ON.')
                     else commandline('User keyboard OFF.');
          com_flush_rx;
        end;
      F4:
        begin
          chatcall:=FALSE; chatr:='';
          thisuser.ac:=thisuser.ac-[alert]; tleft;
        end;
      F5:hangup:=TRUE;
      F6:if (useron) then topscr;
      F7:
        begin
          b:=ch; ch:=TRUE;
          dec(thisuser.tltoday,5);
          tleft;
          ch:=b;
        end;
      F8:
        begin
          b:=ch; ch:=TRUE;
          inc(thisuser.tltoday,5);
          if (thisuser.tltoday<0) then thisuser.tltoday:=32767;
          tleft;
          ch:=b;
        end;
      F9:
        if (useron) then
          with thisuser do begin
            if (sl=255) then
              if (realsl<>255) or (realdsl<>255) then begin
                thisuser.sl:=realsl;
                thisuser.dsl:=realdsl;
                if (systat.compressbases) then newcomptables;
                topscr; commandline('Normal access restored.');
              end else
            else begin
              realsl:=sl; realdsl:=dsl;
              thisuser.sl:=255;
              thisuser.dsl:=255;
              if (systat.compressbases) then newcomptables;
              topscr; commandline('Temporary SysOp access granted.');
            end;
          end;
      F10:
        if (ch) then begin
          ch:=FALSE;
          chatr:='';
        end else
          chat;
      ARROW_HOME:
        if (ch) then chatfile(not cfo);
      ARROW_UP,
      ARROW_LEFT,
      ARROW_RIGHT,
      ARROW_DOWN:
        if ((ch) or (write_msg)) then begin
          if (okavatar) then buf:=buf+^V else buf:=buf+^[+'[';
          case ord(c) of
            ARROW_UP:if (okavatar) then buf:=buf+^C else buf:=buf+'A';
            ARROW_LEFT:if (okavatar) then buf:=buf+^E else buf:=buf+'D';
            ARROW_RIGHT:if (okavatar) then buf:=buf+^F else buf:=buf+'C';
            ARROW_DOWN:if (okavatar) then buf:=buf+^D else buf:=buf+'B';
          end;
        end;
      SHIFT_F3:
        if (outcom) then begin
          savwantout:=wantout; wantout:=FALSE;
          wait(TRUE);
          wantout:=savwantout;
          commandline('User screen OFF ³ User keyboard OFF');
          outcom:=FALSE; incom:=FALSE;
        end else
          if (not com_carrier) then commandline('No carrier detected!')
          else begin
            commandline('User screen ON ³ User keyboard ON');
            savwantout:=wantout; wantout:=FALSE;
            wait(FALSE);
            wantout:=savwantout;
            outcom:=TRUE; incom:=TRUE;
          end;
      SHIFT_F5:
        begin
          cline(s,'Display what hangup file (HANGUPxx.*) :');
          commandline('');
          if (s<>'') then begin
						nl; nl; incom:=FALSE;
            printf('hangup'+s);
            sysoplog('++ Displayed hangup file HANGUP'+s);
            hangup:=TRUE;
          end;
        end;
      SHIFT_F7:
        begin
          wait(TRUE);
          cline(s,'Subtract from user''s time left: ');
          commandline('');
          if (s<>'') then begin
            b:=ch; ch:=TRUE;
            dec(thisuser.tltoday,value(s));
            tleft;
            ch:=b;
          end;
          wait(FALSE);
        end;
      SHIFT_F8:
        begin
          wait(TRUE);
          cline(s,'Add to user''s time left: ');
          commandline('');
          if (s<>'') then begin
            b:=ch; ch:=TRUE;
            inc(thisuser.tltoday,value(s));
            if (thisuser.tltoday<=0) then thisuser.tltoday:=32767;
            tleft;
            ch:=b;
          end;
          wait(FALSE);
        end;
      SHIFT_F10:
        begin
          beepend:=not beepend;
          b:=ch; ch:=TRUE;
          tleft; ch:=b;
        end;
      ALT_F3:
        if (wantout) then begin
          clrscr; tc(11); writeln('Text OFF');
          wantout:=FALSE;
          cursoron(FALSE);
        end else begin
          clrscr; tc(11); writeln('Text ON');
          wantout:=TRUE;
          cursoron(TRUE);
        end;
      ALT_J,
      ALT_F4:SysopShell(FALSE);
      ALT_F5:
        begin
          randomize;
          for i:=1 to 50 do prompt(chr(random(255)));
          hangup:=TRUE;
        end;
      ALT_F9:
        begin
          repeat
            outkey(^G);
            commandline('Paging user...');
            delay(100);
            commandline('');
            checkhangup;
          until ((not empty) or (hangup));
        end;
      ALT_F10:commandline(chatr);
      CTRL_F4:SysopShell(TRUE);
      CTRL_F5:
        begin
          randomize;
          s:='';
          for i:=1 to random(50) do s:=s+chr(random(255));
          prompt(s); (* dm(' '+s,c); *)
        end;
    end;
  end;
end;

procedure savesystat;
var systatf:file of systatrec;
begin
  {rcg11242000 DOSism.}
  {assign(systatf,start_dir+'\status.dat');}
  assign(systatf,start_dir+'/status.dat');
  rewrite(systatf); write(systatf,systat); close(systatf);
end;

procedure setacch(c:char; b:boolean; var u:userrec);
begin
  if (b) then if (not (tacch(c) in u.ac)) then acch(c,u);
  if (not b) then if (tacch(c) in u.ac) then acch(c,u);
end;

procedure remove_port;
begin
  if (not localioonly) then com_deinstall;
end;

procedure openport(comport:byte; baud:longint; parity:char;
                   databits,stopbits:byte);
begin
  if (not localioonly) then begin
    com_set_parity(com_none,stopbits);
    com_set_speed(baud);
  end;
end;

procedure iport;
var anyerrors:word;
begin
  if (not localioonly) then begin
    if (com_installed) then com_deinstall;
    com_install(modemr.comport,anyerrors,systat.fossil);
    openport(modemr.comport,modemr.waitbaud,'N',8,1);
  end;
end;

procedure gameport;
var speed:longint;
begin
  if (not localioonly) then begin
    if (spd='KB') then speed:=modemr.waitbaud else speed:=value(spd);
    if ((not modemr.noforcerate) or (value(spd)<9600)) then
      openport(modemr.comport,speed,'N',8,1);
  end;
end;

procedure sendcom1(c:char);
begin
  if (not localioonly) then com_tx(c);
end;

function recom1(var c:char):boolean;
begin
  c:=#0;
  if (localioonly) then recom1:=TRUE else begin
    if (not com_rx_empty) then begin
      c:=com_rx;
      recom1:=TRUE;
    end else
      recom1:=FALSE;
  end;
end;

procedure term_ready(ready_status:boolean);
var mcr_value:byte;
begin
  if (not localioonly) then
    if (ready_status) then com_raise_dtr else com_lower_dtr;
end;

function getwindysize(wind:integer):integer;
begin
  case wind of
    0:getwindysize:=0;
    1:getwindysize:=5;
    2:getwindysize:=11;
  end;
end;

procedure inuserwindow;
begin
  if (cwindowon) then
    if (systat.istopwindow) then
      window(1,getwindysize(systat.curwindow)+1,80,25)
    else
      window(1,1,80,25-getwindysize(systat.curwindow));
end;

procedure commandline(s:string);
var p,xx,yy:integer;
    sx,sy,sz:byte;
begin
  if (not useron) then exit;

  sx:=wherex; sy:=wherey; sz:=textattr;
  p:=40-(length(s) div 2);

  window(1,1,80,25);
  xx:=4; yy:=1;
  if (not cwindowon) then xx:=1 else
    if (systat.istopwindow) then
      yy:=getwindysize(systat.curwindow)
    else
      yy:=26-getwindysize(systat.curwindow);

  gotoxy(xx,yy);
  if (not ismono) then textattr:=$1F else textattr:=$70;
  if (not cwindowon) then clreol else
    write('                                                                          ');
  gotoxy(xx,yy); write(s);

  inuserwindow;
  gotoxy(sx,sy); textattr:=sz;
end;

procedure clrline(y:integer);
begin
  gotoxy(1,y); clreol;
end;

procedure sclearwindow;
var wind:windowrec;
    i,windysize:integer;
    x,y,z:byte;
begin
  if ((not cwindowon) or (not useron) or (not systat.windowon)) then exit;

  x:=wherex; y:=wherey; z:=textattr;
  windysize:=getwindysize(systat.curwindow);
  cursoron(FALSE);

  window(1,1,80,25); textattr:=7;
  if (not systat.istopwindow) then
    for i:=26-windysize to 25 do clrline(i)
  else begin
    savescreen(wind,1,windysize+1,80,25);
    for i:=1 to windysize do clrline(i);
    movewindow(wind,1,1);
    for i:=26-windysize to 25 do clrline(i);
  end;
  cwindowon:=FALSE;

  gotoxy(x,y); textattr:=z;
  cursoron(TRUE);
end;

procedure schangewindow(needcreate:boolean; newwind:integer);
var wind:windowrec;
    i,j,k,windysize,z:integer;
    sx,sy,sz:byte;
begin
  if (((not useron) and (not needcreate)) or (not systat.windowon)) then exit;

  sx:=wherex; sy:=wherey; sz:=textattr;
  windysize:=getwindysize(newwind);

  if (not needcreate) then needcreate:=(newwind<>systat.curwindow);
  if ((windysize<>getwindysize(systat.curwindow)) and (cwindowon)) then
    sclearwindow;

  if (not systat.istopwindow) then begin
    cursoron(FALSE);
    if ((needcreate) and (newwind in [1,2])) then begin
      window(1,1,80,25);
      gotoxy(1,25);
      if (sy>25-windysize) then begin
        z:=windysize-(25-sy);
        for i:=1 to z do writeln;
        dec(sy,z);
      end;
    end;
    gotoxy(sx,sy);
  end else begin
    if ((needcreate) and (newwind in [1,2])) then begin
      window(1,1,80,25);
      savescreen(wind,1,1,80,sy);
      if (sy<=25-windysize) then z:=windysize+1 else z:=26-sy;
      if (z>=2) then movewindow(wind,1,z);
      if (z<=4) then sy:=(sy-z)+1;

      if (sy>25-windysize) then sy:=25-windysize;
      if (sy<1) then sy:=1;
    end;
    cursoron(TRUE);
  end;

  systat.curwindow:=newwind;
  if (systat.curwindow<>0) then cwindowon:=TRUE;
  gotoxy(sx,sy); textattr:=sz;
  if (systat.curwindow in [1,2]) then topscr;
end;

procedure blankzlog(var zz:zlogrec);
var i:integer;
begin
  with zz do begin
    date:=' ------ ';
    for i:=0 to 4 do userbaud[i]:=0;
    active:=0; calls:=0; newusers:=0; pubpost:=0; privpost:=0;
    fback:=0; criterr:=0; uploads:=0; downloads:=0; uk:=0; dk:=0;
  end;
end;

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

function ctp(t,b:longint):string;
var s,s1:string[32];
    n:real;
begin
  s:=cstr((t*100) div b);
  if (length(s)=1) then s:=' '+s;
  s:=s+'.';
  if (length(s)=3) then s:=' '+s;
  n:=t/b+0.0005;
  s1:=cstr(trunc(n*1000) mod 10);
  ctp:=s+s1+'%';
end;

procedure topscr;
var zf:file of zlogrec;
    zz:array[1..3] of zlogrec;
    s,spe:string;
    i,j,k,windysize:integer;
    sx,sy,sz:byte;
    c:char;
begin
  if ((usernum=0) or (not cwindowon) or (not useron)) then exit;

  cursoron(FALSE);
  sx:=wherex; sy:=wherey; sz:=textattr;
  window(1,1,80,25); windysize:=getwindysize(systat.curwindow);
  textbackground(0);

  if (systat.istopwindow) then window(1,1,80,windysize)
    else window(1,26-windysize,80,25);
  for i:=1 to windysize do begin gotoxy(1,i); clreol; end;

  if (systat.istopwindow) then gotoxy(1,windysize) else gotoxy(1,1);
  tc(9); textbackground(1); clreol; textbackground(0);

  if (systat.istopwindow) then window(1,1,80,windysize-1)
    else window(1,27-windysize,80,25);

  with thisuser do
    case systat.curwindow of
      1:begin
          cwriteat(1,1, #3#11+nam);
          cwriteat(36,1,#3#14+'PS:'+#3#11+mn(msgpost,6)+
                        #3#14+'ES:'+#3#11+mn(emailsent,6)+
                        #3#14+'FS:'+#3#11+mn(feedback,4)+
                        #3#14+'MW:'+#3#11+mn(waiting,3));
          cwrite(#3#14+'UL:'+#3#11+cstr(uploads)+'-'+cstr(uk)+'k');
          cwriteat(1,2, #3#11+realname);
          cwriteat(36,2,#3#14+'TC:'+#3#11+mn(loggedon,6)+
                        #3#14+'TT:'+#3#11+mn(ttimeon,6)+
                        #3#14+'CT:'+#3#11+mn(ontoday,4)+
                        #3#14+'IL:'+#3#11+mn(illegal,3));
          cwrite(#3#14+'DL:'+#3#11+cstr(downloads)+'-'+cstr(dk)+'k');
          spe:=spd;
          if (length(spe)=5) then spe:=copy(spe,1,2)+'.'+copy(spe,3,1);
          if (spe='KB') then spe:='Keys';
          cwriteat(1,3, #3#10+note);
          cwriteat(36,3,#3#11+sex+mn(ageuser(bday),2)+
                        #3#14+'('+#3#11+bday+#3#14+')  '+
                        #3#14+'LO:('+#3#11+laston+#3#14+') '+
                        #3#9+'['+spe+'] '+
                        #3#14+'Pts:'+#3#11+cstr(filepoints));
          cwriteat(1,4, #3#14+'SL:'+#3#11+mn(sl,4)+
                        #3#14+'DSL:'+#3#11+mn(dsl,4)+
                        #3#14+'AR:');
          for c:='A' to 'Z' do begin
            if (c in ar) then tc(4) else tc(7);
            write(c);
          end;
          cwrite(#3#14+' AC:');
          if (ismono) then cpr($70,$07,thisuser) else cpr(4,7,thisuser);
        end;
      2:begin
          if ((aacs(systat.nodlratio)) or (fnodlratio in thisuser.ac)) then
            s:=#3#10+'Exempt'
          else
            s:=#3#11+'1/'+cstr(systat.dlratio[thisuser.sl])+
                   '-1k/'+cstr(systat.dlkratio[thisuser.sl])+'k';
          cwriteat(1,1, #3#11+caps(name)+' ('+caps(realname)+')');
          cwriteat(38,1,#3#11+sex+mn(ageuser(bday),2)+'('+bday+') '+
                        #3#14+'FileRatio='+s);

          if ((aacs(systat.nopostratio)) or (fnopostratio in thisuser.ac)) then
            s:=#3#10+'Exempt'
          else begin
            i:=systat.postratio[thisuser.sl];
            s:=#3#11+cstr(i div 10)+'.'+cstr(i mod 10)+' calls/1 post';
          end;
          cwriteat(1,2, #3#14+street);
          cwriteat(38,2,#3#14+'FO:('+#3#11+firston+#3#14+') '+
                        'PostRatio='+s);

          cwriteat(1,3, #3#14+citystate+' '+zipcode);
          cwriteat(38,3,#3#14+'LO:('+#3#11+laston+#3#14+') AR=');
          for c:='A' to 'Z' do begin
            if (c in ar) then tc(4) else tc(7);
            write(c);
          end;

          cwriteat(1,4, #3#11+stripcolor(computer)+
                        ' ('+cstr(linelen)+'x'+cstr(pagelen)+')');
          cwriteat(38,4,#3#14+ph+'  AC=');
          if (ismono) then cpr($70,$07,thisuser) else cpr(4,7,thisuser);

          cwriteat(1,5, #3#10+note);
          cwriteat(50,5,#3#14+'SL='+#3#11+mn(sl,4)+
                        #3#14+'DSL='+#3#11+mn(dsl,3));

          cwriteat(1,6, #3#9+'ÄÄÄÄÄÄÄÄÂ'+#3#11+'Mins'+
                        #3#9+'ÄÂÄÄÄÄÂÄÄÄÄÄÄÂ'+#3#11+'#New'+
                        #3#9+'Â'+#3#11+'Tim/'+
                        #3#9+'Â'+#3#11+'Pub'+
                        #3#9+'ÄÂ'+#3#11+'Priv'+
                        #3#9+'Â'+#3#11+'Feed'+
                        #3#9+'ÂÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄ');

          cwriteat(1,7, #3#11+'  Date   Activ Call %Activ User User '+
                              'Post Post Back Errs Uploads    Downloads');

          zz[1]:=systat.todayzlog;

          assign(zf,systat.gfilepath+'zlog.dat');
          {$I-} reset(zf); {$I+}
          if (ioresult=0) then begin
            if (eof(zf)) then blankzlog(zz[2]) else read(zf,zz[2]);
            if (eof(zf)) then blankzlog(zz[3]) else read(zf,zz[3]);
            close(zf);
          end else begin
            blankzlog(zz[2]);
            blankzlog(zz[3]);
          end;

          textcolor(9);
          for i:=7 to 10 do
            for j:=1 to 12 do begin
              case j of
                1:k:=9; 2:k:=15; 3:k:=20; 4:k:=27; 5:k:=32; 6:k:=37;
                7:k:=42; 8:k:=47; 9:k:=52; 10:k:=57; 11:k:=68; 12:k:=79;
              end;
              gotoxy(k,i); write('³');
            end;

          textcolor(14);
          for i:=1 to 3 do begin
            if (i=2) then textcolor(11);
            if (i=1) then cwriteat(1,8,'Today''s')
              else cwriteat(1,i+7,zz[i].date);
            cwriteat(10,i+7,mrnn(zz[i].active,5));
            cwriteat(16,i+7,mrnn(zz[i].calls,4));
            cwriteat(21,i+7,ctp(zz[i].active,1440));
            cwriteat(28,i+7,mrnn(zz[i].newusers,4));
            if (zz[i].calls>0) then s:=mrnn(zz[i].active div zz[i].calls,4)
              else s:='';
            cwriteat(33,i+7,s);
            cwriteat(38,i+7,mrnn(zz[i].pubpost,4));
            cwriteat(43,i+7,mrnn(zz[i].privpost,4));
            cwriteat(48,i+7,mrnn(zz[i].fback,4));
            cwriteat(53,i+7,mrnn(zz[i].criterr,4));
            cwriteat(58,i+7,mn(zz[i].uploads,3)+'-'+cstr(zz[i].uk)+'k');
            cwriteat(69,i+7,mn(zz[i].downloads,3)+'-'+cstr(zz[i].dk)+'k');
          end;
        end;
    end;

(*  with thisuser do begin
    gotoxy(2,1);
    tc(14); write(nam+' '); tc(11); write('('+realname+')');
    tc(14);
    gotoxy(2,2); write('SL=     AR=');
    gotoxy(2,3); write('DSL=    AC=');
    tc(11);
    gotoxy(6,2); if res[1]<>255 then write(sl) else write(res[2]);
    gotoxy(6,3); if res[1]<>255 then write(dsl) else write(res[3]);
    gotoxy(13,2);
    for c:='A' to 'Z' do begin
      if (c in ar) then tc(4) else tc(7);
      write(c);
    end;
    gotoxy(13,3); cpr(7,thisuser);
    gotoxy(28,3); write('        ');

    tc(10);
    gotoxy(40,1); write(note);
    tc(14);
    gotoxy(40,2); write(stripcolor(computer)+' (',linelen,'x',pagelen,')');
    gotoxy(40,3); write(ph);
    tc(9);
    spe:=spd;
    if (length(spe)=5) then spe:=copy(spe,1,2)+'.'+copy(spe,3,1);
    if (spe='KB') then spe:='Keys';
    gotoxy(61,3); write('['+spe+']');
    tc(11);
    gotoxy(76,2); write(sex,ageuser(bday));
  end;*)

  commandline(chatr);
  textbackground(0);
  inuserwindow;
  gotoxy(sx,sy); textattr:=sz;
  sde;
  tleft;
  cursoron(TRUE);
end;

procedure gotopx(i:integer; dy:integer);
var y:integer;
begin
  if (systat.istopwindow) then y:=getwindysize(systat.curwindow)-1
    else y:=25;
  if (systat.curwindow=2) then dec(y,5);
  gotoxy(i,y+dy);
end;

procedure tleft;
var s:string[16];
    lng:longint;
    zz:integer;
    sx,sy,sz:byte;
begin
  stsc;
  if ((usernum<>0) and (cwindowon) and (useron)) then begin
    cursoron(FALSE);
    sx:=wherex; sy:=wherey; sz:=textattr;
    window(1,1,80,25);
    gotopx(65,0); clreol;
    if (hangup) then cwrite(#3#21+'Ä'+#3#29+'DROP'+#3#21+'Ä') else
      if (doneafternext) then cwrite(#3#20+'Í'+#3#30+'DNXT'+#3#20+'Í') else
      if (beepend) then cwrite(#3#20+'<'+#3#28+'('+#3#14+'**'+#3#28+')'+#3#20+'>') else
      if (trapping) then cwrite(#3#20+'Ä'+#3#30+'TRAP'+#3#20+'Ä') else
      if (alert in thisuser.ac) then cwrite(#3#20+'Ä'+#3#30+'ALRT'+#3#20+'Ä') else
      if (chatr<>'') then cwrite(#3#25+'Ä'+#3#27+'CHAT'+#3#25+'Ä');
    gotopx(72,0);
    cwrite(#3#7+'TL='+cstrl(trunc(nsl/60)));
    if (sysop) then cwrite(#3#15+'*');
    if (systat.curwindow=2) then begin
      gotopx(72,-1);
      if (thisuser.chatauto) then s:=#3#15 else
        if (systat.autochatopen) then s:=#3#11 else s:=#3#8;
      s:=s+'C';
      if (thisuser.chatseperate) then s:=s+#3#15+'S' else
        s:=s+#3#8+'S';
      if (thisuser.trapactivity) then s:=s+#3#15+'T' else
        if (systat.globaltrap) then s:=s+#3#11+'T' else s:=s+#3#8+'T';
      if (thisuser.trapseperate) then s:=s+#3#15+'S' else
        s:=s+#3#8+'S';
      cwrite(s);
    end;
    inuserwindow;
    gotoxy(sx,sy); textattr:=sz;
    cursoron(TRUE);
  end;
  if ((nsl<0) and (choptime<>0.0)) then begin
    sysoplog('++ Logged user off in preparation for system event');
    nl; nl;
    sprint(#3#7+^G'Shutting down for System Event.'^G);
    nl;
    hangup:=TRUE;
  end;
  if ((not ch) and (nsl<0) and (useron) and (choptime=0.0)) then begin
    nl; nl;

    printf('notleft');
    if (nofile) then
      sprint(#3#7+'You have used up all your time.  Time expired.');

    if (thisuser.timebank<>0) then begin
      nl;
      sprint(#3#5+'Your Time Bank account has '+
             #3#3+cstr(thisuser.timebank)+#3#5+' minutes left in it.');
      dyny:=TRUE;
      if pynq('Withdraw from Time Bank? [Y] : ') then begin
        prt('Withdraw how many minutes? '); inu(zz); lng:=zz;
        if (lng>0) then begin
          if lng>thisuser.timebank then lng:=thisuser.timebank;
          dec(thisuser.timebankadd,lng);
          if (thisuser.timebankadd<0) then thisuser.timebankadd:=0;
          dec(thisuser.timebank,lng);
          inc(thisuser.tltoday,lng);
          sprint('^5In your account: ^3'+cstr(thisuser.timebank)+
                  '^5   Time left online: ^3'+cstr(trunc(nsl) div 60));
          sysoplog('TimeBank: Time expired, withdrew '+cstrl(lng)+' minutes.');
        end;
      end else
        sprint(#3#7+'Hanging up.');
    end;
    if (nsl<0) then hangup:=TRUE;
  end;
  checkhangup;
  sde;
end;

procedure gp(i,j:integer);
var x:integer;
begin
  case j of
    0:gotoxy(58,8);
    1:gotoxy(20,7); 2:gotoxy(20,8); 3:gotoxy(20,9);
    4:gotoxy(20,10); 5:gotoxy(36,7); 6:gotoxy(36,8);
  end;
  if (j in [1..4]) then x:=5 else x:=3;
  if (i=2) then inc(x);
  if (i>0) then gotoxy(wherex+x,wherey);
end;

procedure changeuserdatawindow;
var wind:windowrec;
    s:string[39];
    oo,i,oldsl,{realsl,realdsl,}savsl,savdsl:integer;
    c:char;
    sx,sy,ta:byte;
    done,done1:boolean;

  procedure shd(i:integer; b:boolean);
  var j:integer;
      c:char;
  begin
    gp(0,i);
    if (b) then textcolor(14) else textcolor(9);
    case i of
      1:write('SL  :'); 2:write('DSL :'); 3:write('FP  :');
      4:write('Note:'); 5:write('AR:');   6:write('AC:');
    end;
    if (b) then begin textcolor(0); textbackground(7); end else textcolor(14);
    write(' ');
    with thisuser do
      case i of
        0:if (b) then write('ÄDoneÄ')
          else begin
            textcolor(9); write('Ä');
            textcolor(11); write('Done');
            textcolor(9); write('Ä');
          end;
        1:write(mln(cstr(sl),3));
        2:write(mln(cstr(dsl),3));
        3:write(mln(cstrl(filepoints),5));
        4:write(mln(note,39));
        5:for c:='A' to 'Z' do begin
            if (c in ar) then textcolor(4)
              else if (b) then textcolor(0) else textcolor(7);
            write(c);
          end;
        6:if (b) then cpr($07,$70,thisuser) else cpr($70,$07,thisuser);
      end;
    write(' ');
    textbackground(0);
    cursoron(i in [1..4]);

    if (b) then begin
      gotoxy(26,12); textcolor(14);
      for j:=1 to 41 do write(' ');
      gotoxy(26,12);
      case i of
        0:write('Done -  exit back to BBS');
        1:write('Security Level (0..255)');
        2:write('Download Security Level (0..255)');
        3:write('File Points');
        4:write('Special SysOp note for this user');
        5:write('Special access flags ("!" to toggle all)');
        6:write('Restrictions & special ("!" to clear)');
      end;
    end;
  end;

  procedure ddwind;
  var i:integer;
      c:char;
  begin
    cursoron(FALSE);
    textcolor(9);
    box(1,18,6,68,13); window(19,7,67,12); clrscr;
    box(1,18,6,68,11); window(19,7,67,10);

    window(1,1,80,25);
    gotoxy(20,12); textcolor(9); write('Desc:');

    for i:=0 to 6 do shd(i,FALSE);

    shd(oo,TRUE);
  end;

  procedure ar_tog(c:char);
  begin
    if (c in thisuser.ar) then thisuser.ar:=thisuser.ar-[c]
      else thisuser.ar:=thisuser.ar+[c];
  end;

begin
  saveuf;
{
  if ((realsl<>-1) and (realdsl<>-1)) then begin
    savsl:=thisuser.sl; savdsl:=thisuser.dsl;
    thisuser.sl:=realsl; thisuser.dsl:=realdsl;
    saveuf;
    thisuser.sl:=savsl; thisuser.dsl:=savdsl;
  end;}

  infield_out_fgrd:=0;
  infield_out_bkgd:=7;
  infield_inp_fgrd:=0;
  infield_inp_bkgd:=7;
  infield_arrow_exit:=TRUE;
  infield_arrow_exited:=FALSE;

  sx:=wherex; sy:=wherey; ta:=textattr;
  savescreen(wind,18,6,68,13);
  oo:=1;

  ddwind;
  done:=FALSE;
  repeat
    infield_arrow_exited:=FALSE;
    case oo of
      0:begin
          done1:=FALSE;
          shd(oo,TRUE);
          repeat
            c:=readkey;
            case upcase(c) of
              ^M:begin done:=TRUE; done1:=TRUE; end;
              #0:begin
                   c:=readkey;
                   case ord(c) of
                     ARROW_DOWN,ARROW_UP:
                       begin
                         infield_arrow_exited:=TRUE;
                         infield_last_arrow:=ord(c);
                         done1:=TRUE;
                       end;
                   end;
                 end;
            end;
          until (done1);
        end;
      1:begin
          s:=cstr(thisuser.sl); infield1(26,7,s,3);
          if (value(s)<>thisuser.sl) then begin
            realsl:=value(s);
            thisuser.sl:=value(s);
            inc(thisuser.tltoday,
                systat.timeallow[thisuser.sl]-systat.timeallow[realsl]);
          end;
        end;
      2:begin
          s:=cstr(thisuser.dsl); infield1(26,8,s,3);
          if (value(s)<>thisuser.dsl) then begin
            realdsl:=value(s);
            thisuser.dsl:=value(s);
          end;
        end;
      3:begin
          s:=cstr(thisuser.filepoints); infield1(26,9,s,5);
          thisuser.filepoints:=value(s);
        end;
      4:begin
          s:=thisuser.note; infield1(26,10,s,39);
          thisuser.note:=s;
        end;
      5:begin
          done1:=FALSE;
          repeat
            c:=upcase(readkey);
            case c of
              #13:done1:=TRUE;
              #0:begin
                   c:=readkey;
                   case ord(c) of
                     ARROW_DOWN,ARROW_UP:
                       begin
                         infield_arrow_exited:=TRUE;
                         infield_last_arrow:=ord(c);
                         done1:=TRUE;
                       end;
                   end;
                 end;
              '!':begin
                    for c:='A' to 'Z' do ar_tog(c);
                    shd(oo,TRUE);
                  end;
              'A'..'Z':begin ar_tog(c); shd(oo,TRUE); end;
            end;
          until (done1);
        end;
      6:begin
          s:='LCVBA*PEKM1234';
          done1:=FALSE;
          repeat
            c:=upcase(readkey);
            if (c=#13) then done1:=TRUE
            else
            if (c=#0) then begin
              c:=readkey;
              case ord(c) of
                ARROW_DOWN,ARROW_UP:
                  begin
                    infield_arrow_exited:=TRUE;
                    infield_last_arrow:=ord(c);
                    done1:=TRUE;
                  end;
              end;
            end
            else
            if (pos(c,s)<>0) then begin
              acch(c,thisuser);
              shd(oo,TRUE);
            end
            else begin
              if (c='!') then
                for i:=1 to length(s) do setacch(s[i],FALSE,thisuser);
              shd(oo,TRUE);
            end;
          until (done1);
        end;
    end;
    if (not infield_arrow_exited) then begin
      infield_arrow_exited:=TRUE;
      infield_last_arrow:=ARROW_DOWN;
    end;
    if (infield_arrow_exited) then
      case infield_last_arrow of
        ARROW_DOWN,ARROW_UP:begin
          shd(oo,FALSE);
          if (infield_last_arrow=ARROW_DOWN) then begin
            inc(oo);
            if (oo>6) then oo:=0;
          end else begin
            dec(oo);
            if (oo<0) then oo:=6;
          end;
          shd(oo,TRUE);
        end;
      end;
  until (done);

  removewindow(wind); topscr;
  gotoxy(sx,sy); textattr:=ta;
  cursoron(TRUE);
  if (systat.compressbases) then newcomptables;

  saveuf;

{  if ((realsl<>-1) and (realdsl<>-1)) then begin
    savsl:=thisuser.sl; savdsl:=thisuser.dsl;
    thisuser.sl:=realsl; thisuser.dsl:=realdsl;
    saveuf;
    thisuser.sl:=savsl; thisuser.dsl:=savdsl;
  end;}
end;

procedure readinmacros;
var macrf:file of macrorec;
    i:integer;
begin
  for i:=1 to 4 do macros.macro[i]:='';
  if (thisuser.mpointer<>-1) then begin
    assign(macrf,systat.gfilepath+'macro.lst');
    {$I-} reset(macrf); {$I+}
    if (ioresult<>0) then begin
      sysoplog('!!! "MACRO.LST" file not found.  Created.');
      rewrite(macrf); close(macrf); reset(macrf);
    end;
    if (filesize(macrf)>thisuser.mpointer) then begin
      seek(macrf,thisuser.mpointer);
      read(macrf,macros);
    end else
      thisuser.mpointer:=-1;
    close(macrf);
  end;
end;

procedure saveuf;
var savsl,savdsl:integer;
    ufo:boolean;
begin
  if ((realsl<>-1) and (realdsl<>-1)) then begin
    savsl:=thisuser.sl; savdsl:=thisuser.dsl;
    thisuser.sl:=realsl; thisuser.dsl:=realdsl;

    ufo:=(filerec(uf).mode<>fmclosed);
    if (not ufo) then reset(uf);
    seek(uf,usernum); write(uf,thisuser);
    if (not ufo) then close(uf);

    thisuser.sl:=savsl; thisuser.dsl:=savdsl;
  end;
end;

end.