home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Complete Applications / Telecom / MT Special 3 / IBM WWIV / PART3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-14  |  22.9 KB  |  640 lines  |  [TEXT/ttxt]
  1.  
  2. overlay procedure pstat;
  3. var c:char;
  4. begin
  5.   outkey(chr(12));
  6.   with systat do begin
  7.     print('New User Pass   : '+boardpw);
  8.     prompt('Board is        : '); if closedsystem then print('Closed') else print('Open');
  9.     print('Number Users    : '+cstr(users));
  10.     print('Number calls    : '+cstr(callernum));
  11.     print('Date            : '+lastdate);
  12.     print('Active today    : '+cstr(activetoday));
  13.     print('Calls today     : '+cstr(callstoday));
  14.     print('M posted today  : '+cstr(msgposttoday));
  15.     print('E sent today    : '+cstr(emailtoday));
  16.     print('F sent today    : '+cstr(fbacktoday));
  17.     print('U today         : '+cstr(uptoday));
  18.     prompt('Sysop           : '); if sysop then print('Available')
  19.       else print('NOT Available');
  20.     print('F waiting       : '+cstr(fw));
  21.   end;
  22.   nl;nl;print('Hit any key');
  23.   getkey(c);
  24. end;
  25.  
  26.  
  27. overlay procedure uedit(usern:integer);
  28. var user,user1:userrec; c:char; r:restrictions; i,i1,x:integer; save:boolean; ii,is:str; f:file;
  29.   mr:mailrec;
  30. begin
  31.   reset(uf);
  32.   repeat
  33.    seek(uf,usern); read(uf,user); save:=false;
  34.    if (usern=usernum) and useron then user:=thisuser;
  35.    with user do begin
  36.     cls;
  37.     prompt('Name         : '+name+' #'+cstr(usern));
  38.     if deleted then print('  XXXXXXXXXXXXXXX') else nl;
  39.     print('Real name    : '+realname);
  40.     print('Phone number : '+ph);
  41.     writeln('Password     : '+pw);
  42.     print('Last on      : '+laston);
  43.     print('Messages     : P='+cstr(msgpost)+' E='+cstr(emailsent)+' F='+
  44.       cstr(feedback)+' W='+cstr(waiting));
  45.     prompt('Logged on    : '+cstr(loggedon)); if laston=date then
  46.       prompt('  '+cstr(ontoday)) else prompt('  0');
  47.     print('  I'+cstr(illegal));
  48.     print('Sec Lev      : '+cstr(sl));
  49.     if sl=99 then print('SBN          : '+cstr(sbn));
  50.     print('Computer type: '+comptyp[comptype]);
  51.     print('DL Sec Lev   : '+cstr(dsl)+' - '+cstr(uploads)+'-'+cstr(uk)+
  52.       ' / '+cstr(downloads)+'-'+cstr(dk));
  53.     prompt('Restrictions : ');
  54.     for r:=rlogon to rmsg do
  55.       if r in ac then prompt(copy('LCVBA*PEKM',ORD(R)+1,1)) else prompt(' '); nl;
  56.     prompt('Board access : ');
  57.     for c:='A' to 'G' do
  58.       if c in ar then outkey(c) else outkey(' '); nl; nl;
  59.     if nomail in option then print('Mailbox closed.');
  60.     if alert in option then print('Alert set.');
  61.    end;
  62.    prompt('Option :'); onek(c,'QSA[]UBDRNPELT?'); c:=upcase(c);
  63.    case c of
  64.       'B': begin
  65.              prompt('Which board? '); onek(c,'ABCDEFG'); c:=upcase(c);
  66.              if c in ['A'..'G'] then if c in user.ar then user.ar:=user.ar-[c]
  67.                else user.ar:=user.ar+[c];
  68.              if c in ['A'..'G'] then save:=true;
  69.            end;
  70.       'U': begin
  71.              close(uf); prompt('Enter user: ');
  72.              finduser(i); if i>0 then usern:=i; reset(uf);
  73.            end;
  74.       '[': begin
  75.              usern:=usern-1; if usern=0 then usern:=filesize(uf)-1;
  76.            end;
  77.       ']': begin
  78.              usern:=usern+1; if usern=filesize(uf) then usern:=1;
  79.            end;
  80.       'A': begin save:=true;
  81.               print('LCVBA*PEKM');
  82.               nl;prompt('Which? ');; onek(c,'LCVBA*PEKM'+#13); c:=upcase(c); print(c); nl;
  83.               if c<>#13 then acch(c,user); save:=true;
  84.            end;
  85.       'S': begin prompt('Enter new SL: '); input(ii,4);
  86.                  if ii<>'' then begin
  87.                    i:=value(ii); save:=true; if i<>255 then user.sl:=i;
  88.                    if user.sl=99 then begin
  89.                      prompt('Which board #? '); input(ii,2);
  90.                      user.sbn:=value(ii); save:=true;
  91.                    end;
  92.                  end;
  93.            end;
  94.       'T': begin prompt('Enter new DSL: '); input(ii,4);
  95.                  if ii<>'' then user.dsl:=value(ii); save:=true;
  96.            end;
  97.       'D': begin prompt('Delete? '); if yn and (not user.deleted) then begin
  98.              save:=true; user.deleted:=true; dsr(user.name);
  99.              i:=usernum; usernum:=usern; rsm; usernum:=i;
  100.              begin
  101.                user.waiting:=0; reset(mailfile); for i:=0 to filesize(mailfile)-1 do begin
  102.                  seek(mailfile,i); read(mailfile,mr); i1:=0;
  103.                  if (mr.destin=usern) or (abs(mr.from)=usern) then begin
  104.                    if abs(mr.from)=usern then i1:=mr.destin;
  105.                    assign(f,filename(mr.msg)); {$I-} erase(f); {$I+} x:=ioresult;
  106.                    mr.destin:=-1; mr.from:=0; seek(mailfile,i); write(mailfile,mr);
  107.                  end;
  108.                  if (i1>0) and (i1<filesize(uf)) then begin
  109.                    seek(uf,i1); read(uf,user1); user1.waiting:=user1.waiting-1;
  110.                    seek(uf,i1); write(uf,user1); if i1=1 then fw:=fw-1;
  111.                  end;
  112.                end;
  113.              end;
  114.            end;end;
  115.       'R': if user.deleted then begin save:=true; isr(user.name,usern); user.deleted:=false; end;
  116.       'N': if user.deleted then print('Can''t rename deleted users.') else
  117.            begin nl;prompt('Enter new name or <CR>: '); input(ii,25);
  118.              if ii<>'' then begin
  119.                dsr(user.name); isr(ii,usern); user.name:=ii; save:=true;
  120.                if usern=usernum then thisuser.name:=ii;
  121.              end;
  122.            end;
  123.       'P': begin prompt('New phone number: '); input(ii,12); if ii<>'' then
  124.              begin user.ph:=ii; save:=true; end;
  125.            end;
  126.       'E': begin prompt('New Real Name: '); inputl(ii,14); if ii<>'' then
  127.              begin user.realname:=ii; save:=true; end;
  128.            end;
  129.       'L': begin
  130.              if alert in user.option then
  131.                user.option:=user.option-[alert] else
  132.                user.option:=user.option+[alert];
  133.              save:=true;
  134.            end;
  135.       '?': begin
  136.             print('S - change seclev    A - change access');
  137.             print('[ - down one user    ] - up one user');
  138.             print('U - go to user       B - board access');
  139.             print('D - delete user      R - restore user');
  140.             print('N - change name      P - change phone number');
  141.             print('E - change real name Q - quit');
  142.             print('L - aLert for user   T - Transfer SL');
  143.             prompt('(-*-)'); getkey(c); skey(c);
  144.           end;
  145.   end;
  146.   if save then begin seek(uf,usern); write(uf,user); if usern=usernum then thisuser:=user; end;
  147.   until (c='Q') or hangup;
  148.   close(uf);
  149. end;
  150.  
  151. overlay procedure initvotes;
  152. var vdata:file of vdatar; cv,tv,ii:integer; i,i1,i2:str; vd:vdatar; t1,tf:boolean;
  153.     u1:userrec;
  154. begin
  155.   begin
  156.     assign(vdata,'gfiles\voting.dat'); {$I-} reset(vdata); {$I+}
  157.     if ioresult<>0 then begin
  158.       rewrite(vdata); vd.question:='<< NO QUESTION >>'; vd.numa:=0;
  159.       for cv:=0 to 8 do write(vdata,vd);
  160.     end;
  161.     repeat
  162.       cls;
  163.       for cv:=1 to 9 do begin
  164.         seek(vdata,cv-1); read(vdata,vd);
  165.         print(cstr(cv)+': '+vd.question);
  166.       end;
  167.       prompt('Which? '); input(i,2);
  168.       ii:=value(i); t1:=false;
  169.       if (ii>0) and (ii<10) then begin
  170.         cv:=1; t1:=true;
  171.         print('Enter new question:'); prompt(':');
  172.         inputl(vd.question,79);
  173.         if vd.question='' then begin vd.numa:=0; vd.question:='<< NO QUESTION >>';
  174.         end else begin
  175.           vd.answ[0].ans:='No Comment';
  176.           vd.answ[0].numres:=0;
  177.           nl; print('Enter blank line for last answer,');
  178.           print('max 9 answers, 25 chars/answer');
  179.           tf:=false;
  180.           repeat
  181.             prompt(cstr(cv)+':'); inputl(vd.answ[cv].ans,25); vd.answ[cv].numres:=0;
  182.             if vd.answ[cv].ans='' then begin
  183.               tf:=true;
  184.               if cv=1 then vd.question:='<< NO QUESTION >>'
  185.             end else cv:=cv+1;
  186.           until hangup or (cv=10) or tf;
  187.           vd.numa:=cv-1;
  188.         end;
  189.         seek(vdata,ii-1); write(vdata,vd);
  190.         vqu[ii]:= vd.numa<>0;
  191.         reset(uf); for cv:=1 to filesize(uf)-1 do begin
  192.           seek(uf,cv); read(uf,u1); u1.vote[ii]:=0; seek(uf,cv); write(uf,u1);
  193.         end;
  194.         close(uf);
  195.         thisuser.vote[ii]:=0;
  196.       end;
  197.     until not t1;
  198.     close(vdata);
  199.   end;
  200. end;
  201.  
  202. overlay procedure boardedit;
  203. var i1,i2,ii:integer; c:char; ij:str;
  204. begin
  205.  prompt('PW? '); echo:=false; input(ij,8); echo:=true;
  206.  if ij=systat.sysoppw then
  207.  repeat
  208.   cls;
  209.   print('NN K Name                      Filename     SL  MaxM Password   AR An');
  210.   print('-- = ------------------------- ============ --- ==== ---------- == --');
  211.   for ii:=1 to numboards do with boards[ii] do begin
  212.     prompt(mn(ii,2)+' '+key+' '+mln(name,25)+' '+mln(filename,12)+' '+mn(sl,3)+' ');
  213.     prompt(mn(maxmsgs,3)+'  '+mln(pw,10)+' '); if ar='@' then prompt('   ') else prompt(ar+'  ');
  214.     case anonymous of
  215.       yes:print('Y');
  216.       no:print('N');
  217.       forced:print('F');
  218.       dearabby:print('DA');
  219.     end;
  220.   end;
  221.   nl; prompt('D)elete, I)nsert, M)odify, Q)uit  :'); onek(c,'QDIM');
  222.   case c of
  223.     'D': begin
  224.            prompt('Board number to delete? '); inu(ii);
  225.            if (ii>0) and (ii<=numboards) then begin
  226.              prompt(boards[ii].name+'   Delete it? ');
  227.              if yn then begin
  228.                numboards:=numboards-1; for i1:=ii to numboards do
  229.                  boards[i1]:=boards[i1+1];
  230.                rewrite(bf); for i1:=1 to numboards do write(bf,boards[i1]);
  231.                close(bf); reset(uf); for i1:=1 to filesize(uf)-1 do begin
  232.                  seek(uf,i1);read(uf,user); for i2:=ii to numboards do begin
  233.                    user.qscn[i2]:=user.qscn[i2+1]; user.qscan[i2]:=user.qscan[i2+1];
  234.                  end;
  235.                  seek(uf,i1); write(uf,user);
  236.                end; close(uf);
  237.              end;
  238.            end;
  239.          end;
  240.     'M': begin
  241.            prompt('Board number to edit? '); inu(ii);
  242.            if (ii>0) and (ii<=numboards) then begin with boards[ii] do
  243.            repeat
  244.              cls;
  245.              print('   Board      : '+cstr(ii));
  246.              print('1. Name       : '+name);
  247.              print('2. Filename   : '+filename);
  248.              print('3. Key        : '+key);
  249.              print('4. SL         : '+cstr(sl));
  250.              print('5. AR         : '+ar);
  251.              print('6. Password   : "'+pw+'"');
  252.              print('7. Max Mess   : '+cstr(maxmsgs));
  253.              prompt('8. Anonymous  : '); case anonymous of
  254.                yes:print('Yes');
  255.                no:print('No');
  256.                forced:print('Force');
  257.                dearabby:print('Dear abby');
  258.              end;
  259.              nl; prompt('Which? '); onek(c,'12345678Q');
  260.              case c of
  261.                '1':begin prompt('New name? '); inputl(name,25); end;
  262.                '2':begin prompt('New filename? '); input(filename,12); end;
  263.                '3':begin prompt('New key? '); getkey(c); key:=c; nl;
  264.                          if not (key in ['"','#','%','&','(',')','+',',','-',
  265.                             '.',':',';','<','=','>']) then key:=' '; end;
  266.                '4':begin prompt('New SL? '); ini(sl); end;
  267.                '5':begin prompt('New AR? '); getkey(c); ar:=upcase(c);
  268.                      if (ar<'A') or (ar>'G') then ar:='@'; nl; end;
  269.                '6':begin prompt('New PW? '); input(pw,10); end;
  270.                '7':begin prompt('Max messages? '); ini(maxmsgs); end;
  271.                '8':begin prompt('New ANST (Y,N,F,D) ? '); onek(c,'YNFD');
  272.                      case c of
  273.                        'Y':anonymous:=yes;
  274.                        'N':anonymous:=no;
  275.                        'F':anonymous:=forced;
  276.                        'D':anonymous:=dearabby;
  277.                      end;
  278.                    end;
  279.              end;
  280.            until (c='Q') or hangup;
  281.            reset(bf); seek(bf,ii-1); write(bf,boards[ii]); close(bf); c:=' ';
  282.           end;
  283.          end;
  284.     'I': begin
  285.            prompt('Board number to insert before? '); inu(ii);
  286.            if (ii>0) and (ii<=numboards+1) and (numboards<19) then begin
  287.              numboards:=numboards+1; for i1:=numboards downto ii do
  288.                boards[i1]:=boards[i1-1];
  289.              with boards[ii] do begin
  290.                name:='NEW BOARD';
  291.                filename:='newboard';
  292.                sl:=30;
  293.                maxmsgs:=50;
  294.                pw:='';
  295.                anonymous:=no;
  296.                ar:='@';
  297.                key:=' ';
  298.              end;
  299.              rewrite(bf); for i1:=1 to numboards do write(bf,boards[i1]);
  300.              close(bf); reset(uf); for i1:=1 to filesize(uf)-1 do begin
  301.                seek(uf,i1);read(uf,user); for i2:=numboards downto ii do begin
  302.                  user.qscn[i2]:=user.qscn[i2-1]; user.qscan[i2]:=user.qscan[i2-1];
  303.                end;
  304.                user.qscan[ii].number:=-32767; user.qscan[ii].ltr:='A'; user.qscn[ii]:=true;
  305.                seek(uf,i1); write(uf,user);
  306.              end; close(uf);
  307.            end;
  308.          end;
  309.   end;
  310.  until (c='Q') or hangup;
  311. end;
  312.  
  313. overlay procedure mailr;
  314. var ii:integer; mr:mailrec; abort,a:boolean; c:char; u:userrec; is:str;
  315. begin
  316.   {$I-} reset(mailfile); {$I+} c:=' ';
  317.   if ioresult=0 then begin
  318.     reset(uf);
  319.     ii:=filesize(mailfile)-1; c:=' ';
  320.     while (ii>=0) and (c<>'Q') do begin
  321.       seek(mailfile,ii); read(mailfile,mr);
  322.       if mr.destin<>-1 then begin
  323.         repeat
  324.           seek(uf,mr.destin); read(uf,u);
  325.           print('To '+u.name+' #'+cstr(mr.destin)); a:=true;
  326.           print('Title: '+mr.title);
  327.           readmsg(mr.msg,a,next);
  328.           prompt('R,D,Q,<space>  : ');
  329.           if next then c:=' ' else getkey(c); c:=upcase(c); print(c);
  330.           if c='D' then begin
  331.             close(uf); is:=rmail(ii); reset(uf);
  332.             if usernum=mr.destin then thisuser.waiting:=thisuser.waiting-1;
  333.           end;
  334.           nl;nl;
  335.         until (c<>'R');
  336.       end;
  337.       ii:=ii-1;
  338.     end;
  339.     close(mailfile);
  340.     close(uf);
  341.   end;
  342. end;
  343.  
  344. overlay procedure changestuff;
  345. var i,i1:str; c:char; b1,b2:boolean;
  346.  
  347.   procedure po;
  348.   begin
  349.     clrscr;
  350.     writeln('A. Sysop Password    : "'+systat.sysoppw+'"');
  351.     writeln('B. New User Password : "'+systat.boardpw+'"');
  352.     write('C. System            : ');
  353.       if systat.closedsystem then writeln('Closed') else writeln('Open');
  354.     writeln; writeln; writeln; writeln;
  355.   end;
  356.  
  357. begin
  358.   write('PW? '); input(i,8);
  359.   if i=systat.sysoppw then begin cls;
  360.     po;
  361.     repeat
  362.       b1:=false;
  363.       repeat
  364.         gotoxy(1,8);
  365.         write('Which (A-C,Q=Quit) ? ');
  366.         clreol;
  367.         read(kbd,c);
  368.         c:=upcase(c);
  369.       until c in ['A'..'C','Q'];
  370.       case c of
  371.         'Q':b1:=true;
  372.         'B':begin
  373.               writeln;
  374.               write('New NewUser Password : ');
  375.               input(i,8);
  376.               writeln;
  377.               writeln('NewUser Password: "'+i+'"');
  378.               writeln;
  379.               write('Is this what you want? ');
  380.               if yn then systat.boardpw:=i;
  381.               po;
  382.             end;
  383.         'A':begin
  384.               writeln;
  385.               write('New Sysop Password : ');
  386.               input(i,8);
  387.               writeln;
  388.               writeln('Sysop Password: "'+i+'"');
  389.               writeln;
  390.               write('Is this what you want? ');
  391.               if yn then systat.sysoppw:=i;
  392.               po;
  393.             end;
  394.         'C':begin
  395.               writeln;
  396.               write('Do you want the system closed? ');
  397.               b2:=yn;
  398.               writeln;
  399.               write('System: '); if b2 then writeln('Closed') else writeln('Open');
  400.               writeln;
  401.               write('Is this what you want? ');
  402.               if yn then systat.closedsystem:=b2;
  403.               po;
  404.             end;
  405.       end;
  406.     until b1;
  407.   end;
  408. end;
  409.  
  410. overlay procedure dlboardedit;
  411. var ulf:file of ulrec;
  412.     uboards:array[0..19] of ulrec;
  413.     i1,ii,culb,maxulb:integer;
  414.     c:char; done:boolean;
  415.     ij:str;
  416. begin
  417.  assign(ulf,'gfiles\uploads.dat');
  418.  reset(ulf); maxulb:=-1;
  419.  while not eof(ulf) do begin maxulb:=maxulb+1; read(ulf,uboards[maxulb]); end;
  420.  close(ulf);
  421.  prompt('PW? '); echo:=false; input(ij,8); echo:=true;
  422.  if ij=systat.sysoppw then
  423.  repeat
  424.   cls; done:=false;
  425.   print('NN Board Name                Filename     DSL MaxF  Password');
  426.   print('-- ========================= ------------ === ----  ========');
  427.   for ii:=0 to maxulb do with uboards[ii] do
  428.     print(mn(ii,2)+' '+mln(name,25)+' '+mln(filename,12)+' '+mn(dsl,3)+' '+mn(maxfiles,3)+'   '+mln(password,10));
  429.   nl; prompt('D)elete, I)nsert, M)odify, Q)uit  :'); onek(c,'QDIM');
  430.   case c of
  431.     'Q':done:=true;
  432.     'D':begin
  433.            prompt('Directory number to delete? '); inu(ii);
  434.            if (ii>0) and (ii<=maxulb) then begin
  435.              prompt(uboards[ii].name+'   Delete it? ');
  436.              if yn then begin
  437.                maxulb:=maxulb-1; for i1:=ii to maxulb do
  438.                  uboards[i1]:=uboards[i1+1];
  439.                rewrite(ulf); for i1:=0 to maxulb do write(ulf,uboards[i1]);
  440.                close(ulf);
  441.              end;
  442.            end;
  443.         end;
  444.    'M': begin
  445.            prompt('Directory number to edit? '); inu(ii); cls;
  446.            if (ii>=0) and (ii<=maxulb) then with uboards[ii] do begin
  447.            repeat
  448.              cls; print('   Directory  : '+cstr(ii));
  449.              print('1. Name       : '+name);
  450.              print('2. Filename   : '+filename);
  451.              print('3. DSL        : '+cstr(dsl));
  452.              print('4. Password   : "'+password+'"');
  453.              print('5. Max files  : '+cstr(maxfiles));
  454.              nl; prompt('Which? '); onek(c,'Q12345');
  455.              case c of
  456.                '1':begin prompt('New name? '); inputl(name,25); end;
  457.                '2':begin prompt('New filename? '); input(filename,12); end;
  458.                '3':begin prompt('New DSL? '); ini(dsl); end;
  459.                '4':begin prompt('New PW? '); input(password,10); end;
  460.                '5':begin prompt('Max files? '); inu(maxfiles); end;
  461.              end;
  462.            until (c='Q') or hangup;
  463.            reset(ulf); seek(ulf,ii); write(ulf,uboards[ii]); close(ulf); c:=' ';
  464.          end;
  465.         end;
  466.     'I': begin
  467.            prompt('Board number to insert before? '); inu(ii);
  468.            if (ii>0) and (ii<=maxulb+1) and (maxulb<19) then begin
  469.              maxulb:=maxulb+1; for i1:=maxulb downto ii do
  470.                uboards[i1]:=uboards[i1-1];
  471.              with uboards[ii] do begin
  472.                name:='NEW DIRECTORY';
  473.                filename:='newdir';
  474.                dsl:=0;
  475.                maxfiles:=50;
  476.                password:='';
  477.              end;
  478.              rewrite(ulf); for i1:=0 to maxulb do write(ulf,uboards[i1]);
  479.              close(ulf);
  480.            end;
  481.          end;
  482.   end;
  483.  until done or hangup;
  484. end;
  485.  
  486. overlay procedure init;
  487. var a,b,c:integer;
  488.     vdf:file of vdatar;
  489.     vd:vdatar;
  490.     fi:text;
  491.     i:str;
  492.     fil:file of pnr;
  493.     ns:pnr;
  494.     f:file;
  495.     ch1:char;
  496. begin
  497.  if daynum(date)=0 then begin
  498.    clrscr;
  499.    writeln('You need to set the date & time first.');
  500.    halt;
  501.  end;
  502.  comport:=comnum;
  503.  maxspd:=maxbaud;
  504.  iport; ldate:=daynum(date);
  505.   ch:=false; lil:=0; thisuser.pagelen:=20; buf:=''; chatcall:=false;
  506.   spd:=''; lastname:=''; ll:=''; cursor:=''; i:=''; chatr:='';
  507.   assign(bf,'gfiles\boards.dat');
  508.   assign(uf,'gfiles\user.lst');
  509.   assign(sf,'gfiles\names.lst');
  510.   assign(sysopf,'gfiles\sysop.log');
  511.   assign(mailfile,'gfiles\email.dat');
  512.   assign(systatf,'gfiles\status');
  513.   reset(systatf); read(systatf,systat);close(systatf);
  514.   assign(smf,'gfiles\shortmsg.dat');
  515.   assign(cf,'gfiles\chat.msg'); cfo:=false;
  516.   reset(sf); for a:=0 to systat.users do read(sf,srl[a]); close(sf);
  517.   for a:=systat.users+1 to maxusers do begin srl[a].name:=''; srl[a].number:=0; end;
  518.   hangup:=false;
  519.   incom:=false; outcom:=false;
  520.   echo:=true; doneday:=false;
  521.   reset(bf);
  522.   numboards:=filesize(bf);
  523.   for t:=1 to numboards do
  524.     read(bf,boards[t]);
  525.   close(bf);
  526.   assign(slf,'gfiles\seclev.dat'); reset(slf); for c:=0 to 255 do read(slf,seclev[c]);
  527.   close(slf);
  528.   reset(uf);
  529.   if filesize(uf)>1 then begin seek(uf,1); read(uf,user); fw:=user.waiting;
  530.   end else fw:=0;
  531.   close(uf);
  532.   assign(f,'gfiles\help.msg');
  533.   for ch1:='0' to '^' do helpi[ch1]:=0;
  534.   {$I-} reset(f,1); {$I+}
  535.   if ioresult=0 then begin
  536.     blockread(f,help[1],25000,a);
  537.     close(f);
  538.     b:=1;
  539.     while (b<a) do begin
  540.       if help[b]='|' then begin
  541.         ch1:=help[b+1];
  542.         if ch1 in ['0'..'^'] then begin
  543.           c:=b;
  544.           while (help[c]<>#10) and (abs(c-b)<80) do c:=c+1;
  545.           c:=c+1;
  546.           if c<a then helpi[ch1]:=c;
  547.         end;
  548.       end;
  549.       b:=b+1;
  550.     end;
  551.     help[a+1]:='|';
  552.   end;
  553.   assign(vdf,'gfiles\voting.dat');
  554.   {$I-} reset(vdf); {$I+}
  555.   if ioresult=0 then begin
  556.     for a:=1 to 9 do begin
  557.       read(vdf,vd);
  558.       vqu[a]:=vd.numa<>0;
  559.     end;
  560.     close(vdf);
  561.   end else for a:=1 to 9 do vqu[a]:=false;
  562.   assign(fi,'gfiles\trashcan.txt'); {$I-} reset(fi); {$I+}
  563.   if ioresult<>0 then begin
  564.     rewrite(fi); i:='FUCK'; writeln(fi,i); i:='SID VICIOUS'; writeln(fi,i);
  565.     i:='SYSOP'; writeln(fi,i); i:='JEFF THE RIPPER'; writeln(fi,i);
  566.   end;
  567.   close(fi);
  568.   assign(fil,'gfiles\numbers.trm');
  569.   {$I-} reset(fil); {$I+}
  570.   if ioresult<>0 then begin
  571.     rewrite(fil);
  572.     ns.name:='========================================';
  573.     ns.number:='- --- --- ----';
  574.     ns.hs:=true;
  575.     for c:=1 to 9 do write(fil,ns);
  576.   end;
  577.   close(fil);
  578. end;
  579.  
  580. overlay procedure movemsg(var pl,cn:integer);
  581. var mr,mr1:messagerec; i:str; c1,c2,c3,ob:integer; done:boolean;
  582.  
  583.   function gtr(mr,mr1:messages):boolean;
  584.   begin
  585.    if mr.ext>mr1.ext then gtr:=true else
  586.     if mr.ltr>mr1.ltr then gtr:=true else
  587.       if (mr.ltr=mr1.ltr) and (mr.number>mr1.number) then
  588.         gtr:=true
  589.       else gtr:=false;
  590.   end;
  591.  
  592. begin
  593.   nl; nl; if (cn>0) and (cn<=pl) then begin
  594.     print('Move message'); c1:=0; done:=false;
  595.     repeat
  596.       prompt('To which board (1-'+cstr(numboards)+') ?=list, Q=Quit :');
  597.       input(i,3);
  598.       if (i='') or (i='Q') then done:=true;
  599.       if i='?' then begin
  600.         nl;
  601.         for c2:=1 to numboards do
  602.           print(cstr(c2)+': '+boards[c2].name);
  603.         nl;
  604.       end;
  605.       c1:=value(i);
  606.       if (c1>0) and (c1<=numboards) then done:=true;
  607.     until done;
  608.     if (c1>0) and (c1<=numboards) then begin
  609.       seek(mf,cn); read(mf,mr); pl:=pl-1;
  610.       for c2:=cn+1 to pl+1 do begin
  611.         seek(mf,c2);read(mf,mr1); seek(mf,c2-1); write(mf,mr1);
  612.       end;
  613.       seek(mf,0); mr1.message.number:=pl; write(mf,mr1);
  614.       close(mf);
  615.       ob:=board;
  616.       board:=c1;
  617.       iscan(pl);
  618.       if pl>=boards[board].maxmsgs then deletem(pl,1);
  619.       c1:=pl;
  620.       if c1>0 then begin seek(mf,c1); read(mf,mr1); end;
  621.       while gtr(mr1.message,mr.message) and (c1>0) do begin
  622.         c1:=c1-1;
  623.         if c1>0 then begin seek(mf,c1); read(mf,mr1); end;
  624.       end;
  625.       c1:=c1+1;
  626.       pl:=pl+1;
  627.       for c2:=pl downto c1+1 do begin
  628.         seek(mf,c2-1); read(mf,mr1); seek(mf,c2); write(mf,mr1);
  629.       end;
  630.       seek(mf,c1); write(mf,mr);
  631.       mr.message.number:=pl; seek(mf,0); write(mf,mr);
  632.       close(mf);
  633.       board:=ob;
  634.       iscan(pl);
  635.       if cn>pl then cn:=pl;
  636.       print('Moved.');
  637.     end;
  638.   end;
  639. end;
  640.