Jason Aller Floppy Collection/153.img/TELES.ZIP/DOSP1.PAS

Pascal/Delphi Source File | 1988-07-25 | 37.6 KB | 1,096 lines

var
  fuku1:byte;
  fuku2:byte;

procedure uedit(usern:integer);
var user,user1:userrec; c:char; r:restrictions; i,i1,x:integer; save:boolean; ii,is:astr; f:file;
  mr:mailrec; byt:byte; zz:astr; abort,next:boolean; c1:integer; qq:integer;
  searchopt:record
              sslh,ssll:byte;             bsl:boolean;
              sdslh,sdsll:byte;           bdsl:boolean;
              scomp:byte;                 bcomp:boolean;
              ssex:char;                  bsex:boolean;
              sagel,sageh:byte;           bage:boolean;
              sar:set of acrq;            bar:boolean;
              slastonh,slastonl:integer;  blaston:boolean;
            end;

  function filename(mrec:messages):astr;
  begin
    filename:=systat.msgpath+mrec.ltr+cstr(mrec.number)+'.'+cstr(mrec.ext);
  end;

  procedure isr(uname:astr;usernum:integer);
  var t,i,ii:integer; sr:smalrec;
  begin
   ii:=systat.users; i:=0;
   while (ii-i)>1 do begin
     t:=(ii+i) div 2;
     if uname<srl[t].name then
       ii:=t
     else
       i:=t;
   end;
   if srl[ii].name<uname then i:=ii;
   for ii:=systat.users downto i+1 do
     srl[ii+1]:=srl[ii];
   sr.name:=uname; sr.number:=usernum;
   srl[i+1]:=sr;
   systat.users:=systat.users+1;
   savesystat;
   rewrite(sf); for ii:=0 to systat.users do write(sf,srl[ii]); close(sf);
  end;

  procedure dsr(uname:astr);
  var i,rn:integer; sr:smalrec;
  begin
    rn:=0;
    for i:=1 to systat.users do
      if srl[i].name=uname then
        rn:=i;
    if rn<>0 then begin
      for i:=rn to systat.users-1 do srl[i]:=srl[i+1];
      systat.users:=systat.users-1;
      savesystat;
      rewrite(sf); for i:=0 to systat.users do write(sf,srl[i]); close(sf);
    end else sl1('*** Couldn''t delete "'+uname+'"');
  end;

  procedure rsm;
  var x:smr; i:integer;
  begin
    {$I-} reset(smf); {$I+}
    if ioresult=0 then begin
      i:=0; cl(1);
      repeat
        if i<=filesize(smf)-1 then begin seek(smf,i); read(smf,x); end;
        while (i<filesize(smf)-1) and (x.destin<>usernum) do begin
          i:=i+1; seek(smf,i); read(smf,x);
        end;
        if (x.destin=usernum) and (i<=filesize(smf)-1) then begin
          print(x.msg);
          seek(smf,i); x.destin:=-1; write(smf,x);
          smread:=true;
        end;
        i:=i+1;
      until (i>filesize(smf)-1) or hangup;
      close(smf);
      cl(1);
    end;
  end;

  procedure finduser(var usernum:integer);
  var t,i,i1,gg:integer;
      nn,duh:astr;
  begin
    input(nn,25);
    usernum:=value(nn); if usernum>0 then begin
      if usernum>filesize(uf)-1 then begin
        print('Unknown User.');
        usernum:=0; end
      else begin
        seek(uf,usernum);
        read(uf,user);
      end;
    end else begin
      for gg:=1 to systat.users do begin
        if pos(nn,srl[gg].name)<>0 then begin
          if srl[gg].name<>nn then begin
          prompt('Incomplete match--> ');cl(3);prompt(srl[gg].name);nl;
          prompt('Is this right? ');if yn then nn:=srl[gg].name;end;
        end;
      end;
      i:=1; i1:=systat.users; t:=(i1+i) div 2;
      while ((i1-i)>1) and (srl[t].name<>nn) do begin
        if srl[t].name<nn then
          i:=t
        else
          i1:=t;
        t:=(i1+i) div 2;
      end;
      usernum:=0;
      if srl[i].name=nn then usernum:=srl[i].number;
      if srl[i1].name=nn then usernum:=srl[i1].number;
      if srl[t].name=nn then usernum:=srl[t].number;
      if usernum=0 then print('Unknown User.');
     end;
   end;

    procedure pcuropt;
    var c:char;
    begin
      cls; nl; cl(5); print('Search Options');
      nl;
      prompt('1. Security level     : ');
      if searchopt.bsl then
        print(cstr(searchopt.ssll)+' to '+cstr(searchopt.sslh))
      else
        print('Inactive');
      prompt('2. D/L Security level : ');
      if searchopt.bdsl then
        print(cstr(searchopt.sdsll)+' to '+cstr(searchopt.sdslh))
      else
        print('Inactive');
      prompt('3. Sex                : ');
      if searchopt.bsex then
        if searchopt.ssex='M' then
          print('Male')
        else
          print('Female')
      else
        print('Inactive');
      prompt('4. Age                : ');
      if searchopt.bage then
        print(cstr(searchopt.sagel)+' to '+cstr(searchopt.sageh))
      else
        print('Inactive');
      prompt('5. AR                 : ');
      if searchopt.bar then begin
        for c:='A' to 'G' do
          if c in searchopt.sar then outkey(c) else outkey(' ');
        nl;
      end else
        print('Inactive');
      prompt('6. Last On            : ');
      if searchopt.blaston then
        print(cstr(searchopt.slastonl)+' days to '+cstr(searchopt.slastonh)+' days ago')
      else
        print('Inactive');
      nl;
    end;

  procedure stopt;
  var n:integer; c,ch:char; done:boolean; i:astr;

    procedure chbyte(var x:byte);
    var i:astr; n:integer;
    begin
      input(i,3); n:=x;
      if i<>'' then n:=value(i);
      if (n>=0) and (n<=255) then x:=n;
    end;

    procedure chword(var x:integer);
    var i:astr; n:integer;
    begin
      input(i,3); n:=x;
      if i<>'' then n:=value(i);
      if (n>=0) and (n<=32767) then x:=n;
    end;

  begin
    cls; done:=false; pcuropt;
    repeat
      prt('Change (?,Q) : ');
      onek(ch,'Q?123456TL');
      case ch of
        'Q':done:=true;
        '?':begin
              nl;
              print('Q:uit Options  ?:This Help');
              print('L:ist Options  T:oggle options');
              print('1-6: Change Option #');
              nl;
            end;
        'L':pcuropt;
        'T':begin
              nl; prt('Which (1-6) ? '); onek(ch,#13'123456'); nl;
              case ch of
                '1':searchopt.bsl:=not searchopt.bsl;
                '2':searchopt.bdsl:=not searchopt.bdsl;
                '3':searchopt.bsex:=not searchopt.bsex;
                '4':searchopt.bage:=not searchopt.bage;
                '5':searchopt.bar:=not searchopt.bar;
                '6':searchopt.blaston:=not searchopt.blaston;
              end;
              ch:=#0;
            end;
        '1':if searchopt.bsl then begin
             nl; print('Security Level:');
              prompt('Lower limit ('+cstr(searchopt.ssll)+') ? ');
              chbyte(searchopt.ssll); fuku2:=searchopt.ssll;
              prompt('Upper limit ('+cstr(searchopt.sslh)+') ? ');
              chbyte(searchopt.sslh); fuku1:=searchopt.sslh;
            end;
        '2':if searchopt.bdsl then begin
              nl; print('Download Security Level:');
              prompt('Lower limit ('+cstr(searchopt.sdsll)+') ? ');
              chbyte(searchopt.sdsll);
              prompt('Lower limit ('+cstr(searchopt.sdslh)+') ? ');
              chbyte(searchopt.sdslh);
            end;
        '3':if searchopt.bsex then begin
              nl; prompt('Sex (M,F) ? '); onek(searchopt.ssex,'MF');
            end;
        '4':if searchopt.bage then begin
              nl; print('Age:');
              prompt('Lower limit ('+cstr(searchopt.sagel)+') ? ');
              chbyte(searchopt.sagel);
              prompt('Upper limit ('+cstr(searchopt.sageh)+') ? ');
              chbyte(searchopt.sageh);
            end;
        '5':if searchopt.bar then begin
              prompt('Which board? '); onek(c,#13'ABCDEFG'); c:=upcase(c);
              if c in ['A'..'G'] then if c in searchopt.sar then
                searchopt.sar:=searchopt.sar-[c]
              else
                searchopt.sar:=searchopt.sar+[c];
            end;
        '6':if searchopt.blaston then begin
              nl; print('Limits of number of days since last logon:');
              prompt('Lower limit ('+cstr(searchopt.slastonl)+') ? ');
              chword(searchopt.slastonl);
              prompt('Upper limit ('+cstr(searchopt.slastonh)+') ? ');
              chword(searchopt.slastonh);
            end;
      end;
    until done or hangup;
  end;

  procedure delusr;
  var vdata:file of vdatar; vd:vdatar; j:integer; i:integer;
  begin
    prompt('Delete? '); if yn and (not user.deleted) then begin
      save:=true; user.deleted:=true; dsr(user.name);
      i:=usernum; usernum:=usern; rsm; usernum:=i;
      user.waiting:=0; reset(mailfile);
      for i:=0 to filesize(mailfile)-1 do begin
        seek(mailfile,i); read(mailfile,mr); i1:=0;
        if (mr.destin=usern) or (abs(mr.from)=usern) then begin
          if abs(mr.from)=usern then i1:=mr.destin;
          assign(f,filename(mr.msg)); {$I-} erase(f); {$I+} x:=ioresult;
          mr.destin:=-1; mr.from:=0; seek(mailfile,i); write(mailfile,mr);
        end;
        if (i1>0) and (i1<filesize(uf)) then begin
          seek(uf,i1); read(uf,user1); user1.waiting:=user1.waiting-1;
          seek(uf,i1); write(uf,user1); if i1=1 then fw:=fw-1;
        end;
      end;
      close(mailfile);
      assign(vdata,systat.gfilepath+'voting.dat');
      reset(vdata);
      for j:=1 to filesize(vdata) do
        if user.vote[j]>0 then begin
          seek(vdata,j-1); read(vdata,vd);
          vd.answ[user.vote[j]].numres:=vd.answ[user.vote[j]].numres-1;
          seek(vdata,j-1); write(vdata,vd);
          user.vote[j]:=0;
        end;
      close(vdata);
    end;
  end;

  procedure renusr;
  begin
    if user.deleted then print('Can''t rename deleted users.') else begin
      nl;prompt('Enter new name or <CR>: '); input(ii,25);
      if (ii<>'') and (ii[1] in ['A'..'Z']) then begin
        dsr(user.name); isr(ii,usern); user.name:=ii; save:=true;
        if usern=usernum then thisuser.name:=ii;
      end;
    end;
  end;

  procedure chhflags;
  begin
  save:=true;
              print('LCVBA*PEKM');
              nl;prompt('Which? ');onek(c,'LCVBA*PEKM'+#13); c:=upcase(c); print(c); nl;
              if c<>#13 then acch(c,user); save:=true;
           end;

  procedure autoval;
  begin
    user.sl:=systat.autosl; user.dsl:=systat.autodsl;
    user.ac:=systat.autoac; user.ar:=systat.autoar; save:=true;
    print('User Validated.'); pausescr;
  end;

  procedure chhsl;
  begin
  prompt('Enter new SL: '); input(ii,4);
      if ii<>'' then begin
      byt:=value(ii); save:=true; if thisuser.sl>byt then user.sl:=byt;
      if thisuser.sl<byt then sysoplog('Illegal SL change-Name:'+user.name+' to '+cstr(byt));
      end;
      if (user.sl=99) or (lcosysop in seclev[user.sl].anst) then begin
      prompt('Which board #? '); input(ii,2);
      if ii<>'' then user.sbn:=value(ii);
      save:=true;
       end;
    end;

   procedure chhdsl;
   begin
   begin prompt('Enter new DSL: '); input(ii,4);
      if ii<>'' then begin
      byt:=value(ii); save:=true; if thisuser.sl>byt then user.dsl:=byt;
      if thisuser.sl<byt then sysoplog('Illegal DSL change-Name:'+user.name+' to '+cstr(byt));
      end;
      end;
   end;

  procedure printhelp;
  begin
    nl; cl(5); print('Extra Command Help');
    nl;
    print('[ - Up 1 Record    ] - Down 1 Record');
    print('{ - Search up      } - Search down');
    print('U - Find user      D - Delete user');
    print('R - Restore user   V - Validate quick');
    print('* - Autovalidate   O - Search Options');
    print('% - NewInfoForm    @ - Lock out user');
    nl;
  end;

  procedure search(i:integer);
  var n:integer; u:userrec;

    function okusr(n:integer):boolean;
    var ok:boolean;
    begin
      seek(uf,n); read(uf,u); ok:=true;
      with searchopt do begin
        if bsl then
          if (u.sl<ssll) or (u.sl>sslh) then ok:=false;
        if bdsl then
          if (u.dsl<sdsll) or (u.dsl>sdslh) then ok:=false;
        if bcomp then
          if u.comptype<>scomp then ok:=false;
        if bsex then
          if (ssex<>u.sex) and (u.sex<>' ') then ok:=false;
        if bage then
          if ((u.age<sagel) or (u.age>sageh)) and (u.age<>0) then ok:=false;
        if bar then
          if not (u.ar>=sar) then ok:=false;
        if blaston then
          if (daynum(u.laston)<daynum(date)-slastonh) or
             (daynum(u.laston)>daynum(date)-slastonl) then ok:=false;
      end;
      okusr:=ok;
    end;

  begin
    nl;print('Searching...');
    n:=usern;
    repeat
      usern:=usern+i;
      if usern=0 then usern:=filesize(uf)-1;
      if usern=filesize(uf) then usern:=1;
    until okusr(usern) or (usern=n);
  end;

var s,geepw:astr;
begin
 reset(uf);
  with searchopt do begin
    bsl:=false; bdsl:=false; bcomp:=false; bsex:=false; bage:=false; bar:=false; blaston:=false;
    sslh:=255; ssll:=0; sdslh:=255; sdsll:=0; scomp:=1; ssex:='M';
    sagel:=0; sageh:=255; sar:=[]; slastonh:=32767; slastonl:=0;
    fuku1:=sslh; fuku2:=ssll;
  end;
  repeat
   searchopt.sslh:=fuku1; searchopt.ssll:=fuku2;
   seek(uf,usern); read(uf,user); save:=false;
   if (usern=usernum) and useron then user:=thisuser;
   cls; abort:=false;
   with user do begin
     abort:=false;
     printacr(#3+#5+'Record #'+cstr(usern)+' of '+cstr(filesize(uf)),abort,next);
     nl;
     cl(1);
     s:=#3+#3+'N>'+#3+#0+'User Name:'+#3+#9+mln(name,22)+' #'+mln(cstr(usern),3)+'  '+#3+#3+'D>'+#3+#0+'Status: ';
     if deleted then s:=s+#3+#8+'Deleted' else begin
       if lockedout then s:=s+#3+#8+'Locked out' else
       s:=s+#3+#9+'Normal';
     end;
     printacr(s,abort,next);
     printacr(#3+#3+'E>'+#3+#0+'Real Name:'+#3+#9+mln(realname,21)+
     '        '+#3+#3+'S>'+#3+#0+'SL: '+#3+#9+mln(cstr(sl),3)+
     ' '+#3+#3+'T>'+#3+#0+'DSL: '+#3+#9+cstr(dsl),abort,next);
     printacr(#3+#3+'P>'+#3+#0+'Phone No.:'+#3+#9+ph+' '+
     {+#3+#3+'G>'+#3+#0+'Age: '+#3+#9+mln(cstr(age),2)+}
     '                '+#3+#3+'C>'+#3+#0+'Computer type:'+#3+#9+computer,abort,next);
     s:=#3+#3+'$>'+#3+#0+'Password :'+#3+#9; if (realsl=255) or ((spd='KB') and (so))
       then s:=s+mln(pw,20) else s:=s+'XXXXXXXXXXXXXXXXXXXX';
     {s:=s+'     '+#3+#3+'X)'+#3+#0+'Sex: '+#3+#9;
     if sex='M' then s:=s+'Male  ' else s:=s+'Female';}
     s:=s+'         '+#3+#3+'B>'+#3+#0+'Board Access :'+#3+#9; for c:='A' to 'G' do
     if c in ar then s:=s+c else s:=s+' ';
     printacr(s,abort,next);
    s:=#3+#3+'1>'+#3+#0+'Messages Posted:'+#3+#9+mln(cstr(msgpost),3)+' '+
    #3+#3+'2>'+#3+#0+'Email Sent :'+#3+#9+mln(cstr(emailsent),3)+
    '  '+#3+#3+'A>'+#3+#0+'AC Restricts :'+#3+#9; for r:=rlogon to rmsg do
    if r in ac then s:=s+copy('LCVBA*PEKM',ORD(R)+1,1) else s:=s+' ';
    printacr(s,abort,next);
    printacr(#3+#3+'3>'+#3+#0+'Feedback Sent  :'+#3+#9+mln(cstr(feedback),3)+' '+#3+#3+'4>'+
    #3+#0+'Mail in Box:'+#3+#9+mln(cstr(waiting),3)+
    '  '+#3+#3+'#>'+#3+#0+'File points  : '+#3+#9+cstr(filepoints),abort,next);
    printacr(#3+#3+'5>'+#3+#0+'# of logons    :'+#3+#9+mln(cstr(loggedon),3)+
    ' '+#3+#3+'6>'+#3+#0+'Logon today:'+#3+#9+mln(cstr(ontoday),3)+
    '  '+#3+#3+'!>'+#3+#0+'Lockout file : '+#3+#9+lockedfile+'.MSG',abort,next);
    s:=#3+#3+'K>'+#3+#0+'Upload/Download:'+#3+#9+mln(cstr(uploads),3)+'-'+mln(cstr(uk),5)+' / '+
    mln(cstr(downloads),3)+'-'+mln(cstr(dk),5)+'  '+#3+#3+'X>'+#3+#0+'Sex    : '+#3+#9;
    if sex='M' then s:=s+'Male  ' else s:=s+'Female';
    s:=s+#3+#3+'     G>'+#3+#0+'Age : '+#3+#9+cstr(age);
    printacr(s,abort,next);
    printacr(#3+#3+'J>'+#3+#0+'City, State:'+#3+#9+mln(citystate,26)+' '+#3+#3+'Z>'+#3+#0+'Zipcode: '+#3+#9+
      mln(zipcode,10)+#3+#0+' Timeon: '+#3+#9+cstrr(ttimeon,10),abort,next);
    s:=#3+#3+'M>'+#3+#0+'Street Addr:'+#3+#9+mln(street,21)+'      '+#3+#3+'L>'+#3+#0+'Alert  : '+#3+#9;
    if alert in option then s:=s+'Yes' else s:=s+'No ';
    s:=s+#3+#0+'        Mail  : '+#3+#9;
    if (nomail in option) or (forusr<>0) then begin
      if nomail in option then
        s:=s+'Closed'
      else
        s:=s+'Forwarded';
    end else s:=s+'Open';
    printacr(s,abort,next);
    printacr(#3+#3+'I>'+#3+#0+'Occupation :'+#3+#9+occupation,abort,next);
    printacr(#3+#3+'W>'+#3+#0+'BBS refrnce:'+#3+#9+wherebbs,abort,next);
    printacr(#3+#3+'F>'+#3+#0+'User Note  :'+#3+#9+note,abort,next);
   end;
   nl;
   searchopt.sslh:=fuku1; searchopt.ssll:=fuku2;
   cl(5);prompt('Option :'); cl(9);onek(c,'%X123456I$@HSWO*!JQSA[]#UBDKRNPELTVOCGFZ{}?'); c:=upcase(c);
   case c of
      '1': Begin
             Prompt('Enter # of message''s posted: '); input(ii,3); if ii<>'' then begin
             user.msgpost:=value(ii); save:=true; end;
           end;
      '2': Begin
             Prompt('Enter # of email sent: '); input(ii,3); if ii<>'' then begin
               user.emailsent:=value(ii); save:=true;
             end;
           End;
      '3': Begin
             Prompt('Enter # of feedback sent: '); input(ii,3); if ii<>'' then begin
               user.feedback:=value(ii); save:=true;
             end;
           End;
      '4': Begin
             Prompt('Enter # of mail waiting: '); input(ii,3); if ii<>'' then begin
               user.waiting:=value(ii); save:=true;
             end;
           End;
      '5': Begin
             Prompt('Enter # of logons: '); input(ii,3); if ii<>'' then begin
               user.loggedon:=value(ii); save:=true;
             end;
           End;
      '6': begin
             Prompt('Enter # of logons today: '); input(ii,3); if ii<>'' then begin
               user.ontoday:=value(ii); save:=true;
             end;
           End;
      '%': printfile(systat.gfilepath+'newuser.asw');
      'B': begin
             cl(3);prompt('Which board? '); onek(c,#13'ABCDEFG'); c:=upcase(c);
             if c in ['A'..'G'] then if c in user.ar then user.ar:=user.ar-[c]
               else user.ar:=user.ar+[c];
             if c in ['A'..'G'] then save:=true;
           end;
      'K': if so then begin nl;
        cl(3);prompt('Present record : ');
        cl(1);print('Uploads= '+cstr(user.uploads)+' for '+cstr(user.uk)+'k');
              print ('                  Dloads= '+cstr(user.downloads)+' for '+cstr(user.dk)+'k');
              nl; prt('Enter Uploads: '); mpl(4);input(ii,4);
              if ii <> '' then begin
                user.uploads := value(ii); ii:= '';
                prompt('How many Kbytes? '); mpl(6);input(ii,6);
                if ii <> '' then user.uk := value(ii);
                ii := ''; save:=true;
             end;
              nl; prt('Enter Downloads: '); mpl(4);input(ii,4);
              if ii <> '' then begin
                user.downloads := value(ii); ii:= '';
                prompt('How many Kbytes? '); mpl(6);input(ii,6);
                if ii <> '' then user.dk := value(ii);
                ii := ''; save:=true;
            end;
          end;
      'O': begin stopt; searchopt.sslh:=fuku1; searchopt.ssll:=fuku2; end;
      'F': begin prompt('Note: '); inputl(user.note,39); save:=true; end;
      'G': begin
             prompt('New age? '); input(ii,3); byt:=value(ii);
             if (byt>8) and (byt<100) then begin
               user.age:=byt; save:=true;
             end;
           end;
      'C':begin
             print('Enter new computer type');
             prt(':');mpl(14);inputl(ii,14); if ii<>'' then user.computer:=ii;
             c:=#0; save:=true;
           end;
      '}': search(1);
      '{': search(-1);
      'X': begin
             nl; print('Sex (M,F)? '); onek(user.sex,'MF');
             save:=true;
           end;
      'U': begin
             prompt('Enter user name, #, or partial search string: ');
             finduser(i); if i>0 then usern:=i;
           end;
      '[': begin
             usern:=usern-1; if usern=0 then usern:=filesize(uf)-1;
           end;
      ']': begin
             usern:=usern+1; if usern=filesize(uf) then usern:=1;
           end;
      'A': chhflags;
      '*': autoval;
      'S': chhsl;
      'T': chhdsl;
      'D': delusr;
      '#': begin
             print('Enter new amount of file points.');
             prompt(':'); input(ii,5); user.filepoints:=value(ii);
             save:=true;
           end;
      'R': if user.deleted then begin save:=true; isr(user.name,usern); user.deleted:=false; end;
      'N': renusr;
      'P': begin prompt('New phone number: '); input(ii,12); if ii<>'' then
             begin user.ph:=ii; save:=true; end;
           end;
      'E': begin prompt('New Real Name: '); inputl(ii,21); if ii<>'' then
             begin user.realname:=ii; save:=true; end;
           end;
      'L': begin
             if alert in user.option then
               user.option:=user.option-[alert] else
               user.option:=user.option+[alert];
             save:=true;
           end;
      '?': begin printhelp; pausescr; end;
      '$': begin PROMPT('Enter new password:');mpl(20);input(geepw,20);if geepw<>'' then user.pw:=geepw;save:=true;end;
      'V': begin chhsl;chhdsl;chhflags;end;
      '@': begin
             if user.lockedout then begin print('User is no longer locked out of system.'); pausescr; user.lockedout:=false;
             save:=true; end
             else begin print('User is now LOCKED out.'); user.lockedout:=true; save:=true; pausescr; end;
           end;
      '!': begin
             print('This file is printed when user attempts to log on when');
             print('locked out.  *.MSG automatically included.  This will be');
             print('found in your GFILES\ directory.');
             nl;
             prt('Enter locked file: '); mpl(8); input(ii,8); if ii<>'' then begin
               user.lockedfile:=ii;
               save:=true;
             end;
           end;
      'H': begin
             print('Enter new house address');
             prt(':');mpl(21);input(ii,21);if ii<>'' then begin
               user.street:=ii;
               save:=true;
             end;
           end;
      'Z': begin
             print('Enter new zip code (#####-####)');
             prt(':');mpl(10); input(ii,10);if ii<>'' then begin
               user.zipcode:=ii;
               save:=true;
             end;
           end;
      'I': begin
             print('Enter new occupation');
             prt(':');mpl(40);inputl(ii,40);if ii<>'' then begin
               user.occupation:=ii;
               save:=true;
             end;
            end;
      'J': begin
             print('Enter new city & state seperated by a comma');
             prt(':'); mpl(26);inputl(ii,26);if ii<>'' then begin
               user.citystate:=ii;
               save:=true;
             end;
           end;
      'W': begin
             print('Enter new BBS reference');
             prt(':');mpl(40);inputl(ii,40);if ii<>'' then begin
               user.wherebbs:=ii;
               save:=true;
             end;
           end;
   end;
   if save then begin seek(uf,usern); write(uf,user); if usern=usernum then thisuser:=user; end;
  until (c='Q') or hangup;
  close(uf);
end;

procedure voteprint;
var vdata:file of vdatar; vd:vdatar; vn:integer; t:text; i1,i2:integer; u:userrec;
    x:array[1..maxusers] of array[1..9] of integer;
    s1,s2:astr;

begin
  assign(t,systat.gfilepath+'votes.txt');
  rewrite(t);
  writeln(t); writeln(t,'Votes as of '+dat);
  reset(uf);
  print('Beginning output to file "VOTES.TXT"');
  i1:=1;
  while (i1<filesize(uf)) do begin
    seek(uf,i1); read(uf,u);
    for i2:=1 to 9 do
      x[i1][i2]:=u.vote[i2];
    i1:=i1+1;
  end;
  close(uf);
  assign(vdata,systat.gfilepath+'voting.dat');
  reset(vdata);
  for vn:=1 to 9 do begin
    seek(vdata,vn-1); read(vdata,vd);
    if vd.numa<>0 then begin
      writeln(t); writeln(t,vd.question);
      print(vd.question);
      for i1:=1 to vd.numa do begin
        writeln(t,'   '+vd.answ[i1].ans);
        for i2:=1 to systat.users do begin
          if x[srl[i2].number][vn]=i1 then begin
            writeln(t,'      '+srl[i2].name+' #'+cstr(srl[i2].number));
          end;
        end;
      end;
    end;
  end;
  close(t);
  close(vdata);
  print('Output complete.');
end;

procedure tedit;
var cur,nex,las,b4:strptr;
    top,bottom,used:strptr;
    tline,curline,c1,c2:integer;
    fil:text;
    abort,next,done,allread:boolean;
    i1,i2:astr;

procedure inli(var i:astr);
var cp,rp:integer; c,c1:char; cv,cc:integer;

  procedure bkspc;
  begin
    if cp>1 then begin
      if (i[cp-2]=#3) and (i[cp-1] in [#0..#9]) then begin
        cp:=cp-1;
        cl(1);
      end else
        if i[cp-1]=#8 then begin
          prompt(' ');
          rp:=rp+1;
        end else
          if i[cp-1]<>#10 then begin
            prompt(#8+' '+#8);
            rp:=rp-1;
          end;
      cp:=cp-1;
    end;
  end;

begin
  rp:=1; cp:=1;
  i:='';
  if ll<>'' then begin prompt(ll); i:=ll; ll:=''; cp:=length(i)+1; rp:=cp;end;
  repeat
    getkey(c);
    case ord(c) of
      32..255:if (cp<strlen) and (rp<thisuser.linelen) then begin
                i[cp]:=c; cp:=cp+1; rp:=rp+1; outkey(c); thisline:=thisline+c;
              end;
            2:dm(' -'+#14+'/'+#14+'l'+#14+'\'+#14,c);
           19:dm(' '+date,c);
            8:bkspc;
           24:begin
                cp:=1; for cv:=1 to rp-1 do prompt(#8+' '+#8);
                cl(1);
                rp:=1;
              end;
           23:if cp>1 then repeat
                bkspc;
              until (cp=1) or (i[cp]=' ') or ((i[cp]=chr(8)) and (i[cp-1]<>#3));
           14:if (not (rbackspace in thisuser.ac)) and (rp>1) and (cp<strlen) then begin
                prompt(chr(8)); i[cp]:=chr(8); cp:=cp+1; rp:=rp-1;
              end;
           10:if (not (rbackspace in thisuser.ac)) and (cp<strlen) then begin
                prompt(c); i[cp]:=c; cp:=cp+1;
              end;
           16:if okansi and (cp<strlen-1) then begin
                getkey(c1);
                if c1 in ['0'..'9'] then begin
                  i[cp]:=#3;
                  cp:=cp+1;
                  i[cp]:=chr(ord(c1)-ord('0'));
                  cp:=cp+1;
                  cl(ord(i[cp-1]));
                end;
              end;
            9:begin
                cv:=5-(cp mod 5); if (cp+cv<strlen) and (rp+cv<thisuser.linelen) then
                  for cc:=1 to cv do begin
                    rp:=rp+1; prompt(' ');
                    i[cp]:=' '; cp:=cp+1;
                  end;
              end;
  end;
  until (c=chr(13)) or ((rp=thisuser.linelen) and (wordwrap in thisuser.defaults)) or hangup;
  i[0]:=chr(cp-1);
  if c<>chr(13) then begin
    cv:=cp-1;
    while (cv>1) and (i[cv]<>' ') and ((i[cv]<>chr(8)) or (i[cv-1]=#3)) do
      cv:=cv-1;
    if (cv>(rp div 2)) and (cv<>cp-1) then begin
      ll:=copy(i,cv+1,cp-cv); for cc:=cp-2 downto cv do prompt(chr(8));
      for cc:=cp-2 downto cv do prompt(' ');
      i[0]:=chr(cv-1);
    end;
  end;
  nl;
  if c=chr(13) then i:=i+chr(1);
end;

  function newptr(var x:strptr):boolean;
  begin
    if used<>nil then begin
      x:=used;
      used:=used^.next;
      newptr:=true;
    end else begin
      if (maxavail<0) or (maxavail>100) then begin
        new(x);
        newptr:=true;
      end else newptr:=false;
    end;
  end;

  procedure oldptr(var x:strptr);
  begin
    x^.next:=used;
    used:=x;
  end;

  procedure pline(cl:integer; var cp:strptr; var abort:boolean);
  var next:boolean; i:astr;
  begin
    if not abort then begin
      if cp=nil then i:='      '+#3+#5+'['+#3+#3+'END'+#3+#5+']' else begin
        i:=cstr(cl);
        while length(i)<4 do i:=' '+i;
        i:=i+': '+cp^.i;
      end;
      printacr(i,abort,next);
    end;
  end;

  procedure pl;
  var abort:boolean;
  begin
    abort:=false;
    pline(curline,cur,abort);
  end;

begin
  nl; allread:=true;
  used:=nil;
  top:=nil;
  bottom:=nil;
  ix[2]:=systat.gfilepath+''+ix[2];
(*  if (pos('.MSG',ix[2])=0) and (pos('.TXT',ix[2])=0) then ix[2]:='';*)
  if ix[2]='' then print('Illegal filename.') else begin
    assign(fil,ix[2]); abort:=false;
    {$I-} reset(fil); {$I+}
    tline:=0;
    new(cur);
    cur^.last:=nil;
    cur^.i:='';
    if ioresult<>0 then begin
      {$I-} rewrite(fil); {$I+}
      if ioresult<>0 then begin
        print('Illegal filename.');
        abort:=true;
      end else begin
        close(fil); erase(fil);
        print('New file.');
        tline:=0;
        cur:=nil; top:=cur; bottom:=cur;
      end;
    end else begin
      abort:=not newptr(nex);
      top:=nex;
      print('Loading...');
      while (not eof(fil)) and (not abort) do begin
        tline:=tline+1;
        cur^.next:=nex;
        nex^.last:=cur;
        cur:=nex;
        readln(fil,i1);
        cur^.i:=i1;
        abort:=not newptr(nex);
      end;
      close(fil);
      cur^.next:=nil;
      if tline=0 then begin cur:=nil; top:=nil; end;
      bottom:=cur;
      if abort then begin print('Not all of file read.'); allread:=false; end;
      abort:=false;
    end;
    if not abort then begin
      print('Total lines: '+cstr(tline));
      cur:=top;
      if top<>nil then top^.last:=nil;
      curline:=1;
      done:=false;
      pl;
      repeat
        prompt(':');CL(3);
        input(i1,10);
        if i1='' then i1:='+';
        if value(i1)>0 then begin
          c1:=value(i1);
          if (c1>0) and (c1<=tline) then begin
            while c1<>curline do
              if c1<curline then begin
                if cur=nil then begin
                  cur:=bottom;
                  curline:=tline;
                end else begin
                  curline:=curline-1;
                  cur:=cur^.last;
                end;
              end else begin
                curline:=curline+1;
                cur:=cur^.next;
              end;
            pl;
          end;
        end else case i1[1] of
          '+':if cur<>nil then begin
                c1:=value(copy(i1,2,9));
                if c1=0 then c1:=1;
                while (cur<>nil) and (c1>0) do begin
                  cur:=cur^.next;
                  curline:=curline+1;
                  c1:=c1-1;
                end;
                pl;
              end;
          '?':begin
                cl(3);prompt('P');cl(1);prompt(':rint line      ');cl(3);prompt('L');cl(1);print(':ist');
                cl(3);prompt('-');cl(1);prompt(':back line      ');cl(3);prompt('+');cl(1);print(':forward line');
                cl(3);prompt('T');cl(1);prompt(':op             ');cl(3);prompt('B');cl(1);print(':ottom');
                cl(3);prompt('I');cl(1);prompt(':nsert lines    ');cl(3);prompt('D');cl(1);print(':elete line');
                cl(3);prompt('R');cl(1);prompt(':eplace line    ');cl(3);prompt('C');cl(1);print(':lear workspace');
                cl(3);prompt('Q');cl(1);prompt(':uit            ');cl(3);prompt('S');cl(1);print(':ave');
                cl(3);prompt('*');cl(1);print(':center line');
              end;
          '-':begin
                c1:=value(copy(i1,2,9));
                if c1=0 then c1:=1;
                if cur=nil then begin
                  cur:=bottom;
                  curline:=tline;
                  c1:=c1-1;
                end;
                if cur<>nil then
                  if cur^.last<>nil then begin
                    while (cur^.last<>nil) and (c1>0) do begin
                      cur:=cur^.last;
                      curline:=curline-1;
                      c1:=c1-1;
                    end;
                    pl;
                  end;
              end;
          'C':begin
                prompt('Clear workspace? ');
                if yn then begin
                  tline:=0; curline:=1;
                  cur:=nil; top:=nil; bottom:=nil;
                  release(topheap);
                end;
              end;
          'P':pl;
          'D':begin
                c1:=value(copy(i1,2,9));
                if c1=0 then c1:=1;
                while (cur<>nil) and (c1>0) do begin
                  las:=cur^.last;
                  nex:=cur^.next;
                  if las<>nil then las^.next:=nex;
                  if nex<>nil then nex^.last:=las;
                  oldptr(cur);
                  if bottom=cur then bottom:=las;
                  if top=cur then top:=nex;
                  cur:=nex;
                  tline:=tline-1;
                  c1:=c1-1;
                end;
                pl;
              end;
          'R':if cur<>nil then begin
                pl;
                i2:=cstr(curline); while length(i2)<>4 do i2:=' '+i2;
                i2:=i2+': '; prompt(i2);
                inli(i1);
                cur^.i:=i1;
              end;
          '*':if cur<>nil then cur^.i:=#2+cur^.i;
          'I':begin
                abort:=false; ll:='';NL;
                print('   Enter "." on a seperate line to exit insert mode.');
                print('        [ ^S : Sign Date  ^B : Spinning Cursor ]    ');
                if okansi then begin
                  cl(2);
                  print('   ═════════════════════════════════════════════════');
                end;
                i1:=''; thisuser.linelen:=thisuser.linelen-6;
                while (not hangup) and (not abort) and (i1<>'.') and (i1<>'.'+#1) do begin
                  i2:=cstr(curline); while length(i2)<>4 do i2:=' '+i2;
                  i2:=i2+': '; prompt(i2);
                  inli(i1);
                  if (i1<>'.') and (i1<>'.'+#1) then begin
                    abort:=not newptr(nex);
                    if not abort then begin
                      nex^.i:=i1;
                      if (top=cur) then
                        if cur=nil then begin
                          nex^.last:=nil;
                          nex^.next:=nil;
                          top:=nex;
                          bottom:=nex;
                        end else begin
                          nex^.next:=cur;
                          cur^.last:=nex;
                          top:=nex;
                        end
                      else begin
                        if cur=nil then begin
                          bottom^.next:=nex;
                          nex^.last:=bottom;
                          nex^.next:=nil;
                          bottom:=nex;
                        end else begin
                          las:=cur^.last;
                          nex^.last:=las;
                          nex^.next:=cur;
                          cur^.last:=nex;
                          las^.next:=nex;
                        end;
                      end;
                      curline:=curline+1;
                      tline:=tline+1;
                    end else print('No room left.');
                  end;
                end;
                thisuser.linelen:=thisuser.linelen+6;
              end;
          'T':begin
                cur:=top;
                curline:=1;
                pl;
              end;
          'B':begin
                cur:=nil;
                curline:=tline+1;
                pl;
              end;
          'L':begin
                abort:=false;
                nex:=cur;
                c1:=curline;
                while (not abort) and (nex<>nil) do begin
                  pline(c1,nex,abort);
                  nex:=nex^.next;
                  c1:=c1+1;
                end;
              end;
          'Q':done:=true;
          'S':begin
                if not allread then begin
                  prompt('Not all of file read.  Save anyway? ');
                  allread:=yn;
                end;
                if allread then begin
                  done:=true; c1:=0;
                  writeln('Saving...');
                  sysoplog('TEDIT: Saved "'+ix[2]+'"');
                  rewrite(fil);
                  cur:=top;
                  while cur<>nil do begin
                    writeln(fil,cur^.i);
                    cur:=cur^.next;
                    c1:=c1+1;
                  end;
                  if c1=0 then writeln(fil);
                  close(fil);
                end;
              end;
        end;
      until done or hangup;
    end;
  end;
  release(topheap);
end;

(*procedure ren;
begin
  fix(ix[2]); fix(ix[3]); abort:=false; nl;
  if (ix[2]='') or (ix[3]='') then begin abort:=true; print('Illegal filename.'); end;
  if not abort then begin
    assign(f,ix[2]); {$I-} reset(f); {$I+}
    if ioresult=0 then begin
      close(f); assign(f,ix[3]); {$I-} reset(f); {$I+}
      if ioresult<>0 then begin
        {$I-} rewrite(f); {$I+}
        if ioresult=0 then begin
          close(f); erase(f); assign(f,ix[2]); rename(f,ix[3]);
          print('Renamed.');
        end else print('Illegal filename.');
      end else begin close(f); print('Filename already in use.'); end;
    end else print('File not found.');
  end;
end;
*)
procedure copyfile(srcname,destname:astr);
var buffer: array[1..16384] of byte;
    dfs,nrec:integer;
    src, dest: file;

    procedure dodate;
    var r:registers; od,ot,ha:integer;
    begin
      srcname:=srcname+#0;
      destname:=destname+#0;
      with r do begin
        ax:=$3d00; ds:=seg(srcname[1]); dx:=ofs(srcname[1]); msdos(r);
        ha:=ax; bx:=ha; ax:=$5700; msdos(r);
        od:=dx; ot:=cx; bx:=ha; ax:=$3e00; msdos(r);
        ax:=$3d02; ds:=seg(destname[1]); dx:=ofs(destname[1]); msdos(r);
        ha:=ax; bx:=ha; ax:=$5701; cx:=ot; dx:=od; msdos(r);
        ax:=$3e00; bx:=ha; msdos(r);
      end;
    end;

begin
  assign(src,srcname); reset(src,1);
  if destname[2]=':' then dfs:=freek(ord(destname[1])-ord('@')) else dfs:=freek(0);
  if trunc(longfilesize(src)/1024.0)+1>=dfs then begin
    print('Disk full.');
    close(src);
  end else begin
    assign(dest,destname); rewrite(dest,1);
    nl; print('Copying...');
    repeat
      blockread(src,buffer,16384,nrec);
      blockwrite(dest,buffer,nrec);
    until nrec<16384;
    close(dest);
    close(src);
    dodate;
  end;
end;