Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SYSPC22.ZIP/MAINMENU.PAS

Pascal/Delphi Source File | 1989-02-14 | 26.3 KB | 1,093 lines

overlay procedure editusers;
var eunum:integer;

  procedure elistusers;
  var cnt,f,l:integer;
      u:userrec;
  begin
    parserange (numusers,f,l);
    seek (ufile,f);
    for cnt:=f to l do begin
      read (ufile,u);
      tab (strr(cnt)+'. ',5);
      if break then exit;
      tab (u.handle,31);
      if break then exit;
      writestr (strr(u.level));
      if break then exit
    end
  end;

begin
  repeat
    writestr (^M'User to edit [?=list]:');
    if input='?'
      then elistusers
      else if (length(input)=0) or (match(input,'Q'))
        then exit
        else begin
          eunum:=lookupuser (input);
          if eunum=0
            then writestr ('User not found!')
            else edituser (eunum)
        end
  until hungupon
end;

overlay procedure summonsysop;
var tf:text;
    k:char;
begin
  chatmode:=not chatmode;
  bottomline;
  if chatmode
    then
      if sysopisavail
        then
          begin
            writestr ('Enter a short reason: &');
            chatreason:=input;
            if length(input)=0 then begin
              chatmode:=false;
              exit
            end;
            writelog (1,3,chatreason);
            splitscreen (4);
            top;
            clrscr;
            writeln (usr,unam,' wants to chat!  His reason:');
            write (usr,chatreason);
            bottom;
            assign (tf,'Summon');
            reset (tf);
            if ioresult=0
              then
                while (not (eof(tf) or hungupon)) and chatmode do
                  begin
                    read (tf,k);
                    nobreak:=true;
                    if ord(k)=7 then summonbeep else writechar (k);
                    if keyhit then begin
                      k:=bioskey;
                      clearbreak;
                      chat (false)
                    end
                  end;
            if chatmode
              then writestr (^M'Use [C] again to turn off page.')
              else unsplit
          end
        else
          begin
            writeln ('*> Sysop is not available <*');
            chatmode:=false;
            if chatnum=3 then writeln (^M'*> Don''t Push It!!! One more time and you will be logged off <*');
            if chatnum>=4 then begin
            writeln (^M'*> Some people NEVER learn <*');
            disconnect;
            end;
            writelog (1,2,'')
          end
    else writestr ('Page off.  Use [C] to turn it back on.');
  chatnum:=chatnum+1;
  clearbreak
end;

overlay procedure offtheforum;
var q,n:integer;
    tn:file of integer;
    m:message;
begin
  writestr ('Hang up now? *');
  if yes then begin
    writestr ('Leave message to next user? *');
    if yes then begin
      q:=editor(m,false);
      if q>=0 then begin
        if tonext>=0 then deletetext (tonext);
        tonext:=q;
        writestatus
      end
    end;
    printfile (textfiledir+'GoodBye');
    disconnect
  end
end;

overlay procedure listusers;
var cnt:integer;
    u:userrec;
begin
  writeln (^B'[Name]                             [Level]  [Calls]  [Posts]  [Last Login]'^M);
  if break then exit;
  for cnt:=1 to numusers do
    begin
      seek (ufile,cnt);
      read (ufile,u); che;
      if length(u.handle)>0 then begin
        tab (u.handle,35);
        if break then exit;
     {   if u.level>31 and ulvl<31 then
         writestr ('31')
        else  }
        tab (strr(u.level),9);
        if break then exit;
        tab (strr(u.numon),9);
        if break then exit;
        tab (strr(u.nbu),9);
        if break then exit;
        writeln (u.londa);
      end
    end
end;

