home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / DOSP1.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-25  |  39KB  |  1,096 lines
  1. var
  2.   fuku1:byte;
  3.   fuku2:byte;
  4.  
  5. procedure uedit(usern:integer);
  6. var user,user1:userrec; c:char; r:restrictions; i,i1,x:integer; save:boolean; ii,is:astr; f:file;
  7.   mr:mailrec; byt:byte; zz:astr; abort,next:boolean; c1:integer; qq:integer;
  8.   searchopt:record
  9.               sslh,ssll:byte;             bsl:boolean;
  10.               sdslh,sdsll:byte;           bdsl:boolean;
  11.               scomp:byte;                 bcomp:boolean;
  12.               ssex:char;                  bsex:boolean;
  13.               sagel,sageh:byte;           bage:boolean;
  14.               sar:set of acrq;            bar:boolean;
  15.               slastonh,slastonl:integer;  blaston:boolean;
  16.             end;
  17.  
  18.   function filename(mrec:messages):astr;
  19.   begin
  20.     filename:=systat.msgpath+mrec.ltr+cstr(mrec.number)+'.'+cstr(mrec.ext);
  21.   end;
  22.  
  23.   procedure isr(uname:astr;usernum:integer);
  24.   var t,i,ii:integer; sr:smalrec;
  25.   begin
  26.    ii:=systat.users; i:=0;
  27.    while (ii-i)>1 do begin
  28.      t:=(ii+i) div 2;
  29.      if uname<srl[t].name then
  30.        ii:=t
  31.      else
  32.        i:=t;
  33.    end;
  34.    if srl[ii].name<uname then i:=ii;
  35.    for ii:=systat.users downto i+1 do
  36.      srl[ii+1]:=srl[ii];
  37.    sr.name:=uname; sr.number:=usernum;
  38.    srl[i+1]:=sr;
  39.    systat.users:=systat.users+1;
  40.    savesystat;
  41.    rewrite(sf); for ii:=0 to systat.users do write(sf,srl[ii]); close(sf);
  42.   end;
  43.  
  44.   procedure dsr(uname:astr);
  45.   var i,rn:integer; sr:smalrec;
  46.   begin
  47.     rn:=0;
  48.     for i:=1 to systat.users do
  49.       if srl[i].name=uname then
  50.         rn:=i;
  51.     if rn<>0 then begin
  52.       for i:=rn to systat.users-1 do srl[i]:=srl[i+1];
  53.       systat.users:=systat.users-1;
  54.       savesystat;
  55.       rewrite(sf); for i:=0 to systat.users do write(sf,srl[i]); close(sf);
  56.     end else sl1('*** Couldn''t delete "'+uname+'"');
  57.   end;
  58.  
  59.   procedure rsm;
  60.   var x:smr; i:integer;
  61.   begin
  62.     {$I-} reset(smf); {$I+}
  63.     if ioresult=0 then begin
  64.       i:=0; cl(1);
  65.       repeat
  66.         if i<=filesize(smf)-1 then begin seek(smf,i); read(smf,x); end;
  67.         while (i<filesize(smf)-1) and (x.destin<>usernum) do begin
  68.           i:=i+1; seek(smf,i); read(smf,x);
  69.         end;
  70.         if (x.destin=usernum) and (i<=filesize(smf)-1) then begin
  71.           print(x.msg);
  72.           seek(smf,i); x.destin:=-1; write(smf,x);
  73.           smread:=true;
  74.         end;
  75.         i:=i+1;
  76.       until (i>filesize(smf)-1) or hangup;
  77.       close(smf);
  78.       cl(1);
  79.     end;
  80.   end;
  81.  
  82.   procedure finduser(var usernum:integer);
  83.   var t,i,i1,gg:integer;
  84.       nn,duh:astr;
  85.   begin
  86.     input(nn,25);
  87.     usernum:=value(nn); if usernum>0 then begin
  88.       if usernum>filesize(uf)-1 then begin
  89.         print('Unknown User.');
  90.         usernum:=0; end
  91.       else begin
  92.         seek(uf,usernum);
  93.         read(uf,user);
  94.       end;
  95.     end else begin
  96.       for gg:=1 to systat.users do begin
  97.         if pos(nn,srl[gg].name)<>0 then begin
  98.           if srl[gg].name<>nn then begin
  99.           prompt('Incomplete match--> ');cl(3);prompt(srl[gg].name);nl;
  100.           prompt('Is this right? ');if yn then nn:=srl[gg].name;end;
  101.         end;
  102.       end;
  103.       i:=1; i1:=systat.users; t:=(i1+i) div 2;
  104.       while ((i1-i)>1) and (srl[t].name<>nn) do begin
  105.         if srl[t].name<nn then
  106.           i:=t
  107.         else
  108.           i1:=t;
  109.         t:=(i1+i) div 2;
  110.       end;
  111.       usernum:=0;
  112.       if srl[i].name=nn then usernum:=srl[i].number;
  113.       if srl[i1].name=nn then usernum:=srl[i1].number;
  114.       if srl[t].name=nn then usernum:=srl[t].number;
  115.       if usernum=0 then print('Unknown User.');
  116.      end;
  117.    end;
  118.  
  119.     procedure pcuropt;
  120.     var c:char;
  121.     begin
  122.       cls; nl; cl(5); print('Search Options');
  123.       nl;
  124.       prompt('1. Security level     : ');
  125.       if searchopt.bsl then
  126.         print(cstr(searchopt.ssll)+' to '+cstr(searchopt.sslh))
  127.       else
  128.         print('Inactive');
  129.       prompt('2. D/L Security level : ');
  130.       if searchopt.bdsl then
  131.         print(cstr(searchopt.sdsll)+' to '+cstr(searchopt.sdslh))
  132.       else
  133.         print('Inactive');
  134.       prompt('3. Sex                : ');
  135.       if searchopt.bsex then
  136.         if searchopt.ssex='M' then
  137.           print('Male')
  138.         else
  139.           print('Female')
  140.       else
  141.         print('Inactive');
  142.       prompt('4. Age                : ');
  143.       if searchopt.bage then
  144.         print(cstr(searchopt.sagel)+' to '+cstr(searchopt.sageh))
  145.       else
  146.         print('Inactive');
  147.       prompt('5. AR                 : ');
  148.       if searchopt.bar then begin
  149.         for c:='A' to 'G' do
  150.           if c in searchopt.sar then outkey(c) else outkey(' ');
  151.         nl;
  152.       end else
  153.         print('Inactive');
  154.       prompt('6. Last On            : ');
  155.       if searchopt.blaston then
  156.         print(cstr(searchopt.slastonl)+' days to '+cstr(searchopt.slastonh)+' days ago')
  157.       else
  158.         print('Inactive');
  159.       nl;
  160.     end;
  161.  
  162.   procedure stopt;
  163.   var n:integer; c,ch:char; done:boolean; i:astr;
  164.  
  165.     procedure chbyte(var x:byte);
  166.     var i:astr; n:integer;
  167.     begin
  168.       input(i,3); n:=x;
  169.       if i<>'' then n:=value(i);
  170.       if (n>=0) and (n<=255) then x:=n;
  171.     end;
  172.  
  173.     procedure chword(var x:integer);
  174.     var i:astr; n:integer;
  175.     begin
  176.       input(i,3); n:=x;
  177.       if i<>'' then n:=value(i);
  178.       if (n>=0) and (n<=32767) then x:=n;
  179.     end;
  180.  
  181.   begin
  182.     cls; done:=false; pcuropt;
  183.     repeat
  184.       prt('Change (?,Q) : ');
  185.       onek(ch,'Q?123456TL');
  186.       case ch of
  187.         'Q':done:=true;
  188.         '?':begin
  189.               nl;
  190.               print('Q:uit Options  ?:This Help');
  191.               print('L:ist Options  T:oggle options');
  192.               print('1-6: Change Option #');
  193.               nl;
  194.             end;
  195.         'L':pcuropt;
  196.         'T':begin
  197.               nl; prt('Which (1-6) ? '); onek(ch,#13'123456'); nl;
  198.               case ch of
  199.                 '1':searchopt.bsl:=not searchopt.bsl;
  200.                 '2':searchopt.bdsl:=not searchopt.bdsl;
  201.                 '3':searchopt.bsex:=not searchopt.bsex;
  202.                 '4':searchopt.bage:=not searchopt.bage;
  203.                 '5':searchopt.bar:=not searchopt.bar;
  204.                 '6':searchopt.blaston:=not searchopt.blaston;
  205.               end;
  206.               ch:=#0;
  207.             end;
  208.         '1':if searchopt.bsl then begin
  209.              nl; print('Security Level:');
  210.               prompt('Lower limit ('+cstr(searchopt.ssll)+') ? ');
  211.               chbyte(searchopt.ssll); fuku2:=searchopt.ssll;
  212.               prompt('Upper limit ('+cstr(searchopt.sslh)+') ? ');
  213.               chbyte(searchopt.sslh); fuku1:=searchopt.sslh;
  214.             end;
  215.         '2':if searchopt.bdsl then begin
  216.               nl; print('Download Security Level:');
  217.               prompt('Lower limit ('+cstr(searchopt.sdsll)+') ? ');
  218.               chbyte(searchopt.sdsll);
  219.               prompt('Lower limit ('+cstr(searchopt.sdslh)+') ? ');
  220.               chbyte(searchopt.sdslh);
  221.             end;
  222.         '3':if searchopt.bsex then begin
  223.               nl; prompt('Sex (M,F) ? '); onek(searchopt.ssex,'MF');
  224.             end;
  225.         '4':if searchopt.bage then begin
  226.               nl; print('Age:');
  227.               prompt('Lower limit ('+cstr(searchopt.sagel)+') ? ');
  228.               chbyte(searchopt.sagel);
  229.               prompt('Upper limit ('+cstr(searchopt.sageh)+') ? ');
  230.               chbyte(searchopt.sageh);
  231.             end;
  232.         '5':if searchopt.bar then begin
  233.               prompt('Which board? '); onek(c,#13'ABCDEFG'); c:=upcase(c);
  234.               if c in ['A'..'G'] then if c in searchopt.sar then
  235.                 searchopt.sar:=searchopt.sar-[c]
  236.               else
  237.                 searchopt.sar:=searchopt.sar+[c];
  238.             end;
  239.         '6':if searchopt.blaston then begin
  240.               nl; print('Limits of number of days since last logon:');
  241.               prompt('Lower limit ('+cstr(searchopt.slastonl)+') ? ');
  242.               chword(searchopt.slastonl);
  243.               prompt('Upper limit ('+cstr(searchopt.slastonh)+') ? ');
  244.               chword(searchopt.slastonh);
  245.             end;
  246.       end;
  247.     until done or hangup;
  248.   end;
  249.  
  250.   procedure delusr;
  251.   var vdata:file of vdatar; vd:vdatar; j:integer; i:integer;
  252.   begin
  253.     prompt('Delete? '); if yn and (not user.deleted) then begin
  254.       save:=true; user.deleted:=true; dsr(user.name);
  255.       i:=usernum; usernum:=usern; rsm; usernum:=i;
  256.       user.waiting:=0; reset(mailfile);
  257.       for i:=0 to filesize(mailfile)-1 do begin
  258.         seek(mailfile,i); read(mailfile,mr); i1:=0;
  259.         if (mr.destin=usern) or (abs(mr.from)=usern) then begin
  260.           if abs(mr.from)=usern then i1:=mr.destin;
  261.           assign(f,filename(mr.msg)); {$I-} erase(f); {$I+} x:=ioresult;
  262.           mr.destin:=-1; mr.from:=0; seek(mailfile,i); write(mailfile,mr);
  263.         end;
  264.         if (i1>0) and (i1<filesize(uf)) then begin
  265.           seek(uf,i1); read(uf,user1); user1.waiting:=user1.waiting-1;
  266.           seek(uf,i1); write(uf,user1); if i1=1 then fw:=fw-1;
  267.         end;
  268.       end;
  269.       close(mailfile);
  270.       assign(vdata,systat.gfilepath+'voting.dat');
  271.       reset(vdata);
  272.       for j:=1 to filesize(vdata) do
  273.         if user.vote[j]>0 then begin
  274.           seek(vdata,j-1); read(vdata,vd);
  275.           vd.answ[user.vote[j]].numres:=vd.answ[user.vote[j]].numres-1;
  276.           seek(vdata,j-1); write(vdata,vd);
  277.           user.vote[j]:=0;
  278.         end;
  279.       close(vdata);
  280.     end;
  281.   end;
  282.  
  283.   procedure renusr;
  284.   begin
  285.     if user.deleted then print('Can''t rename deleted users.') else begin
  286.       nl;prompt('Enter new name or <CR>: '); input(ii,25);
  287.       if (ii<>'') and (ii[1] in ['A'..'Z']) then begin
  288.         dsr(user.name); isr(ii,usern); user.name:=ii; save:=true;
  289.         if usern=usernum then thisuser.name:=ii;
  290.       end;
  291.     end;
  292.   end;
  293.  
  294.   procedure chhflags;
  295.   begin
  296.   save:=true;
  297.               print('LCVBA*PEKM');
  298.               nl;prompt('Which? ');onek(c,'LCVBA*PEKM'+#13); c:=upcase(c); print(c); nl;
  299.               if c<>#13 then acch(c,user); save:=true;
  300.            end;
  301.  
  302.   procedure autoval;
  303.   begin
  304.     user.sl:=systat.autosl; user.dsl:=systat.autodsl;
  305.     user.ac:=systat.autoac; user.ar:=systat.autoar; save:=true;
  306.     print('User Validated.'); pausescr;
  307.   end;
  308.  
  309.   procedure chhsl;
  310.   begin
  311.   prompt('Enter new SL: '); input(ii,4);
  312.       if ii<>'' then begin
  313.       byt:=value(ii); save:=true; if thisuser.sl>byt then user.sl:=byt;
  314.       if thisuser.sl<byt then sysoplog('Illegal SL change-Name:'+user.name+' to '+cstr(byt));
  315.       end;
  316.       if (user.sl=99) or (lcosysop in seclev[user.sl].anst) then begin
  317.       prompt('Which board #? '); input(ii,2);
  318.       if ii<>'' then user.sbn:=value(ii);
  319.       save:=true;
  320.        end;
  321.     end;
  322.  
  323.    procedure chhdsl;
  324.    begin
  325.    begin prompt('Enter new DSL: '); input(ii,4);
  326.       if ii<>'' then begin
  327.       byt:=value(ii); save:=true; if thisuser.sl>byt then user.dsl:=byt;
  328.       if thisuser.sl<byt then sysoplog('Illegal DSL change-Name:'+user.name+' to '+cstr(byt));
  329.       end;
  330.       end;
  331.    end;
  332.  
  333.   procedure printhelp;
  334.   begin
  335.     nl; cl(5); print('Extra Command Help');
  336.     nl;
  337.     print('[ - Up 1 Record    ] - Down 1 Record');
  338.     print('{ - Search up      } - Search down');
  339.     print('U - Find user      D - Delete user');
  340.     print('R - Restore user   V - Validate quick');
  341.     print('* - Autovalidate   O - Search Options');
  342.     print('% - NewInfoForm    @ - Lock out user');
  343.     nl;
  344.   end;
  345.  
  346.   procedure search(i:integer);
  347.   var n:integer; u:userrec;
  348.  
  349.     function okusr(n:integer):boolean;
  350.     var ok:boolean;
  351.     begin
  352.       seek(uf,n); read(uf,u); ok:=true;
  353.       with searchopt do begin
  354.         if bsl then
  355.           if (u.sl<ssll) or (u.sl>sslh) then ok:=false;
  356.         if bdsl then
  357.           if (u.dsl<sdsll) or (u.dsl>sdslh) then ok:=false;
  358.         if bcomp then
  359.           if u.comptype<>scomp then ok:=false;
  360.         if bsex then
  361.           if (ssex<>u.sex) and (u.sex<>' ') then ok:=false;
  362.         if bage then
  363.           if ((u.age<sagel) or (u.age>sageh)) and (u.age<>0) then ok:=false;
  364.         if bar then
  365.           if not (u.ar>=sar) then ok:=false;
  366.         if blaston then
  367.           if (daynum(u.laston)<daynum(date)-slastonh) or
  368.              (daynum(u.laston)>daynum(date)-slastonl) then ok:=false;
  369.       end;
  370.       okusr:=ok;
  371.     end;
  372.  
  373.   begin
  374.     nl;print('Searching...');
  375.     n:=usern;
  376.     repeat
  377.       usern:=usern+i;
  378.       if usern=0 then usern:=filesize(uf)-1;
  379.       if usern=filesize(uf) then usern:=1;
  380.     until okusr(usern) or (usern=n);
  381.   end;
  382.  
  383. var s,geepw:astr;
  384. begin
  385.  reset(uf);
  386.   with searchopt do begin
  387.     bsl:=false; bdsl:=false; bcomp:=false; bsex:=false; bage:=false; bar:=false; blaston:=false;
  388.     sslh:=255; ssll:=0; sdslh:=255; sdsll:=0; scomp:=1; ssex:='M';
  389.     sagel:=0; sageh:=255; sar:=[]; slastonh:=32767; slastonl:=0;
  390.     fuku1:=sslh; fuku2:=ssll;
  391.   end;
  392.   repeat
  393.    searchopt.sslh:=fuku1; searchopt.ssll:=fuku2;
  394.    seek(uf,usern); read(uf,user); save:=false;
  395.    if (usern=usernum) and useron then user:=thisuser;
  396.    cls; abort:=false;
  397.    with user do begin
  398.      abort:=false;
  399.      printacr(#3+#5+'Record #'+cstr(usern)+' of '+cstr(filesize(uf)),abort,next);
  400.      nl;
  401.      cl(1);
  402.      s:=#3+#3+'N>'+#3+#0+'User Name:'+#3+#9+mln(name,22)+' #'+mln(cstr(usern),3)+'  '+#3+#3+'D>'+#3+#0+'Status: ';
  403.      if deleted then s:=s+#3+#8+'Deleted' else begin
  404.        if lockedout then s:=s+#3+#8+'Locked out' else
  405.        s:=s+#3+#9+'Normal';
  406.      end;
  407.      printacr(s,abort,next);
  408.      printacr(#3+#3+'E>'+#3+#0+'Real Name:'+#3+#9+mln(realname,21)+
  409.      '        '+#3+#3+'S>'+#3+#0+'SL: '+#3+#9+mln(cstr(sl),3)+
  410.      ' '+#3+#3+'T>'+#3+#0+'DSL: '+#3+#9+cstr(dsl),abort,next);
  411.      printacr(#3+#3+'P>'+#3+#0+'Phone No.:'+#3+#9+ph+' '+
  412.      {+#3+#3+'G>'+#3+#0+'Age: '+#3+#9+mln(cstr(age),2)+}
  413.      '                '+#3+#3+'C>'+#3+#0+'Computer type:'+#3+#9+computer,abort,next);
  414.      s:=#3+#3+'$>'+#3+#0+'Password :'+#3+#9; if (realsl=255) or ((spd='KB') and (so))
  415.        then s:=s+mln(pw,20) else s:=s+'XXXXXXXXXXXXXXXXXXXX';
  416.      {s:=s+'     '+#3+#3+'X)'+#3+#0+'Sex: '+#3+#9;
  417.      if sex='M' then s:=s+'Male  ' else s:=s+'Female';}
  418.      s:=s+'         '+#3+#3+'B>'+#3+#0+'Board Access :'+#3+#9; for c:='A' to 'G' do
  419.      if c in ar then s:=s+c else s:=s+' ';
  420.      printacr(s,abort,next);
  421.     s:=#3+#3+'1>'+#3+#0+'Messages Posted:'+#3+#9+mln(cstr(msgpost),3)+' '+
  422.     #3+#3+'2>'+#3+#0+'Email Sent :'+#3+#9+mln(cstr(emailsent),3)+
  423.     '  '+#3+#3+'A>'+#3+#0+'AC Restricts :'+#3+#9; for r:=rlogon to rmsg do
  424.     if r in ac then s:=s+copy('LCVBA*PEKM',ORD(R)+1,1) else s:=s+' ';
  425.     printacr(s,abort,next);
  426.     printacr(#3+#3+'3>'+#3+#0+'Feedback Sent  :'+#3+#9+mln(cstr(feedback),3)+' '+#3+#3+'4>'+
  427.     #3+#0+'Mail in Box:'+#3+#9+mln(cstr(waiting),3)+
  428.     '  '+#3+#3+'#>'+#3+#0+'File points  : '+#3+#9+cstr(filepoints),abort,next);
  429.     printacr(#3+#3+'5>'+#3+#0+'# of logons    :'+#3+#9+mln(cstr(loggedon),3)+
  430.     ' '+#3+#3+'6>'+#3+#0+'Logon today:'+#3+#9+mln(cstr(ontoday),3)+
  431.     '  '+#3+#3+'!>'+#3+#0+'Lockout file : '+#3+#9+lockedfile+'.MSG',abort,next);
  432.     s:=#3+#3+'K>'+#3+#0+'Upload/Download:'+#3+#9+mln(cstr(uploads),3)+'-'+mln(cstr(uk),5)+' / '+
  433.     mln(cstr(downloads),3)+'-'+mln(cstr(dk),5)+'  '+#3+#3+'X>'+#3+#0+'Sex    : '+#3+#9;
  434.     if sex='M' then s:=s+'Male  ' else s:=s+'Female';
  435.     s:=s+#3+#3+'     G>'+#3+#0+'Age : '+#3+#9+cstr(age);
  436.     printacr(s,abort,next);
  437.     printacr(#3+#3+'J>'+#3+#0+'City, State:'+#3+#9+mln(citystate,26)+' '+#3+#3+'Z>'+#3+#0+'Zipcode: '+#3+#9+
  438.       mln(zipcode,10)+#3+#0+' Timeon: '+#3+#9+cstrr(ttimeon,10),abort,next);
  439.     s:=#3+#3+'M>'+#3+#0+'Street Addr:'+#3+#9+mln(street,21)+'      '+#3+#3+'L>'+#3+#0+'Alert  : '+#3+#9;
  440.     if alert in option then s:=s+'Yes' else s:=s+'No ';
  441.     s:=s+#3+#0+'        Mail  : '+#3+#9;
  442.     if (nomail in option) or (forusr<>0) then begin
  443.       if nomail in option then
  444.         s:=s+'Closed'
  445.       else
  446.         s:=s+'Forwarded';
  447.     end else s:=s+'Open';
  448.     printacr(s,abort,next);
  449.     printacr(#3+#3+'I>'+#3+#0+'Occupation :'+#3+#9+occupation,abort,next);
  450.     printacr(#3+#3+'W>'+#3+#0+'BBS refrnce:'+#3+#9+wherebbs,abort,next);
  451.     printacr(#3+#3+'F>'+#3+#0+'User Note  :'+#3+#9+note,abort,next);
  452.    end;
  453.    nl;
  454.    searchopt.sslh:=fuku1; searchopt.ssll:=fuku2;
  455.    cl(5);prompt('Option :'); cl(9);onek(c,'%X123456I$@HSWO*!JQSA[]#UBDKRNPELTVOCGFZ{}?'); c:=upcase(c);
  456.    case c of
  457.       '1': Begin
  458.              Prompt('Enter # of message''s posted: '); input(ii,3); if ii<>'' then begin
  459.              user.msgpost:=value(ii); save:=true; end;
  460.            end;
  461.       '2': Begin
  462.              Prompt('Enter # of email sent: '); input(ii,3); if ii<>'' then begin
  463.                user.emailsent:=value(ii); save:=true;
  464.              end;
  465.            End;
  466.       '3': Begin
  467.              Prompt('Enter # of feedback sent: '); input(ii,3); if ii<>'' then begin
  468.                user.feedback:=value(ii); save:=true;
  469.              end;
  470.            End;
  471.       '4': Begin
  472.              Prompt('Enter # of mail waiting: '); input(ii,3); if ii<>'' then begin
  473.                user.waiting:=value(ii); save:=true;
  474.              end;
  475.            End;
  476.       '5': Begin
  477.              Prompt('Enter # of logons: '); input(ii,3); if ii<>'' then begin
  478.                user.loggedon:=value(ii); save:=true;
  479.              end;
  480.            End;
  481.       '6': begin
  482.              Prompt('Enter # of logons today: '); input(ii,3); if ii<>'' then begin
  483.                user.ontoday:=value(ii); save:=true;
  484.              end;
  485.            End;
  486.       '%': printfile(systat.gfilepath+'newuser.asw');
  487.       'B': begin
  488.              cl(3);prompt('Which board? '); onek(c,#13'ABCDEFG'); c:=upcase(c);
  489.              if c in ['A'..'G'] then if c in user.ar then user.ar:=user.ar-[c]
  490.                else user.ar:=user.ar+[c];
  491.              if c in ['A'..'G'] then save:=true;
  492.            end;
  493.       'K': if so then begin nl;
  494.         cl(3);prompt('Present record : ');
  495.         cl(1);print('Uploads= '+cstr(user.uploads)+' for '+cstr(user.uk)+'k');
  496.               print ('                  Dloads= '+cstr(user.downloads)+' for '+cstr(user.dk)+'k');
  497.               nl; prt('Enter Uploads: '); mpl(4);input(ii,4);
  498.               if ii <> '' then begin
  499.                 user.uploads := value(ii); ii:= '';
  500.                 prompt('How many Kbytes? '); mpl(6);input(ii,6);
  501.                 if ii <> '' then user.uk := value(ii);
  502.                 ii := ''; save:=true;
  503.              end;
  504.               nl; prt('Enter Downloads: '); mpl(4);input(ii,4);
  505.               if ii <> '' then begin
  506.                 user.downloads := value(ii); ii:= '';
  507.                 prompt('How many Kbytes? '); mpl(6);input(ii,6);
  508.                 if ii <> '' then user.dk := value(ii);
  509.                 ii := ''; save:=true;
  510.             end;
  511.           end;
  512.       'O': begin stopt; searchopt.sslh:=fuku1; searchopt.ssll:=fuku2; end;
  513.       'F': begin prompt('Note: '); inputl(user.note,39); save:=true; end;
  514.       'G': begin
  515.              prompt('New age? '); input(ii,3); byt:=value(ii);
  516.              if (byt>8) and (byt<100) then begin
  517.                user.age:=byt; save:=true;
  518.              end;
  519.            end;
  520.       'C':begin
  521.              print('Enter new computer type');
  522.              prt(':');mpl(14);inputl(ii,14); if ii<>'' then user.computer:=ii;
  523.              c:=#0; save:=true;
  524.            end;
  525.       '}': search(1);
  526.       '{': search(-1);
  527.       'X': begin
  528.              nl; print('Sex (M,F)? '); onek(user.sex,'MF');
  529.              save:=true;
  530.            end;
  531.       'U': begin
  532.              prompt('Enter user name, #, or partial search string: ');
  533.              finduser(i); if i>0 then usern:=i;
  534.            end;
  535.       '[': begin
  536.              usern:=usern-1; if usern=0 then usern:=filesize(uf)-1;
  537.            end;
  538.       ']': begin
  539.              usern:=usern+1; if usern=filesize(uf) then usern:=1;
  540.            end;
  541.       'A': chhflags;
  542.       '*': autoval;
  543.       'S': chhsl;
  544.       'T': chhdsl;
  545.       'D': delusr;
  546.       '#': begin
  547.              print('Enter new amount of file points.');
  548.              prompt(':'); input(ii,5); user.filepoints:=value(ii);
  549.              save:=true;
  550.            end;
  551.       'R': if user.deleted then begin save:=true; isr(user.name,usern); user.deleted:=false; end;
  552.       'N': renusr;
  553.       'P': begin prompt('New phone number: '); input(ii,12); if ii<>'' then
  554.              begin user.ph:=ii; save:=true; end;
  555.            end;
  556.       'E': begin prompt('New Real Name: '); inputl(ii,21); if ii<>'' then
  557.              begin user.realname:=ii; save:=true; end;
  558.            end;
  559.       'L': begin
  560.              if alert in user.option then
  561.                user.option:=user.option-[alert] else
  562.                user.option:=user.option+[alert];
  563.              save:=true;
  564.            end;
  565.       '?': begin printhelp; pausescr; end;
  566.       '$': begin PROMPT('Enter new password:');mpl(20);input(geepw,20);if geepw<>'' then user.pw:=geepw;save:=true;end;
  567.       'V': begin chhsl;chhdsl;chhflags;end;
  568.       '@': begin
  569.              if user.lockedout then begin print('User is no longer locked out of system.'); pausescr; user.lockedout:=false;
  570.              save:=true; end
  571.              else begin print('User is now LOCKED out.'); user.lockedout:=true; save:=true; pausescr; end;
  572.            end;
  573.       '!': begin
  574.              print('This file is printed when user attempts to log on when');
  575.              print('locked out.  *.MSG automatically included.  This will be');
  576.              print('found in your GFILES\ directory.');
  577.              nl;
  578.              prt('Enter locked file: '); mpl(8); input(ii,8); if ii<>'' then begin
  579.                user.lockedfile:=ii;
  580.                save:=true;
  581.              end;
  582.            end;
  583.       'H': begin
  584.              print('Enter new house address');
  585.              prt(':');mpl(21);input(ii,21);if ii<>'' then begin
  586.                user.street:=ii;
  587.                save:=true;
  588.              end;
  589.            end;
  590.       'Z': begin
  591.              print('Enter new zip code (#####-####)');
  592.              prt(':');mpl(10); input(ii,10);if ii<>'' then begin
  593.                user.zipcode:=ii;
  594.                save:=true;
  595.              end;
  596.            end;
  597.       'I': begin
  598.              print('Enter new occupation');
  599.              prt(':');mpl(40);inputl(ii,40);if ii<>'' then begin
  600.                user.occupation:=ii;
  601.                save:=true;
  602.              end;
  603.             end;
  604.       'J': begin
  605.              print('Enter new city & state seperated by a comma');
  606.              prt(':'); mpl(26);inputl(ii,26);if ii<>'' then begin
  607.                user.citystate:=ii;
  608.                save:=true;
  609.              end;
  610.            end;
  611.       'W': begin
  612.              print('Enter new BBS reference');
  613.              prt(':');mpl(40);inputl(ii,40);if ii<>'' then begin
  614.                user.wherebbs:=ii;
  615.                save:=true;
  616.              end;
  617.            end;
  618.    end;
  619.    if save then begin seek(uf,usern); write(uf,user); if usern=usernum then thisuser:=user; end;
  620.   until (c='Q') or hangup;
  621.   close(uf);
  622. end;
  623.  
  624. procedure voteprint;
  625. var vdata:file of vdatar; vd:vdatar; vn:integer; t:text; i1,i2:integer; u:userrec;
  626.     x:array[1..maxusers] of array[1..9] of integer;
  627.     s1,s2:astr;
  628.  
  629. begin
  630.   assign(t,systat.gfilepath+'votes.txt');
  631.   rewrite(t);
  632.   writeln(t); writeln(t,'Votes as of '+dat);
  633.   reset(uf);
  634.   print('Beginning output to file "VOTES.TXT"');
  635.   i1:=1;
  636.   while (i1<filesize(uf)) do begin
  637.     seek(uf,i1); read(uf,u);
  638.     for i2:=1 to 9 do
  639.       x[i1][i2]:=u.vote[i2];
  640.     i1:=i1+1;
  641.   end;
  642.   close(uf);
  643.   assign(vdata,systat.gfilepath+'voting.dat');
  644.   reset(vdata);
  645.   for vn:=1 to 9 do begin
  646.     seek(vdata,vn-1); read(vdata,vd);
  647.     if vd.numa<>0 then begin
  648.       writeln(t); writeln(t,vd.question);
  649.       print(vd.question);
  650.       for i1:=1 to vd.numa do begin
  651.         writeln(t,'   '+vd.answ[i1].ans);
  652.         for i2:=1 to systat.users do begin
  653.           if x[srl[i2].number][vn]=i1 then begin
  654.             writeln(t,'      '+srl[i2].name+' #'+cstr(srl[i2].number));
  655.           end;
  656.         end;
  657.       end;
  658.     end;
  659.   end;
  660.   close(t);
  661.   close(vdata);
  662.   print('Output complete.');
  663. end;
  664.  
  665. procedure tedit;
  666. var cur,nex,las,b4:strptr;
  667.     top,bottom,used:strptr;
  668.     tline,curline,c1,c2:integer;
  669.     fil:text;
  670.     abort,next,done,allread:boolean;
  671.     i1,i2:astr;
  672.  
  673. procedure inli(var i:astr);
  674. var cp,rp:integer; c,c1:char; cv,cc:integer;
  675.  
  676.   procedure bkspc;
  677.   begin
  678.     if cp>1 then begin
  679.       if (i[cp-2]=#3) and (i[cp-1] in [#0..#9]) then begin
  680.         cp:=cp-1;
  681.         cl(1);
  682.       end else
  683.         if i[cp-1]=#8 then begin
  684.           prompt(' ');
  685.           rp:=rp+1;
  686.         end else
  687.           if i[cp-1]<>#10 then begin
  688.             prompt(#8+' '+#8);
  689.             rp:=rp-1;
  690.           end;
  691.       cp:=cp-1;
  692.     end;
  693.   end;
  694.  
  695. begin
  696.   rp:=1; cp:=1;
  697.   i:='';
  698.   if ll<>'' then begin prompt(ll); i:=ll; ll:=''; cp:=length(i)+1; rp:=cp;end;
  699.   repeat
  700.     getkey(c);
  701.     case ord(c) of
  702.       32..255:if (cp<strlen) and (rp<thisuser.linelen) then begin
  703.                 i[cp]:=c; cp:=cp+1; rp:=rp+1; outkey(c); thisline:=thisline+c;
  704.               end;
  705.             2:dm(' -'+#14+'/'+#14+'l'+#14+'\'+#14,c);
  706.            19:dm(' '+date,c);
  707.             8:bkspc;
  708.            24:begin
  709.                 cp:=1; for cv:=1 to rp-1 do prompt(#8+' '+#8);
  710.                 cl(1);
  711.                 rp:=1;
  712.               end;
  713.            23:if cp>1 then repeat
  714.                 bkspc;
  715.               until (cp=1) or (i[cp]=' ') or ((i[cp]=chr(8)) and (i[cp-1]<>#3));
  716.            14:if (not (rbackspace in thisuser.ac)) and (rp>1) and (cp<strlen) then begin
  717.                 prompt(chr(8)); i[cp]:=chr(8); cp:=cp+1; rp:=rp-1;
  718.               end;
  719.            10:if (not (rbackspace in thisuser.ac)) and (cp<strlen) then begin
  720.                 prompt(c); i[cp]:=c; cp:=cp+1;
  721.               end;
  722.            16:if okansi and (cp<strlen-1) then begin
  723.                 getkey(c1);
  724.                 if c1 in ['0'..'9'] then begin
  725.                   i[cp]:=#3;
  726.                   cp:=cp+1;
  727.                   i[cp]:=chr(ord(c1)-ord('0'));
  728.                   cp:=cp+1;
  729.                   cl(ord(i[cp-1]));
  730.                 end;
  731.               end;
  732.             9:begin
  733.                 cv:=5-(cp mod 5); if (cp+cv<strlen) and (rp+cv<thisuser.linelen) then
  734.                   for cc:=1 to cv do begin
  735.                     rp:=rp+1; prompt(' ');
  736.                     i[cp]:=' '; cp:=cp+1;
  737.                   end;
  738.               end;
  739.   end;
  740.   until (c=chr(13)) or ((rp=thisuser.linelen) and (wordwrap in thisuser.defaults)) or hangup;
  741.   i[0]:=chr(cp-1);
  742.   if c<>chr(13) then begin
  743.     cv:=cp-1;
  744.     while (cv>1) and (i[cv]<>' ') and ((i[cv]<>chr(8)) or (i[cv-1]=#3)) do
  745.       cv:=cv-1;
  746.     if (cv>(rp div 2)) and (cv<>cp-1) then begin
  747.       ll:=copy(i,cv+1,cp-cv); for cc:=cp-2 downto cv do prompt(chr(8));
  748.       for cc:=cp-2 downto cv do prompt(' ');
  749.       i[0]:=chr(cv-1);
  750.     end;
  751.   end;
  752.   nl;
  753.   if c=chr(13) then i:=i+chr(1);
  754. end;
  755.  
  756.   function newptr(var x:strptr):boolean;
  757.   begin
  758.     if used<>nil then begin
  759.       x:=used;
  760.       used:=used^.next;
  761.       newptr:=true;
  762.     end else begin
  763.       if (maxavail<0) or (maxavail>100) then begin
  764.         new(x);
  765.         newptr:=true;
  766.       end else newptr:=false;
  767.     end;
  768.   end;
  769.  
  770.   procedure oldptr(var x:strptr);
  771.   begin
  772.     x^.next:=used;
  773.     used:=x;
  774.   end;
  775.  
  776.   procedure pline(cl:integer; var cp:strptr; var abort:boolean);
  777.   var next:boolean; i:astr;
  778.   begin
  779.     if not abort then begin
  780.       if cp=nil then i:='      '+#3+#5+'['+#3+#3+'END'+#3+#5+']' else begin
  781.         i:=cstr(cl);
  782.         while length(i)<4 do i:=' '+i;
  783.         i:=i+': '+cp^.i;
  784.       end;
  785.       printacr(i,abort,next);
  786.     end;
  787.   end;
  788.  
  789.   procedure pl;
  790.   var abort:boolean;
  791.   begin
  792.     abort:=false;
  793.     pline(curline,cur,abort);
  794.   end;
  795.  
  796. begin
  797.   nl; allread:=true;
  798.   used:=nil;
  799.   top:=nil;
  800.   bottom:=nil;
  801.   ix[2]:=systat.gfilepath+''+ix[2];
  802. (*  if (pos('.MSG',ix[2])=0) and (pos('.TXT',ix[2])=0) then ix[2]:='';*)
  803.   if ix[2]='' then print('Illegal filename.') else begin
  804.     assign(fil,ix[2]); abort:=false;
  805.     {$I-} reset(fil); {$I+}
  806.     tline:=0;
  807.     new(cur);
  808.     cur^.last:=nil;
  809.     cur^.i:='';
  810.     if ioresult<>0 then begin
  811.       {$I-} rewrite(fil); {$I+}
  812.       if ioresult<>0 then begin
  813.         print('Illegal filename.');
  814.         abort:=true;
  815.       end else begin
  816.         close(fil); erase(fil);
  817.         print('New file.');
  818.         tline:=0;
  819.         cur:=nil; top:=cur; bottom:=cur;
  820.       end;
  821.     end else begin
  822.       abort:=not newptr(nex);
  823.       top:=nex;
  824.       print('Loading...');
  825.       while (not eof(fil)) and (not abort) do begin
  826.         tline:=tline+1;
  827.         cur^.next:=nex;
  828.         nex^.last:=cur;
  829.         cur:=nex;
  830.         readln(fil,i1);
  831.         cur^.i:=i1;
  832.         abort:=not newptr(nex);
  833.       end;
  834.       close(fil);
  835.       cur^.next:=nil;
  836.       if tline=0 then begin cur:=nil; top:=nil; end;
  837.       bottom:=cur;
  838.       if abort then begin print('Not all of file read.'); allread:=false; end;
  839.       abort:=false;
  840.     end;
  841.     if not abort then begin
  842.       print('Total lines: '+cstr(tline));
  843.       cur:=top;
  844.       if top<>nil then top^.last:=nil;
  845.       curline:=1;
  846.       done:=false;
  847.       pl;
  848.       repeat
  849.         prompt(':');CL(3);
  850.         input(i1,10);
  851.         if i1='' then i1:='+';
  852.         if value(i1)>0 then begin
  853.           c1:=value(i1);
  854.           if (c1>0) and (c1<=tline) then begin
  855.             while c1<>curline do
  856.               if c1<curline then begin
  857.                 if cur=nil then begin
  858.                   cur:=bottom;
  859.                   curline:=tline;
  860.                 end else begin
  861.                   curline:=curline-1;
  862.                   cur:=cur^.last;
  863.                 end;
  864.               end else begin
  865.                 curline:=curline+1;
  866.                 cur:=cur^.next;
  867.               end;
  868.             pl;
  869.           end;
  870.         end else case i1[1] of
  871.           '+':if cur<>nil then begin
  872.                 c1:=value(copy(i1,2,9));
  873.                 if c1=0 then c1:=1;
  874.                 while (cur<>nil) and (c1>0) do begin
  875.                   cur:=cur^.next;
  876.                   curline:=curline+1;
  877.                   c1:=c1-1;
  878.                 end;
  879.                 pl;
  880.               end;
  881.           '?':begin
  882.                 cl(3);prompt('P');cl(1);prompt(':rint line      ');cl(3);prompt('L');cl(1);print(':ist');
  883.                 cl(3);prompt('-');cl(1);prompt(':back line      ');cl(3);prompt('+');cl(1);print(':forward line');
  884.                 cl(3);prompt('T');cl(1);prompt(':op             ');cl(3);prompt('B');cl(1);print(':ottom');
  885.                 cl(3);prompt('I');cl(1);prompt(':nsert lines    ');cl(3);prompt('D');cl(1);print(':elete line');
  886.                 cl(3);prompt('R');cl(1);prompt(':eplace line    ');cl(3);prompt('C');cl(1);print(':lear workspace');
  887.                 cl(3);prompt('Q');cl(1);prompt(':uit            ');cl(3);prompt('S');cl(1);print(':ave');
  888.                 cl(3);prompt('*');cl(1);print(':center line');
  889.               end;
  890.           '-':begin
  891.                 c1:=value(copy(i1,2,9));
  892.                 if c1=0 then c1:=1;
  893.                 if cur=nil then begin
  894.                   cur:=bottom;
  895.                   curline:=tline;
  896.                   c1:=c1-1;
  897.                 end;
  898.                 if cur<>nil then
  899.                   if cur^.last<>nil then begin
  900.                     while (cur^.last<>nil) and (c1>0) do begin
  901.                       cur:=cur^.last;
  902.                       curline:=curline-1;
  903.                       c1:=c1-1;
  904.                     end;
  905.                     pl;
  906.                   end;
  907.               end;
  908.           'C':begin
  909.                 prompt('Clear workspace? ');
  910.                 if yn then begin
  911.                   tline:=0; curline:=1;
  912.                   cur:=nil; top:=nil; bottom:=nil;
  913.                   release(topheap);
  914.                 end;
  915.               end;
  916.           'P':pl;
  917.           'D':begin
  918.                 c1:=value(copy(i1,2,9));
  919.                 if c1=0 then c1:=1;
  920.                 while (cur<>nil) and (c1>0) do begin
  921.                   las:=cur^.last;
  922.                   nex:=cur^.next;
  923.                   if las<>nil then las^.next:=nex;
  924.                   if nex<>nil then nex^.last:=las;
  925.                   oldptr(cur);
  926.                   if bottom=cur then bottom:=las;
  927.                   if top=cur then top:=nex;
  928.                   cur:=nex;
  929.                   tline:=tline-1;
  930.                   c1:=c1-1;
  931.                 end;
  932.                 pl;
  933.               end;
  934.           'R':if cur<>nil then begin
  935.                 pl;
  936.                 i2:=cstr(curline); while length(i2)<>4 do i2:=' '+i2;
  937.                 i2:=i2+': '; prompt(i2);
  938.                 inli(i1);
  939.                 cur^.i:=i1;
  940.               end;
  941.           '*':if cur<>nil then cur^.i:=#2+cur^.i;
  942.           'I':begin
  943.                 abort:=false; ll:='';NL;
  944.                 print('   Enter "." on a seperate line to exit insert mode.');
  945.                 print('        [ ^S : Sign Date  ^B : Spinning Cursor ]    ');
  946.                 if okansi then begin
  947.                   cl(2);
  948.                   print('   ═════════════════════════════════════════════════');
  949.                 end;
  950.                 i1:=''; thisuser.linelen:=thisuser.linelen-6;
  951.                 while (not hangup) and (not abort) and (i1<>'.') and (i1<>'.'+#1) do begin
  952.                   i2:=cstr(curline); while length(i2)<>4 do i2:=' '+i2;
  953.                   i2:=i2+': '; prompt(i2);
  954.                   inli(i1);
  955.                   if (i1<>'.') and (i1<>'.'+#1) then begin
  956.                     abort:=not newptr(nex);
  957.                     if not abort then begin
  958.                       nex^.i:=i1;
  959.                       if (top=cur) then
  960.                         if cur=nil then begin
  961.                           nex^.last:=nil;
  962.                           nex^.next:=nil;
  963.                           top:=nex;
  964.                           bottom:=nex;
  965.                         end else begin
  966.                           nex^.next:=cur;
  967.                           cur^.last:=nex;
  968.                           top:=nex;
  969.                         end
  970.                       else begin
  971.                         if cur=nil then begin
  972.                           bottom^.next:=nex;
  973.                           nex^.last:=bottom;
  974.                           nex^.next:=nil;
  975.                           bottom:=nex;
  976.                         end else begin
  977.                           las:=cur^.last;
  978.                           nex^.last:=las;
  979.                           nex^.next:=cur;
  980.                           cur^.last:=nex;
  981.                           las^.next:=nex;
  982.                         end;
  983.                       end;
  984.                       curline:=curline+1;
  985.                       tline:=tline+1;
  986.                     end else print('No room left.');
  987.                   end;
  988.                 end;
  989.                 thisuser.linelen:=thisuser.linelen+6;
  990.               end;
  991.           'T':begin
  992.                 cur:=top;
  993.                 curline:=1;
  994.                 pl;
  995.               end;
  996.           'B':begin
  997.                 cur:=nil;
  998.                 curline:=tline+1;
  999.                 pl;
  1000.               end;
  1001.           'L':begin
  1002.                 abort:=false;
  1003.                 nex:=cur;
  1004.                 c1:=curline;
  1005.                 while (not abort) and (nex<>nil) do begin
  1006.                   pline(c1,nex,abort);
  1007.                   nex:=nex^.next;
  1008.                   c1:=c1+1;
  1009.                 end;
  1010.               end;
  1011.           'Q':done:=true;
  1012.           'S':begin
  1013.                 if not allread then begin
  1014.                   prompt('Not all of file read.  Save anyway? ');
  1015.                   allread:=yn;
  1016.                 end;
  1017.                 if allread then begin
  1018.                   done:=true; c1:=0;
  1019.                   writeln('Saving...');
  1020.                   sysoplog('TEDIT: Saved "'+ix[2]+'"');
  1021.                   rewrite(fil);
  1022.                   cur:=top;
  1023.                   while cur<>nil do begin
  1024.                     writeln(fil,cur^.i);
  1025.                     cur:=cur^.next;
  1026.                     c1:=c1+1;
  1027.                   end;
  1028.                   if c1=0 then writeln(fil);
  1029.                   close(fil);
  1030.                 end;
  1031.               end;
  1032.         end;
  1033.       until done or hangup;
  1034.     end;
  1035.   end;
  1036.   release(topheap);
  1037. end;
  1038.  
  1039. (*procedure ren;
  1040. begin
  1041.   fix(ix[2]); fix(ix[3]); abort:=false; nl;
  1042.   if (ix[2]='') or (ix[3]='') then begin abort:=true; print('Illegal filename.'); end;
  1043.   if not abort then begin
  1044.     assign(f,ix[2]); {$I-} reset(f); {$I+}
  1045.     if ioresult=0 then begin
  1046.       close(f); assign(f,ix[3]); {$I-} reset(f); {$I+}
  1047.       if ioresult<>0 then begin
  1048.         {$I-} rewrite(f); {$I+}
  1049.         if ioresult=0 then begin
  1050.           close(f); erase(f); assign(f,ix[2]); rename(f,ix[3]);
  1051.           print('Renamed.');
  1052.         end else print('Illegal filename.');
  1053.       end else begin close(f); print('Filename already in use.'); end;
  1054.     end else print('File not found.');
  1055.   end;
  1056. end;
  1057. *)
  1058. procedure copyfile(srcname,destname:astr);
  1059. var buffer: array[1..16384] of byte;
  1060.     dfs,nrec:integer;
  1061.     src, dest: file;
  1062.  
  1063.     procedure dodate;
  1064.     var r:registers; od,ot,ha:integer;
  1065.     begin
  1066.       srcname:=srcname+#0;
  1067.       destname:=destname+#0;
  1068.       with r do begin
  1069.         ax:=$3d00; ds:=seg(srcname[1]); dx:=ofs(srcname[1]); msdos(r);
  1070.         ha:=ax; bx:=ha; ax:=$5700; msdos(r);
  1071.         od:=dx; ot:=cx; bx:=ha; ax:=$3e00; msdos(r);
  1072.         ax:=$3d02; ds:=seg(destname[1]); dx:=ofs(destname[1]); msdos(r);
  1073.         ha:=ax; bx:=ha; ax:=$5701; cx:=ot; dx:=od; msdos(r);
  1074.         ax:=$3e00; bx:=ha; msdos(r);
  1075.       end;
  1076.     end;
  1077.  
  1078. begin
  1079.   assign(src,srcname); reset(src,1);
  1080.   if destname[2]=':' then dfs:=freek(ord(destname[1])-ord('@')) else dfs:=freek(0);
  1081.   if trunc(longfilesize(src)/1024.0)+1>=dfs then begin
  1082.     print('Disk full.');
  1083.     close(src);
  1084.   end else begin
  1085.     assign(dest,destname); rewrite(dest,1);
  1086.     nl; print('Copying...');
  1087.     repeat
  1088.       blockread(src,buffer,16384,nrec);
  1089.       blockwrite(dest,buffer,nrec);
  1090.     until nrec<16384;
  1091.     close(dest);
  1092.     close(src);
  1093.     dodate;
  1094.   end;
  1095. end;
  1096.