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

Pascal/Delphi Source File | 1988-04-01 | 6.2 KB | 283 lines

overlay procedure init;

  procedure readstatus;
  var f:file of systemstatus;
      ss:systemstatus absolute numcallers;
  begin
    assign (f,'Status');
    reset (f);
    if ioresult<>0 then begin
      fillchar (numcallers,511,0);
      tonext:=-1;
      sysopavail:=bytime;
      writestatus;
      exit
    end;
    read (f,ss);
    close (f)
  end;

  procedure formatmfile;
  var m:mailrec;
  begin
    rewrite (mfile);
    fillchar (m,sizeof(m),0);
    write (mfile,m)
  end;

  procedure openmfile;
  begin
    close (mfile);
    assign (mfile,'Mail');
    reset (mfile);
    if ioresult<>0 then formatmfile
  end;

  procedure closetfile;
  var n:integer;
  begin
    close (tfile);
    n:=ioresult;
    close (mapfile);
    n:=ioresult
  end;

  procedure formattfile;
  var cnt,p:integer;
      r:real;
      buff:buffer;
  const dummystr:sstr='Blank!! ';
  begin
    writestr ('Create new message base (y/n)? *');
    if not yes then halt;
    rewrite (mapfile);
    if ioresult<>0 then begin
      writeln ('Unable to create message base.');
      halt
    end;
    p:=-2;
    for cnt:=0 to numsectors do write (mapfile,p);
    p:=1;
    for cnt:=1 to sectorsize do begin
      buff[cnt]:=dummystr[p];
      p:=p+1;
      if p>length(dummystr) then p:=1
    end;
    rewrite (tfile);
    if ioresult<>0 then begin
      writeln ('Unable to create message base.');
      halt
    end;
    for cnt:=0 to 5 do write (tfile,buff)
  end;

  procedure opentfile;
  var i,j:integer;
  begin
    closetfile;
    assign (tfile,textdir+'Text');
    assign (mapfile,textdir+'BlockMap');
    reset (tfile);
    i:=ioresult;
    reset (mapfile);
    j:=ioresult;
    if (i<>0) or (j<>0) then formattfile;
    firstfree:=-1
  end;

  procedure openufile;
  var u:userrec;
      n,cnt:integer;
      k:integer;
  begin
    close (ufile);
    assign (ufile,'Users');
    reset (ufile);
    n:=ioresult;
    if n=0 then begin
      numusers:=filesize(ufile)-1;
      exit
    end;
    close (ufile);
    n:=ioresult;
    rewrite (ufile);
    fillchar (u,sizeof(u),0);
    write (ufile,u);
    u.handle:=sysopname;
    u.password:='Sysop';
    u.timetoday:=9999;
    u.level:=sysoplevel+1;
    u.udlevel:=sysoplevel+1;
    u.udpoints:=10000;
    u.gflvl:=sysoplevel+1;
    for k:=1 to 9 do
    u.infoform[k]:=-1;
    fillchar (u.access2,32,255);
    if useconmode
      then u.config:=u.config+[ansigraphics,lowercase]
      else u.config:=u.config+[asciigraphics];
    write (ufile,u);
    numusers:=1

  end;

  procedure initfile (var f:file);
  var fi:fib absolute f;
  begin
    fi.handle:=-1;
    fi.path[1]:=chr(0)
  end;

  procedure devicedrivers;
  begin
    if coninptr=ofs(readchar) then exit;
    turbooutptr:=conoutptr;
    turboinptr:=coninptr;
    usrinptr:=ofs(bioskey);
    usroutptr:=turbooutptr;
    coninptr:=ofs(readchar);
    conoutptr:=ofs(writechar);
    constptr:=ofs(charready);
    auxoutptr:=ofs(sendchar);
    auxinptr:=ofs(getchar);
(*  errorptr:=ofs(errorhandle) *)
  end;

  procedure openlogfile;

    procedure autodeletesyslog;
    var mx,cnt:integer;
        l:logrec;
    begin
      dontanswer;
      write (usr,'*> Autodeleting system log ... please stand by ... ');
      mx:=filesize(logfile) div 2;
      for cnt:=1 to mx do begin
        seek (logfile,cnt+mx-1);
        read (logfile,l);
        seek (logfile,cnt-1);
        write (logfile,l)
      end;
      seek (logfile,mx-1);
      truncate (logfile);
      writeln (usr,'Done. <*');
      doanswer
    end;

  begin
    assign (logfile,'Syslog');
    reset (logfile);
    if ioresult<>0 then begin
      rewrite (logfile);
      if ioresult<>0 then begin
        writeln (usr,'Unable to create log file');
        halt
      end
    end;
    if filesize(logfile)>maxsyslogsize then autodeletesyslog
  end;

  procedure loadsyslogdat;
  var tf:text;
      q:lstr;
      b1,b2,p,s,n:integer;
  begin
    numsyslogdat:=0;
    with syslogdat[0] do begin
      menu:=0;
      subcommand:=0;
      text:='SYSLOG.DAT entry not found: %'
    end;
    assign (tf,'syslog.dat');
    {$I-} reset (tf); {$I+}
    if ioresult=0 then begin
      while not eof(tf) do begin
        readln (tf,q);
        p:=pos(' ',q);
        if p<>0 then begin
          val (copy(q,1,p-1),b1,s);
          if s=0 then begin
            delete (q,1,p);
            p:=pos(' ',q);
            if p<>0 then begin
              val (copy(q,1,p-1),b2,s);
              if s=0 then begin
                delete (q,1,p);
                if numsyslogdat=maxsyslogdat
                  then writeln ('Too many SYSLOG.DAT entries')
                  else begin
                    numsyslogdat:=numsyslogdat+1;
                    with syslogdat[numsyslogdat] do begin
                      menu:=b1;
                      subcommand:=b2;
                      text:=copy(q,1,30)
                    end
                  end
              end
            end
          end
        end
      end;
      textclose (tf)
    end;
    if numsyslogdat=0 then writeln (usr,'SYSLOG.DAT file missing or invalid')
  end;

var k:char;
    cnt:integer;
    r:regs;
begin
  r.ah:=15;
  intr ($10,r);
  if r.al=7
    then screenseg:=$b000
    else screenseg:=$b800;
  devicestackptr:=0;
  devicedrivers;
  iocode:=0;
  linecount:=0;
  sysopavail:=bytime;
  errorparam:='';
  errorproc:='';
  unam:='';
  chainstr:='';
  chatreason:='';
  ulvl:=0;
  unum:=-1;
  logonunum:=-2;
  break:=false;
  nochain:=false;
  nobreak:=false;
  wordwrap:=false;
  dots:=false;
  online:=false;
  local:=true;
  chatmode:=false;
  texttrap:=false;
  printerecho:=false;
  fillchar (urec,sizeof(urec),0);
  usecapsonly:=false;
  uselinefeeds:=true;
  curattrib:=0;
  buflen:=80;
  baudrate:=defbaudrate;
  parity:=false;
  timelock:=false;
  modeminlock:=false;
  modemoutlock:=false;
  tempsysop:=false;
  sysnext:=false;
  cursection:=mainsysop;
  regularlevel:=0;
  setparam (usecom,baudrate,parity);
  initwinds;
  for cnt:=1 to numsysfiles do initfile (sysfiles[cnt]);
  cls;
  loadsyslogdat;
  readstatus;
  openufile;
  opentfile;
  openlogfile;
  openmfile
end;