overlay procedure editnews;
var nn,numnews:integer;
    nf:file of newsrec;

  procedure getnn (txt:mstr);
  begin
    writestr ('News number to '+txt+':');
    nn:=valu(input);
    if (nn<1) or (nn>numnews) then nn:=0
  end;

  procedure delnews;
  var cnt:integer;
      r:newsrec;
  begin
    if nn=0 then getnn ('delete');
    if nn<>0 then begin
      seek (nf,nn-1);
      read (nf,r); che;
      deletetext (r.where);
      numnews:=filesize(nf)-1;
      for cnt:=nn to numnews do
        begin
          seek (nf,cnt);
          read (nf,r);
          seek (nf,cnt-1);
          write (nf,r)
        end;
      seek (nf,numnews);
      truncate (nf)
    end
  end;

  procedure listnews;
  var cnt:integer;
      r:newsrec;
      sector:integer;
      q:buffer;
      l:anystr;
      k:char;
  begin
    clearbreak;
    for cnt:=1 to numnews do begin
      seek (nf,cnt-1);
      read (nf,r);
      write (strr(cnt)+'. ');
      writeln (r.title);
      if break then exit
    end;
    writeln
  end;

  procedure viewnews;
  var r:newsrec;
  begin
    if nn=0 then getnn ('view');
    if nn<>0 then begin
      seek (nf,nn-1);
      read (nf,r); che;
      writeln ('Title: ',r.title);
      writeln ('Level: ',r.Level);
      writeln ('Date : ',r.date,' at ',r.time);
      writeln;
      printtext (r.where)
    end
  end;

  procedure adddnews;
  begin
    close (nf);
    addnews;
    assign (nf,'News');
    reset (nf)
  end;

var q:integer;
begin
  assign (nf,'News');
  reset (nf);
  if ioresult<>0 then writestr ('No news!  Use [A] to add some!') else begin
    repeat
      numnews:=filesize(nf);
      write (^B^M'News entries: ',numnews);
      q:=menu ('News edit','NEWS','ADLVQ');
      nn:=valu(copy(input,2,255));
      if (nn<1) or (nn>numnews) then nn:=0;
      case q of
        1:adddnews;
        2:delnews;
        3:listnews;
        4:viewnews
      end;
      if numnews=0 then begin
        close (nf);
        erase (nf);
        writestr ('No more news!  Use [A] to add some.');
        q:=5
      end
    until (q=5) or hungupon
  end;
  close (nf)
end;

overlay procedure yourstatus;
begin
  writehdr (' *> Your Status <* ');
  writeln;
  writeln (' *> Name:   '^S,unam,
         ^M' *> Level:  '^S,ulvl,
         ^M' *> Calls:  '^S,urec.numon,
         ^M' *> Posted: '^S,urec.nbu,
       ^M^M' *> G-File Transfers <* ',
       ^M^M' *> Uploads:     '^S,urec.gfup,
         ^M' *> Downloads:   '^S,urec.gfdown,
       ^M^M' *> Transfer Section <* ',
       ^M^M' *> Uploads:     '^S,urec.uploads,
         ^M' *> Downloads:   '^S,urec.downloads,
       ^M^M' *> Total time on: '^S,urec.totaltime:0:0,
         ^M' *> Time left:     '^S,timeleft)
end;

overlay procedure delerrlog;
var e:text;
    i:integer;
begin
  writestr ('Delete error log:  Confirm:');
  if not yes then exit;
  assign (e,'errlog');
  reset (e);
  i:=ioresult;
  if ioresult=1
    then writeln (^M'No error log!')
    else begin
      textclose (e);
      erase (e);
      writestr ('Error log deleted.');
      if ioresult>1
        then writeln ('I/O error ',i,' deleting error log!');
      writelog (2,2,'')
    end
end;

overlay procedure feedback;
var m:mailrec;
    me:message;
begin
  writestr ('Leave feedback? *');
  if not yes then exit;
  sendtoistru:=false;
  feed:=true;
  m.line:=editor(me,true);
  if m.line<0 then exit;
  m.title:=me.title;
  m.sentby:=unam;
  m.anon:=false;
  m.sentda:=datestr;
  m.sentti:=timestr;
  addfeedback (m);feed:=false;sendtoistru:=true;
  writestr ('Feedback sent.')
end;

overlay procedure settime;
var n1,n2,n3,t:integer;
    r:regs;
begin
  writestr ('Current time: '+timestr);
  writestr ('Current date: '+datestr);
  writestr ('Enter new time:');
  if length(input)<>0
    then begin
      t:=timeleft;
      n3:=timeval(input);
      n1:=n3 div 60;
      n2:=n3 mod 60;
      r.ch:=n1;
      r.cl:=n2;
      r.dh:=0;
      r.dl:=0;
      r.ah:=$2d;
      intr ($21,r);
      if r.al=$ff then writestr ('Invalid time!');
      settimeleft (t)
    end;
  writestr ('Enter new date:');
  if length(input)<>0
    then begin
      parse3 (input,n1,n2,n3);
      if n3<100 then n3:=n3+1900;
      r.dh:=n1;
      r.dl:=n2;
      r.cx:=n3;
      r.ah:=$2b;
      intr ($21,r);
      if r.al=$ff then writestr ('Invalid date!')
    end;
  writelog (2,4,'')
