home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 276.img / FORUM21S.ZIP / INIT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-15  |  11KB  |  444 lines
  1. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit init;
  5.  
  6. interface
  7.  
  8. uses crt,dos,
  9.      gentypes,modem,statret,configrt,gensubs,subs1,windows,subs2;
  10.  
  11. procedure validconfiguration;
  12. procedure initforum (checkfiles30:boolean);
  13.  
  14. implementation
  15.  
  16. procedure validconfiguration;
  17. var errs:integer;
  18.     cnt:integer;
  19.     flag:boolean;
  20.  
  21.   procedure error (q:anystr);
  22.   begin
  23.     if errs=0 then writeln (usr,'Configuration Errors:');
  24.     errs:=errs+1;
  25.     writeln (usr,errs,'. ',q)
  26.   end;
  27.  
  28.   procedure ispath (var x:lstr; name:lstr);
  29.   begin
  30.     if not exist(x+'con') then error (name+' path bad: '+x)
  31.   end;
  32.  
  33.   procedure isstring (x:anystr; name:lstr);
  34.   var cnt:integer;
  35.   begin
  36.     if length(x)=0 then begin
  37.       error (name+' has not been set!');
  38.       exit
  39.     end;
  40.     for cnt:=1 to length(x) do if not (x[cnt] in [#32..#255])
  41.       then begin
  42.         error ('Bad '+name+' string');
  43.         exit
  44.       end
  45.   end;
  46.  
  47.   procedure isinteger (n,r1,r2:integer; name:lstr);
  48.   begin
  49.     if (n<r1) or (n>r2) then error ('Bad '+name+' value: '+strr(n))
  50.   end;
  51.  
  52. begin
  53.   errs:=0;
  54.   isstring (sysopname,'Sysop name');
  55.   ispath (textdir,'Path to message base');
  56.   ispath (uploaddir,'Path to ASCII uploads');
  57.   ispath (boarddir,'Path to sub-board files');
  58.   ispath (textfiledir,'Path to text files');
  59.   ispath (doordir,'Path to door batch files');
  60.   isinteger (defbaudrate,110,9600,'default baud rate');
  61.   isinteger (usecom,1,2,'COM: port');
  62.   isinteger (mintimeout,1,maxint,'input time out');
  63.   isinteger (sysoplevel,1,maxint,'co-sysop level');
  64.   flag:=true;
  65.   for cnt:=1 to 100 do if flag and (usertime[cnt]<1) then begin
  66.     flag:=false;
  67.     error ('Time per day has non-positive entries')
  68.   end;
  69.   if errs>0 then halt(e_badconfig)
  70. end;
  71.  
  72. procedure initforum (checkfiles30:boolean);
  73.  
  74.   procedure formatmfile;
  75.   var m:mailrec;
  76.   begin
  77.     rewrite (mfile);
  78.     fillchar (m,sizeof(m),255);
  79.     write (mfile,m)
  80.   end;
  81.  
  82.   procedure openmfile;
  83.   var i:integer;
  84.   begin
  85.     close (mfile);
  86.     i:=ioresult;
  87.     assign (mfile,'Mail');
  88.     reset (mfile);
  89.     i:=ioresult;
  90.     if i<>0
  91.       then if i=2
  92.         then formatmfile
  93.         else begin
  94.           writeln (usr,'Fatal error: Unable to open mail file!');
  95.           halt (e_fatalfileerror)
  96.         end
  97.   end;
  98.  
  99.   procedure closetfile;
  100.   var n:integer;
  101.   begin
  102.     close (tfile);
  103.     n:=ioresult;
  104.     close (mapfile);
  105.     n:=ioresult
  106.   end;
  107.  
  108.   procedure formattfile;
  109.   var cnt,p:integer;
  110.       r:real;
  111.       buff:buffer;
  112.       x:string[1];
  113.   const dummystr:sstr='Blank!! ';
  114.   begin
  115.     write (usr,'Create new message base (y/n)? ');
  116.     buflen:=1;
  117.     readline (x);
  118.     if (length(x)=0) or (upcase(x[1])<>'Y') then halt (e_fatalfileerror);
  119.     rewrite (mapfile);
  120.     if ioresult<>0 then begin
  121.       writeln (usr,'Unable to create message base.');
  122.       halt (e_fatalfileerror)
  123.     end;
  124.     p:=-2;
  125.     for cnt:=0 to numsectors do write (mapfile,p);
  126.     p:=1;
  127.     for cnt:=1 to sectorsize do begin
  128.       buff[cnt]:=dummystr[p];
  129.       p:=p+1;
  130.       if p>length(dummystr) then p:=1
  131.     end;
  132.     rewrite (tfile);
  133.     if ioresult<>0 then begin
  134.       writeln (usr,'Unable to create message base.');
  135.       halt (e_fatalfileerror)
  136.     end;
  137.     for cnt:=0 to 5 do write (tfile,buff)
  138.   end;
  139.  
  140.   procedure opentfile;
  141.   var i,j:integer;
  142.   begin
  143.     closetfile;
  144.     assign (tfile,textdir+'Text');
  145.     assign (mapfile,textdir+'BlockMap');
  146.     reset (tfile);
  147.     i:=ioresult;
  148.     reset (mapfile);
  149.     j:=ioresult;
  150.     if (i<>0) or (j<>0) then formattfile;
  151.     firstfree:=-1
  152.   end;
  153.  
  154.   procedure openufile;
  155.   var u:userrec;
  156.       n,cnt:integer;
  157.  
  158.     procedure createuhfile;
  159.     var cnt:integer;
  160.     begin
  161.       rewrite (uhfile);
  162.       if ioresult<>0 then begin
  163.         writeln (usr,'Unable to create user index file.');
  164.         halt (e_fatalfileerror)
  165.       end;
  166.       seek (ufile,0);
  167.       while not eof(ufile) do begin
  168.         read (ufile,u);
  169.         write (uhfile,u.handle)
  170.       end
  171.     end;
  172.  
  173.   begin
  174.     close (ufile);
  175.     assign (ufile,'Users');
  176.     reset (ufile);
  177.     n:=ioresult;
  178.     if n=0 then begin
  179.       numusers:=filesize(ufile)-1;
  180.       assign (uhfile,'Userindx');
  181.       reset (uhfile);
  182.       if ioresult<>0
  183.         then createuhfile
  184.         else if filesize(uhfile)<>filesize(ufile) then begin
  185.           close (uhfile);
  186.           createuhfile
  187.         end;
  188.       exit
  189.     end;
  190.     close (ufile);
  191.     n:=ioresult;
  192.     rewrite (ufile);
  193.     fillchar (u,sizeof(u),0);
  194.     write (ufile,u);
  195.     u.handle:=sysopname;
  196.     u.password:='Sysop';
  197.     u.timetoday:=9999;
  198.     u.level:=sysoplevel+1;
  199.     u.udlevel:=10000;
  200.     u.udpoints:=10000;
  201.     u.config:=[lowercase,eightycols,linefeeds,postprompts];
  202.     u.emailannounce:=-1;
  203.     u.infoform:=-1;
  204.     u.displaylen:=24;
  205.     fillchar (u.access2,32,255);
  206.     if useconmode
  207.       then u.config:=u.config+[ansigraphics]
  208.       else u.config:=u.config+[asciigraphics];
  209.     write (ufile,u);
  210.     numusers:=1;
  211.     createuhfile
  212.   end;
  213.  
  214.   procedure initfile (var f:file);
  215.   var fi:fib absolute f;
  216.   begin
  217.     fi.handle:=0;
  218.     fi.name[0]:=chr(0)
  219.   end;
  220.  
  221.   procedure openlogfile;
  222.  
  223.     procedure autodeletesyslog;
  224.     var mx,cnt:integer;
  225.         l:logrec;
  226.     begin
  227.       dontanswer;
  228.       write (usr,'Autodeleting system log ... please stand by ... ');
  229.       mx:=filesize(logfile) div 2;
  230.       for cnt:=1 to mx do begin
  231.         seek (logfile,cnt+mx-1);
  232.         read (logfile,l);
  233.         seek (logfile,cnt-1);
  234.         write (logfile,l)
  235.       end;
  236.       seek (logfile,mx-1);
  237.       truncate (logfile);
  238.       writeln (usr,'Done.');
  239.       doanswer
  240.     end;
  241.  
  242.   begin
  243.     assign (logfile,'Syslog');
  244.     reset (logfile);
  245.     if ioresult<>0 then begin
  246.       rewrite (logfile);
  247.       if ioresult<>0 then begin
  248.         writeln (usr,'Unable to create log file');
  249.         halt (e_fatalfileerror)
  250.       end
  251.     end;
  252.     if filesize(logfile)>maxsyslogsize then autodeletesyslog
  253.   end;
  254.  
  255.   procedure loadsyslogdat;
  256.   var tf:text;
  257.       q:lstr;
  258.       b1,b2,p,s,n:integer;
  259.   begin
  260.     numsyslogdat:=0;
  261.     with syslogdat[0] do begin
  262.       menu:=0;
  263.       subcommand:=0;
  264.       text:='SYSLOG.DAT entry not found: %'
  265.     end;
  266.     assign (tf,'syslog.dat');
  267.     reset (tf);
  268.     if ioresult=0 then begin
  269.       while not eof(tf) do begin
  270.         readln (tf,q);
  271.         p:=pos(' ',q);
  272.         if p<>0 then begin
  273.           val (copy(q,1,p-1),b1,s);
  274.           if s=0 then begin
  275.             delete (q,1,p);
  276.             p:=pos(' ',q);
  277.             if p<>0 then begin
  278.               val (copy(q,1,p-1),b2,s);
  279.               if s=0 then begin
  280.                 delete (q,1,p);
  281.                 if numsyslogdat=maxsyslogdat
  282.                   then writeln (usr,'Too many SYSLOG.DAT entries')
  283.                   else begin
  284.                     numsyslogdat:=numsyslogdat+1;
  285.                     with syslogdat[numsyslogdat] do begin
  286.                       menu:=b1;
  287.                       subcommand:=b2;
  288.                       text:=copy(q,1,30)
  289.                     end
  290.                   end
  291.               end
  292.             end
  293.           end
  294.         end
  295.       end;
  296.       textclose (tf)
  297.     end;
  298.     if numsyslogdat=0 then writeln (usr,'SYSLOG.DAT file missing or invalid')
  299.   end;
  300.  
  301.   procedure doesfilesequal30;
  302.   var f:array [1..14] of file;
  303.       cnt,i:integer;
  304.   begin
  305.     for cnt:=1 to 14 do begin
  306.       assign (f[cnt],'CON');
  307.       reset (f[cnt]);
  308.       i:=ioresult;
  309.       if i<>0 then begin
  310.         writeln (usr,^M^J'Fatal error:  You MUST put the command',
  311.            ^M^J^J'   FILES=30',
  312.            ^M^J^J'in your CONFIG.SYS file on the disk from which you boot.',
  313.            ^M^J^J'Note:  If you have been modifying Forum-PC, then you may',
  314.              ^M^J'       be leaving a file open.');
  315.         halt (e_files30)
  316.       end
  317.     end;
  318.     for cnt:=14 downto 1 do close(f[cnt])
  319.   end;
  320.  
  321. var k:char;
  322.     cnt:integer;
  323. begin
  324.   with textrec(system.output) do begin
  325.     openfunc:=@opendevice;
  326.     closefunc:=@closedevice;
  327.     flushfunc:=@writechars;
  328.     inoutfunc:=@writechars
  329.   end;
  330.   with textrec(system.input) do begin
  331.     inoutfunc:=@readcharfunc;
  332.     openfunc:=@ignorecommand;
  333.     closefunc:=@ignorecommand;
  334.     flushfunc:=@ignorecommand
  335.   end;
  336.   if checkfiles30 then doesfilesequal30;
  337.   if not driverpresent then begin
  338.     writeln (usr,'The modem driver is not installed!  Please run the',
  339.                  'program'^M^J^M^J'    MODEMDRV.COM'^M^J^M^J,
  340.                  'and run Forum-PC again.');
  341.     halt (e_nomodemdrv)
  342.   end;
  343.   fillchar (urec,sizeof(urec),0);
  344.   urec.config:=[lowercase,eightycols,asciigraphics];
  345.   iocode:=0;
  346.   linecount:=0;
  347.   sysopavail:=bytime;
  348.   errorparam:='';
  349.   errorproc:='';
  350.   unam:='';
  351.   chainstr:='';
  352.   chatreason:='';
  353.   ulvl:=0;
  354.   unum:=-1;
  355.   logonunum:=-2;
  356.   break:=false;
  357.   nochain:=false;
  358.   nobreak:=false;
  359.   wordwrap:=false;
  360.   beginwithspacesok:=false;
  361.   dots:=false;
  362.   online:=false;
  363.   local:=true;
  364.   chatmode:=false;
  365.   texttrap:=false;
  366.   printerecho:=false;
  367.   fillchar (urec,sizeof(urec),0);
  368.   usecapsonly:=false;
  369.   uselinefeeds:=true;
  370.   curattrib:=0;
  371.   buflen:=80;
  372.   baudrate:=defbaudrate;
  373.   parity:=false;
  374.   timelock:=false;
  375.   ingetstr:=false;
  376.   modeminlock:=false;
  377.   modemoutlock:=false;
  378.   tempsysop:=false;
  379.   sysnext:=false;
  380.   forcehangup:=false;
  381.   requestbreak:=false;
  382.   disconnected:=false;
  383.   cursection:=mainsysop;
  384.   regularlevel:=0;
  385.   setparam (usecom,baudrate,parity);
  386.   doanswer;
  387.   initwinds;
  388.   for cnt:=1 to numsysfiles do initfile (sysfiles[cnt]);
  389.   cls;
  390.   loadsyslogdat;
  391.   readstatus;
  392.   openufile;
  393.   opentfile;
  394.   openlogfile;
  395.   openmfile
  396. end;
  397.  
  398. procedure assignname (var t:text; nm:lstr);
  399. begin
  400.   with textrec(t) do begin
  401.     move (nm[1],name,length(nm));
  402.     name[length(nm)]:=#0
  403.   end
  404. end;
  405.  
  406. var r:registers;
  407. begin
  408.   textmode (bw80);
  409.   checkbreak:=false;
  410.   checkeof:=false;
  411.   directvideo:=directvideomode;
  412.   checksnow:=checksnowmode;
  413.   r.ah:=15;
  414.   intr ($10,r);
  415.   if r.al=7
  416.     then screenseg:=$b000
  417.     else screenseg:=$b800;
  418.   textrec(system.input).mode:=fminput;
  419.   move (output,usr,sizeof(text));           { Set up device drivers }
  420.   move (output,direct,sizeof(text));
  421.   move (system.input,directin,sizeof(text));
  422.   with textrec(direct) do begin
  423.     openfunc:=@opendevice;
  424.     closefunc:=@closedevice;
  425.     flushfunc:=@directoutchars;
  426.     inoutfunc:=@directoutchars;
  427.     bufptr:=@buffer
  428.   end;
  429.   with textrec(directin) do begin
  430.     mode:=fminput;
  431.     inoutfunc:=@directinchars;
  432.     openfunc:=@ignorecommand;
  433.     flushfunc:=@ignorecommand;
  434.     closefunc:=@ignorecommand;
  435.     bufptr:=@buffer
  436.   end;
  437.   with textrec(usr) do bufptr:=@buffer;
  438.   assignname (usr,'USR');
  439.   assignname (direct,'DIRECT');
  440.   assignname (directin,'DIRECT-IN');
  441.   assignname (system.output,'OUTPUT');
  442.   assignname (system.input,'INPUT')
  443. end.
  444.