end;

overlay procedure changepwd;
var t:sstr;
begin
  writehdr ('Password Change');
  dots:=true;
  buflen:=15;
  write ('Enter new password: ');
  if getpassword
    then begin
      writeurec;
      writestr ('Password changed.');
      writelog (1,1,'')
    end else
      writestr ('No change.')
end;



overlay procedure makeuser;
var u:userrec;
    un,ln:integer;
begin
  writehdr ('Add a user');
  writestr ('Name:');
  if length(input)=0 then exit;
  if lookupuser(input)<>0 then begin
    writestr ('Sorry!  Already exists!');
    exit
  end;
  u.handle:=input;
  writestr ('Password:');
  u.password:=input;
  writestr ('Level:');
  if length(input)=0 then exit;
  u.level:=valu(input);
  un:=adduser(u);
  if un=-1 then begin
    writestr ('Sorry, no room for new users!');
    exit
  end;
  ln:=u.level;
  if ln<1 then ln:=1;
  if ln>100 then ln:=100;
  u.timetoday:=usertime[ln];
  seek (ufile,un);
  write (ufile,u);
  writestr ('User added as #'+strr(un)+'.');
  writelog (2,8,u.handle)
end;

overlay procedure infoformhunt;
begin
  nosys:=false;
  writestr ('User to search for [CR=all users]:');
  writeln (^M);
  showinfoforms (input)
end;

overlay procedure viewsyslog;
var n:integer;
    l:logrec;

  function lookupsyslogdat (m,s:integer):integer;
  var cnt:integer;
  begin
    for cnt:=1 to numsyslogdat do with syslogdat[cnt] do
      if (menu=m) and (subcommand=s) then begin
        lookupsyslogdat:=cnt;
        exit
      end;
    lookupsyslogdat:=0
  end;

  function firstentry:boolean;
  begin
    firstentry:=(l.menu=0) and (l.subcommand in [1..2])
  end;

  procedure backup;
  begin
    while n<>0 do begin
      n:=n-1;
      seek (logfile,n);
      read (logfile,l);
      if firstentry then exit
    end;
    n:=-1
  end;

  procedure showentry (includedate:boolean);
  var q:lstr;
      p:integer;
  begin
    q:=syslogdat[lookupsyslogdat(l.menu,l.subcommand)].text;
    p:=pos('%',q);
    if p<>0 then q:=copy(q,1,p-1)+l.param+copy(q,p+1,255);
    if includedate then q:=q+' on '+l.date;
    q:=q+' at '+l.time;
    writeln (q)
  end;

var b:boolean;
begin
  writehdr ('View system log');
  writeln ('Press space to advance to the previous caller, X to abort.');
  writeln;
  writelog (2,6,'');
  n:=filesize(logfile);
  repeat
    clearbreak;
    writeln (^M);
    backup;
    if n=-1 then exit;
    seek (logfile,n);
    read (logfile,l);
    showentry (true);
    b:=false;
    while not (eof(logfile) or break or xpressed or b) do begin
      read (logfile,l);
      b:=firstentry;
      if not b then showentry (false);
    end
  until xpressed
end;

overlay procedure delsyslog;
begin
  writestr ('Delete system log: Confirm:');
  if not yes then exit;
  close (logfile);
  rewrite (logfile);
  writeln (^M'System log deleted.');
  writelog (2,7,unam)
end;

overlay procedure nvote;
 begin
   if vote and (ulvl>=forvote) then newvote else
   writeln (^M^M);
 end;

overlay procedure showsystemstatus;
var totalused,totalidle,totalup,totaldown,totalmins,callsday,
    total_disk,total_free,file_sizes:real;
    total_files:integer;

  Procedure FileSZ;
  var cnt,cnt2,cnt3,cnt4,curarea:integer;
      ar,area:arearec;
      ud:udrec;
      Inscan,showit,fast:boolean;
      Drv:array[1..15] of boolean;

  procedure assignud;
  begin
    close (udfile);
    assign (udfile,'AREA'+strr(curarea))
  end;

  const beenaborted:boolean=false;

  function aborted:boolean;
  begin
    if beenaborted then begin
      aborted:=true;
      exit
    end;
    aborted:=xpressed or hungupon;
    if xpressed then begin
      beenaborted:=true;
      writeln (^B'File Calculation aborted..')
    end
  end;

  procedure setarea (n:integer);
  begin
    curarea:=n;
    seek(afile,n-1);
    read (afile,area);
    assignud;
    close (udfile);
    reset (udfile);
    if ioresult<>0 then rewrite (udfile);
  end;

  Procedure CheckDrive(dv:char);
  var n:byte;
      Temp_Disk,Temp_Free:real;

    procedure WriteFreeSpace (dr:byte);
    var r:regs;
        csize:real;

      function unsigned (i:integer):real;
      begin
        if i>=0 then unsigned:=i else unsigned:=65536.0+i
      end;

    begin
      r.ah:=$36;
      r.dl:=dr;
      intr ($21,r);
      if r.ax=-1 then exit;
      csize:=unsigned(r.ax)*unsigned(r.cx);
      Temp_Free:=(csize*unsigned(r.bx))/1000;
      Temp_Disk:=(csize*unsigned(r.dx))/1000;
    end;

  begin
    if (ord(dv)<65) or (ord(dv)>79) then exit;
    n:=ord(dv)-64;
    writefreespace(n);
    if not Drv[n] then begin
      Drv[n]:=true;
      Total_Disk:=Total_Disk+Temp_Disk;
      Total_Free:=Total_Free+Temp_Free;
    end;
  end;

  function getfname (path:lstr; name:mstr):lstr;
  var l:lstr;
  begin
    l:=path;
    if length(l)<>0 then if not (upcase(l[length(l)]) in [':','\'])
      then l:=l+'\';
    l:=l+name;
    getfname:=l
  end;

  begin
    total_files:=0;
    file_sizes:=0;
    total_disk:=0;
    Total_Free:=0;
    for cnt:=1 to 15 do Drv[Cnt]:=false;
    assign (afile,'AreaDir');
    if exist ('Areadir') then begin
      reset (afile);
      if filesize (afile)<0 then exit
    end else rewrite (afile);
    cnt:=1;
    while (cnt<=filesize(afile)) do begin
      seek (afile,cnt-1);
      read (afile,ar);
      CheckDrive(upcase(ar.xmodemdir[1]));
      setarea (cnt);
      if urec.udlevel >= ar.level then
      write ('*> Area [',cnt,']  [',ar.name,'] <*          ')
      else write ('*> Area: [Restricted] <*');
      for cnt2:=filesize(udfile) downto 1 do begin
        Seek (udfile,cnt2-1);
        read (udfile,ud);
        CheckDrive(upcase(ud.path[1]));
        if aborted then begin
          Total_Files:=0;
          File_Sizes:=0;
          Total_Disk:=0;
          Total_Free:=0;
          exit;
        end;
        if exist(getfname(ud.path,ud.filename)) then begin
          Total_Files:=Total_Files+1;
          File_Sizes:=File_Sizes+ud.filesize;
        end;
      end;
      cnt3:=0;
      delay(1000);
      write (^H^H^H^H^H^H^H^H^H^H^H^H^H^H);
      cnt4:=14;
      for cnt3:=1 to length(ar.name) do write (^H);
      for cnt3:=1 to length(ar.name) do cnt4:=cnt4+1;
      write (^H^H^H^H);
      cnt4:=cnt4+4;
      if cnt<10 then write (^H) else write (^H^H);
      if cnt<10 then cnt4:=cnt4+1 else cnt4:=cnt4+2;
      write (^H^H^H^H^H^H^H^H^H);
      cnt4:=cnt4+9;
      for cnt3:=1 to cnt4 do write (' ');
      for cnt3:=1 to cnt4 do write (^H);
      cnt:=cnt+1;
    end;
    File_Sizes:=File_Sizes/1000;
    write(usr,'*> Drives Online: ');
    for cnt:=1 to 15 do if Drv[cnt] then write (usr,chr(cnt+64),' ');
  end;

  procedure percent (prompt:mstr; top,bot:real);
  var p:real;
  begin
    write (prompt);
    if bot<1 then begin
      writeln (' Not Available');
      exit
    end;
    p:=round(10000*top/bot)/100;
    writeln (p:6:2,'%')
  end;


begin
  totalused:=numminsused.total+elapsedtime(numminsused);
  totalidle:=numminsidle.total;
  totalup:=totalidle+numminsused.total;
  totalmins:=1440.0*(numdaysup-1.0)+timer;
  totaldown:=totalmins-totalup;
  callsday:=round(10*numcallers/numdaysup)/10;
  writeln('*> Calculating <*');
  writeln;
  FileSZ;
  writehdr('           *> System Statistics <*');
  writeln(^B^B^B);
  writeln ('*> Time & date        --->  '^S,timestr,', ',datestr,
       ^M^J'*> Calls today        --->  '^S,callstoday,
       ^M^J'*> Total callers      --->  '^S,numcallers:0:0,
       ^M^J'*> Total days up      --->  '^S,numdaysup,
       ^M^J'*> Calls per day      --->  '^S,callsday:0:1,
       ^M^J'*> Total mins in use  --->  '^S,numminsused.total:0:0,
       ^M^J'*> Total mins idle    --->  '^S,totalidle:0:0,
       ^M^J'*> Mins file xfer     --->  '^S,numminsxfer.total:0:0,
       ^M^J'*> Total mins up      --->  '^S,totalup:0:0,
       ^M^J'*> Total mins down    --->  '^S,totaldown:0:0);
  percent ('*> Pct used           --->  '^S,totalused,totalmins);
  percent ('*> Pct dead           --->  '^S,totalidle,totalmins);
  percent ('*> Pct up             --->  '^S,totalup,totalmins);
  percent ('*> Pct down           --->  '^S,totaldown,totalmins);
  writeln ('*> Files Online       --->  '^S,total_files,
       ^M^J'*> Files Storage      --->  '^S,File_Sizes/1000:0:3,' megs',
       ^M^J'*> Total Storage      --->  '^S,Total_Disk/1000:0:3,' megs',
       ^M^J'*> Upload Space       --->  '^S,Total_Free/1000:0:3,' megs');
  percent ('*> Pct Space Unused   --->  '^S,total_free,total_disk);
  percent ('*> Pct Space Used     --->  '^S,(total_disk-Total_Free),Total_disk);
  percent ('*> Pct Storage Online --->  '^S,file_sizes,total_disk);
end;

overlay procedure newuselist;
var n:integer;
    u:userrec;

  procedure showuser;

  begin
    writeln (^B^M'Name:   '^S,u.handle,
               ^M'Voting  ',
               ^M'   Yes: ',^S,u.votey,
               ^M'    No: ',^S,u.voten);
    writestr  (^M'Edit user? *');
    if yes then edituser (n)
  end;

begin
  for n:=1 to numusers do begin
    seek (ufile,n);
    read (ufile,u);
    if (u.level<=level2nd) and (length(u.handle)>0) then showuser;
  end;
end;

overlay procedure showallforms;
begin
end;

overlay procedure showallsysops;
var n:integer;
    u:userrec;
    q:set of configtype;
    s:configtype;

  procedure showuser;
  const sectionnames:array [udsysop..databasesysop] of string[20]=
         ('File transfer','Bulletin section','Voting booths',
          'E-mail section','Doors','Main menu','Databases');
  begin
    writeln (^B^M'Name:  '^S,u.handle,
               ^M'Level: '^S,u.level,^M);
    for s:=udsysop to databasesysop do
      if s in u.config then
        writeln ('Sysop of the ',sectionnames[s]);
    writestr (^M'Edit user? *');
    if yes then edituser (n)
  end;

begin
  q:=[];
  for s:=udsysop to databasesysop do q:=q+[s];
  for n:=1 to numusers do begin
    seek (ufile,n);
    read (ufile,u);
    if (u.level>=sysoplevel) or (q*u.config<>[]) then showuser
  end
end;


overlay procedure readerrlog;
begin
  if exist ('Errlog')
    then printfile ('Errlog')
    else writestr ('No error file!')
end;

overlay procedure setlastcall;

  function digit (k:char):boolean;
  begin
    digit:=ord(k) in [48..57]
  end;

  function validtime (inp:sstr):boolean;
  var c,s,l:integer;
      d1,d2,d3,d4:char;
      ap,m:char;
  begin
    validtime:=false;
    l:=length(inp);
    if (l<7) or (l>8) then exit;
    c:=pos(':',inp);
    if c<>l-5 then exit;
    s:=pos(' ',inp);
    if s<>l-2 then exit;
    d2:=inp[c-1];
    if l=7
      then d1:='0'
      else d1:=inp[1];
    d3:=inp[c+1];
    d4:=inp[c+2];
    ap:=upcase(inp[s+1]);
    m:=upcase(inp[s+2]);
    if d1='1' then if d2>'2' then d2:='!';
    if (d1>='0') and (d1<='1') and digit(d2) and (d3>='0') and (d3<='5')
       and digit(d4) and ((ap='A') or (ap='P')) and (m='M')
         then validtime:=true
  end;

  function validdate (inp:sstr):boolean;
  var k,l:char;

    function gchar:char;
    begin
      if length(inp)=0 then begin
        gchar:='?';
        exit
      end;
      gchar:=inp[1];
      delete (inp,1,1)
    end;

  begin
    validdate:=false;
    k:=gchar;
    l:=gchar;
    if not digit(k) then exit;
    if l='/'
      then if k='0'
        then exit
        else
      else begin
        if k>'1' then exit;
        if not digit(l) then exit;
        if (l>'2') and (k='1') then exit;
        l:=gchar;
        if l<>'/' then exit
      end;
    k:=gchar;
    l:=gchar;
    if l='/'
      then if k='0'
        then exit
        else
      else begin
        if k>'3' then exit;
        if not digit(l) then exit;
        if (k='3') and (l>'1') then exit;
        l:=gchar;
        if l<>'/' then exit
      end;
    if digit(gchar) and digit(gchar) then validdate:=true
  end;

begin
  writeln (^M'Your last call was: '^S,lastonda,' at ',lastonti);
  writestr (^M'Enter new date (mm/dd/yy):');
  if validdate (input)
    then
    begin
    urec.ldmns:=input;
    urec.londa:=input;
    end
    else writestr ('Invalid date!');
  writestr (^M'Enter new time (hh:mm am/pm):');
  if validtime(input)
    then
    begin
    urec.ltmns:=input;
    urec.lonti:=input;
    end
    else writestr ('Invalid time!');
    writeurec;
end;

overlay procedure removeallforms;
var cnt,ndel:integer;
    u:userrec;
    f:integer;
begin
  writestr ('Erase ALL info-forms:  Are you sure? *');
  if not yes then exit;
  writeurec;
  writestr (^M'Erasing... please stand by...');
  ndel:=0;
  for cnt:=1 to numusers do begin
    if (cnt mod 10)=0 then write (cnt,', ');
    seek (ufile,cnt);
    read (ufile,u);
    for f:=1 to 9 do
    if u.infoform[f]>=0 then begin
      deletetext (u.infoform[f]);
      u.infoform[f]:=-1;
      seek (ufile,cnt);
      write (ufile,u);
      ndel:=ndel+1
    end;
      end;
  writeln ('done.');
  writestr (^M'All '+strr(ndel)+' forms erased.');
  readurec
end;

overlay procedure readfeedback;
var ffile:file of mailrec;
    m:mailrec;
    me:message;
    cur:integer;

  function nummessages:integer;
  begin
    nummessages:=filesize(ffile)
  end;

  function checkcur:boolean;
  begin
    if length(input)>1 then cur:=valu(copy(input,2,255));
    if (cur<1) or (cur>nummessages) then begin
      writestr (^M'Message out of range!');
      cur:=0;
      checkcur:=true
    end else begin
      checkcur:=false;
      seek (ffile,cur-1);
      read (ffile,m)
    end
  end;

  procedure readnum (n:integer);
  begin
    cur:=n;
    input:='';
    if checkcur then exit;
    writeln (^B^M'Message: '^S,cur,
               ^M'Title:   '^S,m.title,
               ^M'Sent by: '^S,m.sentby,
               ^M'Sent on: '^S,m.sentda,' at '^S,m.sentti,^M);
    if break then exit;
    printtext (m.line)
  end;

  procedure writecurmsg;
  begin
    if (cur<1) or (cur>nummessages) then cur:=0;
    write (^B^M'Current msg: '^S);
    if cur=0 then write ('None') else begin
      seek (ffile,cur-1);
      read (ffile,m);
      write (m.title,' by ',m.sentby)
    end
  end;

  procedure delfeedback;
  var cnt:integer;
  begin
    if checkcur then exit;
    deletetext (m.line);
    for cnt:=cur to nummessages-1 do begin
      seek (ffile,cnt);
      read (ffile,m);
      seek (ffile,cnt-1);
      write (ffile,m)
    end;
    seek (ffile,nummessages-1);
    truncate (ffile);
    cur:=cur-1
  end;

  procedure editusr;
  var n:integer;
  begin
    if checkcur then exit;
    n:=lookupuser (m.sentby);
    if n=0
      then writestr ('User disappeared!')
      else edituser (n)
  end;


procedure infoform;
begin

  writeln (^M);
  showinfoforms (m.sentby)
end;


  procedure nextfeedback;
  begin
    cur:=cur+1;
    if cur>nummessages then begin
      writestr (^M'Sorry, no more feedback!');
      cur:=0;
      exit
    end;
    readnum (cur)
  end;

  procedure readagain;
  begin
    if checkcur then exit;
    readnum (cur)
  end;

  procedure replyfeedback;
  begin
    if checkcur then exit;
    sendmailto (m.sentby,false)
  end;

  procedure listfeedback;
  var cnt:integer;
  begin
    if nummessages=0 then exit;
    thereare (nummessages,'piece of feedback','pieces of feedback');
    if break then exit;
    writeln (^M'Num Title                          Left by'^M);
    seek (ffile,0);
    for cnt:=1 to nummessages do begin
      read (ffile,m);
      tab (strr(cnt),4);
      if break then exit;
      tab (m.title,31);
      writeln (m.sentby);
      if break then exit
    end
  end;

var q:integer;
label exit;
begin
  assign (ffile,'Feedback');
  reset (ffile);
  if ioresult<>0 then rewrite (ffile);
  cur:=0;
  repeat
    if nummessages=0 then begin
      writestr ('Sorry, no feedback!');
      goto exit
    end;
    writecurmsg;
    q:=menu ('Feedback','FEED','Q#DEIR_AL');
    if q<0
      then readnum (-q)
      else case q of
        3:delfeedback;
        4:editusr;
        5:infoform;
        6:replyfeedback;
        7:nextfeedback;
        8:readagain;
        9:listfeedback;
      end
  until (q=1) or hungupon;
  exit:
  close (ffile)
end;

procedure mainsysopcommands;
var q:integer;
begin
  repeat
    q:=menu ('Sysop','SYSOP','QTEANDUCIJSKVMFRL');
    case q of
      2:;
      3:readerrlog;
      4:addnews;
      5:editnews;
      6:delerrlog;
      7:editusers;
      8:settime;
      9:infoformhunt;
      10:showallforms;
      11:viewsyslog;
      12:delsyslog;
      13:showallsysops;
      14:makeuser;
      15:readfeedback;
      16:removeallforms;
      17:newuselist;
    end
  until (q=1) or (q=2) or hungupon
end;

procedure mainmenu;
var q:integer;
begin
  repeat
    if fromdoor then doors;
    cursection:=mainsysop;
    q:=menu ('Main','MAIN','OKCDEFTIAR&UMNZP__SG_V+XY-_____%@');
    writeln;
    case q of
      1:printfile ('otherbbs');                          {aboutthisbbs;}
      2:configure;                                       {bulletinmenu;}
      3:summonsysop;
      4:datamenu;
      5:emailmenu;
      6:feedback;
      7:genfiles;                                        {offtheforum;}
      8:question(0);                                     {mainhelp;}
      9:aboutthisbbs;
      10:if gambling then mycommand;
      11:nvote;                                          {configure;}
      12:listusers;
      13:bulletinmenu;                                   {otherbbs;}
      14:printnews;
      15:doors;
      16:showlastcallers;                                {doors;}
      17:;
      18:;
      19:showsystemstatus;
      20:offtheforum;                                    {udsection;}
      21:;
      22:votingbooth (false);
      23:changepwd;                                      {showlastcallers;}
      24:udsection;                                      {transfername;}
      25:yourstatus;
      26:setlastcall;
      27:;                                               {changepwd;}
      28:;
      29:;
      30:;                                               {Showadd;}
      31:;                                               {Donation;}
      32:mainsysopcommands;
    end
  until hungupon
end;