home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / init.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-09  |  15KB  |  591 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit init;
  4.  
  5. interface
  6.  
  7. uses crt,dos,
  8. gentypes,modem,statret,configrt,gensubs,subs1,windows,subs2,desq42;
  9.  
  10. Var t:Text;
  11.  
  12. procedure validconfiguration;
  13. procedure initforum (checkfiles30:boolean);
  14.  
  15. implementation
  16.  
  17. procedure validconfiguration;
  18. var errs:integer;
  19.     cnt:integer;
  20.     flag:boolean;
  21.     trs,trb:mstr;
  22.     a,b:integer;
  23.  
  24.   procedure getinfo;
  25.   var reg:registerrec;
  26.       rf:file of registerrec;
  27.       name,board:string;
  28.       i:integer;
  29.   begin
  30.     registo:='■╣┬æN╟';
  31.     registb:='';
  32.     close (rf);
  33.     assign (rf,'VISION.REG');
  34.     reset (rf);
  35.     if ioresult <> 0 then exit;
  36.     read (rf,reg);
  37.     close (rf);
  38.     name:=reg.sysop;
  39.     for i:=1 to length(name) do
  40.      name[i]:=chr((ord(name[i]) - i) xor $12);
  41.     registo:=name;
  42.     board:=reg.boardname;
  43.     for i:=1 to length(board) do
  44.      board[i]:=chr((ord(board[i]) + i) xor $08);
  45.     registb:=board;
  46.     notvalidas:=not match(configset.sysopnam,registo);
  47.  end;
  48.  
  49.   procedure error (q:anystr);
  50.   begin
  51.     if errs=0 then writeln (usr,'Configuration Errors:');
  52.     errs:=errs+1;
  53.     writeln (usr,errs,'. ',q)
  54.   end;
  55.  
  56.   procedure ispath (var x:lstr; name:lstr);
  57.   begin
  58.     if not exist(x+'con') then error (name+' path bad: '+x)
  59.   end;
  60.  
  61.   procedure isstring (x:anystr; name:lstr);
  62.   var cnt:integer;
  63.   begin
  64.     if length(x)=0 then begin
  65.       error (name+' has not been set!');
  66.       exit
  67.     end;
  68.     for cnt:=1 to length(x) do if not (x[cnt] in [#32..#255])
  69.       then begin
  70.         error ('Bad '+name+' string');
  71.         exit
  72.       end
  73.   end;
  74.  
  75.   Procedure IsExistedFile(X:Mstr);
  76.   Begin
  77.     If Fsearch(X,'.;'+GetEnv('PATH'))='' Then
  78.        Error('File '+X+' not found in your environment!');
  79.   End;
  80.  
  81.   procedure isinteger (n,r1,r2:integer; name:lstr);
  82.   begin
  83.     if (n<r1) or (n>r2) then error ('Bad '+name+' value: '+strr(n))
  84.   end;
  85.  
  86. begin
  87.   a:=100;
  88.   b:=50;
  89.   a:=a div b;
  90.   b:=a+3;
  91.   mens:=false;
  92.   totalsent:=0;
  93.   totalrece:=0;
  94.   errs:=0;
  95.   matrix:='';
  96.   texttrap:=false;
  97.   notvalidas:=true;
  98.   getinfo;
  99.   if notvalidas then begin
  100.      ClrScr;
  101.      writeln('This copy of ViSiON is NOT registered to you, if there is');
  102.      writeln('a problem with the validation file please contact Crimson Blade or');
  103.      WriteLn('The Elemental at...');
  104.      writeln('   Countdown To Chaos (619)868-2025 - ViSiON Home');
  105.      delay(4000);
  106.      matrix:='GO AHEAD AND TRY TO CRACK THIS!!';
  107.   end;
  108.   isstring (configset.sysopnam,'Sysop name');
  109.   ispath (configset.textdi,'Path to message base');
  110.   ispath (configset.uploaddi,'Path to ASCII uploads');
  111.   ispath (configset.boarddi,'Path to sub-board files');
  112.   ispath (configset.textfiledi,'Path to text files');
  113.   ispath (configset.doordi,'Path to door batch files');
  114.   ispath (configset.netdir,'Path to net mail files');
  115.   ispath (configset.workdir,'Path to "Work Directory"');
  116.   isinteger (configset.useco,1,4,'COM: port');
  117.   isinteger (configset.mintimeou,1,maxint,'input time out');
  118.   isinteger (configset.sysopleve,1,maxint,'co-sysop level');
  119.   IsExistedFile('PKZIP.EXE');
  120.   IsExistedFile('PKUNZIP.EXE');
  121.   IsExistedFile('DSZ.COM');
  122.   IsExistedFile('COMMAND.COM');
  123.   flag:=true;
  124.   usedvmode:=(dv_get_version>0);
  125.   for cnt:=1 to 100 do if flag and (configset.usertim[cnt]<1) then begin
  126.     flag:=false;
  127.     error ('Time per day has non-positive entries')
  128.   end;
  129.   assign (t,'PROMPT.DAT');
  130.   reset(t);
  131.   if ioresult<>0 then begin
  132.    rewrite(t);
  133.    close(t);
  134.    append(t);
  135.    writeln('Creating Prompt File...');
  136.    writeln(t,'|01■|09■|03■|10[|14|CP|10]|03■|09■|01■:');
  137.    writeln(t);
  138.    writeln(t);
  139.    close(t);
  140.    reset(t);
  141.   end;
  142.   readln(t,confpromp1);
  143.   readln(t,confpromp2);
  144.   readln(t,confpromp3);
  145.   if errs>0 then begin
  146.   closeport;
  147.   halt(e_badconfig)
  148.   end;
  149. end;
  150.  
  151. procedure initforum (checkfiles30:boolean);
  152. var knt:integer;
  153.  
  154.   procedure formatmfile;
  155.   var m:mailrec;
  156.   begin
  157.     rewrite (mfile);
  158.     fillchar (m,sizeof(m),255);
  159.     write (mfile,m)
  160.   end;
  161.  
  162.   procedure openmfile;
  163.   var i:integer;
  164.   begin
  165.     close (mfile);
  166.     i:=ioresult;
  167.     assign (mfile,configset.forumdi+'Mail');
  168.     reset (mfile);
  169.     i:=ioresult;
  170.     if i<>0
  171.       then if i=2
  172.         then formatmfile
  173.         else begin
  174.           writeln (usr,'Fatal error: Unable to open mail file!');
  175.           closeport;
  176.           halt (e_fatalfileerror)
  177.         end
  178.   end;
  179.  
  180.   procedure closetfile;
  181.   var n:integer;
  182.   begin
  183.     close (tfile);
  184.     n:=ioresult;
  185.     close (mapfile);
  186.     n:=ioresult
  187.   end;
  188.  
  189.   procedure formattfile;
  190.   var cnt,p:integer;
  191.       r:real;
  192.       buff:buffer;
  193.       x:string[1];
  194.   const dummystr:sstr='Blank!! ';
  195.   begin
  196.     write (usr,'Creat New Message Base? [N]: ');
  197.     buflen:=1;
  198.     readline (x);
  199.     if (length(x)=0) or (upcase(x[1])<>'Y') then begin
  200.        closeport;
  201.        halt (e_fatalfileerror);
  202.        end;
  203.     rewrite (mapfile);
  204.     if ioresult<>0 then begin
  205.       writeln (usr,'Unable to create message base.');
  206.       closeport;
  207.       halt (e_fatalfileerror)
  208.     end;
  209.     p:=-2;
  210.     for cnt:=0 to numsectors do write (mapfile,p);
  211.     p:=1;
  212.     for cnt:=1 to sectorsize do begin
  213.       buff[cnt]:=dummystr[p];
  214.       p:=p+1;
  215.       if p>length(dummystr) then p:=1
  216.     end;
  217.     rewrite (tfile);
  218.     if ioresult<>0 then begin
  219.       writeln (usr,'Unable to create message base.');
  220.       closeport;
  221.       halt (e_fatalfileerror)
  222.     end;
  223.     for cnt:=0 to 5 do write (tfile,buff)
  224.   end;
  225.  
  226.   procedure opentfile;
  227.   var i,j:integer;
  228.   begin
  229.     closetfile;
  230.     assign (tfile,configset.textdi+'Text');
  231.     assign (mapfile,configset.textdi+'BlockMap');
  232.     reset (tfile);
  233.     i:=ioresult;
  234.     reset (mapfile);
  235.     j:=ioresult;
  236.     if (i<>0) or (j<>0) then formattfile;
  237.     firstfree:=-1
  238.   end;
  239.  
  240.   procedure openufile;
  241.   var u:userrec;
  242.       n,cnt:integer;
  243.       lsd:bbsrec;
  244.       lsf:file of bbsrec;
  245.  
  246.     procedure createuhfile;
  247.     var cnt:integer;
  248.     begin
  249.       rewrite (uhfile);
  250.       if ioresult<>0 then begin
  251.         writeln (usr,'Unable to create user index file. Run ViSiON Again!');
  252.         closeport;
  253.         halt (e_fatalfileerror)
  254.       end;
  255.       seek (ufile,0);
  256.       while not eof(ufile) do begin
  257.         read (ufile,u);
  258.         write (uhfile,u.handle)
  259.       end
  260.     end;
  261.  
  262.   var knte:integer;
  263.  
  264.   begin
  265.     close (ufile);
  266.     assign (ufile,configset.forumdi+'USERS');
  267.     reset (ufile);
  268.     n:=ioresult;
  269.     if n=0 then begin
  270.       numusers:=filesize(ufile)-1;
  271.       assign (uhfile,configset.forumdi+'USERINDX');
  272.       reset (uhfile);
  273.       if ioresult<>0
  274.         then createuhfile
  275.         else if filesize(uhfile)<>filesize(ufile) then begin
  276.           close (uhfile);
  277.           createuhfile
  278.         end;
  279.       assign(lsf,configset.forumdi+'BBSLIST.DAT');
  280.       reset(lsf);
  281.       if ioresult<>0 then  begin
  282.          lsd.name:='Countdown To Chaos';
  283.          lsd.baud:='38.4';
  284.          lsd.phone:='619-868-2025';
  285.          lsd.ware:='ViSiON';
  286.          rewrite(lsf);
  287.          write(lsf,lsd);
  288.          close(lsf);
  289.        end;
  290.       exit
  291.     end;
  292.     close (ufile);
  293.     n:=ioresult;
  294.     rewrite (ufile);
  295.     fillchar (u,sizeof(u),0);
  296.     write (ufile,u);
  297.     u.handle:=configset.sysopnam;
  298.     u.password:='Sysop';
  299.     u.Conf[1]:=true;
  300.     u.Conf[2]:=True;
  301.     U.Conf[3]:=True;
  302.     U.Conf[4]:=True;
  303.     U.Conf[5]:=true;
  304.     u.timetoday:=9999;
  305.     u.level:=configset.sysopleve+1;
  306.     u.menuboard:=112;
  307.         u.menuback:=27;
  308.         u.menuhighlight:=14;
  309.     u.blowboard:=configset.defblowbor;
  310.     u.blowinside:=configset.defblowin;
  311.     u.macro1:='Macro 1';
  312.     u.macro2:='Macro 2';
  313.     u.macro3:='Macro 3';
  314.     u.udlevel:=10000;
  315.     u.udpoints:=10000;
  316.     u.config:=[lowercase,eightycols,linefeeds,postprompts,asciigraphics,fseditor];
  317.     u.emailannounce:=-1;
  318.     u.infoform:=-1;
  319.     u.phonenum:='8005551212';
  320.     u.displaylen:=24;
  321.     fillchar (u.access2,32,255);
  322.      u.config:=u.config+[ansigraphics];
  323.      u.statcolor:=configset.defstacolor;
  324.      u.regularcolor:=configset.defreg;
  325.      u.promptcolor:=configset.defpromp;
  326.      u.inputcolor:=configset.definput;
  327.      u.usernote:='SysOverLord';
  328.      u.glevel:=configset.sysopleve+1;
  329.      u.gpoints:=10000;
  330.      u.upkay:=0;
  331.      u.dnkay:=0;
  332.      u.revision:=0;
  333.      u.lastposts:=0;
  334.      u.lastfiles:=0;
  335.      u.infoform2:=-1;
  336.      u.infoform3:=-1;
  337.      u.infoform4:=-1;
  338.      u.infoform5:=-1;
  339.      for knte:=1 to 32 do u.confset[knte]:=1;
  340.      write (ufile,u);
  341.     numusers:=1;
  342.     createuhfile
  343.  
  344.   end;
  345.  
  346.   procedure initfile (var f:file);
  347.   var fi:fib absolute f;
  348.   begin
  349.     fi.handle:=0;
  350.     fi.name[0]:=chr(0)
  351.   end;
  352.  
  353.   procedure openlogfile;
  354.  
  355.     procedure autodeletesyslog;
  356.     var mx,cnt:integer;
  357.         l:logrec;
  358.         begin
  359.                 dontanswer;
  360.       write (usr,'Autodeleting system log ... please stand by ... ');
  361.       mx:=filesize(logfile) div 2;
  362. (*      for cnt:=1 to mx do begin *)
  363. (*        assign (Configset.ForumDi+'SysLog'); *)
  364.         erase (logfile);
  365. (*        seek (logfile,cnt-1); *)
  366.         close (logfile);
  367. (*      end;
  368.         seek (logfile,mx-1);
  369.         truncate (logfile); *)
  370.             writeln (usr,'Done.');
  371.             doanswer;
  372.     end;
  373.  
  374.   begin
  375.     assign (logfile,configset.forumdi+'Syslog');
  376.     reset (logfile);
  377.     if ioresult<>0 then begin
  378.       rewrite (logfile);
  379.       if ioresult<>0 then begin
  380.         writeln (usr,'Unable to create log file');
  381.         closeport;
  382.         halt (e_fatalfileerror)
  383.       end
  384.     end;
  385.     if filesize(logfile)>maxsyslogsize then autodeletesyslog
  386.   end;
  387.  
  388.   procedure loadsyslogdat;
  389.     var tf:text;
  390.             f:File of Byte;
  391.             q:lstr;
  392.             b1,b2,p,s,n:integer;
  393.  
  394.    {$I MakeDat.Pas}
  395.  
  396.   begin
  397.     numsyslogdat:=0;
  398.     with syslogdat[0] do begin
  399.       menu:=0;
  400.       subcommand:=0;
  401.       text:='SYSLOG.DAT entry not found: %'
  402.     end;
  403.      if not exist('syslog.dat') then
  404.      begin
  405.             WriteLn(Usr,'Syslog.Dat not found! Recreating!');
  406.             makesyslogdat;
  407.      End;
  408.             Assign(F,'Syslog.Dat');
  409.             Reset(F);
  410.             If FileSize(F)<>4056 then
  411.                 Begin
  412.                     WriteLn(Usr,'SysLog.Dat file invalid. Updating.');
  413.                     MakeSyslogDat;
  414.                 End;
  415.                 Close(F);
  416.         assign (tf,'syslog.dat');
  417.     reset (tf);
  418.     if ioresult=0 then begin
  419.       while not eof(tf) do begin
  420.         readln (tf,q);
  421.         p:=pos(' ',q);
  422.         if p<>0 then begin
  423.           val (copy(q,1,p-1),b1,s);
  424.           if s=0 then begin
  425.             delete (q,1,p);
  426.             p:=pos(' ',q);
  427.             if p<>0 then begin
  428.               val (copy(q,1,p-1),b2,s);
  429.               if s=0 then begin
  430.                 delete (q,1,p);
  431.                 if numsyslogdat=maxsyslogdat
  432.                   then writeln (usr,'Too many SYSLOG.DAT entries')
  433.                   else begin
  434.                     numsyslogdat:=numsyslogdat+1;
  435.                     with syslogdat[numsyslogdat] do begin
  436.                       menu:=b1;
  437.                       subcommand:=b2;
  438.                       text:=copy(q,1,30)
  439.                     end
  440.                   end
  441.               end
  442.             end
  443.           end
  444.         end
  445.       end;
  446.       textclose (tf)
  447.     end;
  448.     if numsyslogdat=0 then writeln (usr,'SYSLOG.DAT file missing or invalid')
  449.   end;
  450.  
  451.   procedure doesfilesequal30;
  452.   var f:array [1..14] of file;
  453.       cnt,i:integer;
  454.     begin
  455.     {
  456.     for cnt:=1 to 14 do begin
  457.       assign (f[cnt],'CON');
  458.       reset (f[cnt]);
  459.       i:=ioresult;
  460.       if i<>0 then begin
  461.         writeln (usr,^M^J'Fatal error:  You MUST put the command',
  462.            ^M^J^J'   FILES=30',
  463.            ^M^J^J'in your CONFIG.SYS file on the disk from which you boot.',
  464.            ^M^J^J'Note:  If you have been modifying Forum-PC, then you may',
  465.              ^M^J'       be leaving a file open.');
  466.              closeport;
  467.         halt (e_files30)
  468.             end
  469.         end;
  470.         for cnt:=14 downto 1 do close(f[cnt])}
  471.   end;
  472.  
  473. var k:char;
  474.     cnt:integer;
  475. begin
  476.   with textrec(system.output) do begin
  477.     openfunc:=@opendevice;
  478.     closefunc:=@closedevice;
  479.     flushfunc:=@writechars;
  480.     inoutfunc:=@writechars
  481.   end;
  482.   with textrec(system.input) do begin
  483.     inoutfunc:=@readcharfunc;
  484.     openfunc:=@ignorecommand;
  485.     closefunc:=@ignorecommand;
  486.     flushfunc:=@ignorecommand
  487.   end;
  488.   if checkfiles30 then doesfilesequal30;
  489.   fillchar (urec,sizeof(urec),0);
  490.   urec.config:=[lowercase,eightycols,asciigraphics];
  491.   iocode:=0;
  492.   linecount:=0;
  493.   sysopavail:=bytime;
  494.   errorparam:='';
  495.   errorproc:='';
  496.   unam:='';
  497.   chainstr:='';
  498.   chatreason:='';
  499.   ulvl:=0;
  500.   unum:=-1;
  501.   logonunum:=-2;
  502.   break:=false;
  503.   nochain:=false;
  504.   nobreak:=false;
  505.   wordwrap:=false;
  506.   beginwithspacesok:=false;
  507.   dots:=false;
  508.   online:=false;
  509.   local:=true;
  510.   chatmode:=false;
  511.   printerecho:=false;
  512.   fillchar (urec,sizeof(urec),0);
  513.   usecapsonly:=false;
  514.   uselinefeeds:=true;
  515.   curattrib:=0;
  516.   buflen:=80;
  517.   baudrate:=configset.defbaudrat;
  518.   parity:=false;
  519.   timelock:=false;
  520.   ingetstr:=false;
  521.   modeminlock:=false;
  522.   modemoutlock:=false;
  523.   tempsysop:=false;
  524.   usebottom:=false;
  525.   sysnext:=false;
  526.   forcehangup:=false;
  527.   requestbreak:=false;
  528.   disconnected:=false;
  529.   cursection:=mainsysop;
  530.   regularlevel:=0;
  531.     setparam (configset.useco,baudrate,parity);
  532.     doanswer;
  533.   initwinds;
  534.   for cnt:=1 to numsysfiles do initfile (sysfiles[cnt]);
  535.   cls;
  536.   loadsyslogdat;
  537.   readstatus;
  538.   openufile;
  539.   opentfile;
  540.   openlogfile;
  541.   openmfile;
  542. end;
  543.  
  544. procedure assignname (var t:text; nm:lstr);
  545. begin
  546.   with textrec(t) do begin
  547.     move (nm[1],name,length(nm));
  548.     name[length(nm)]:=#0
  549.   end
  550. end;
  551.  
  552. var r:registers;
  553. begin
  554.   textmode (co80);
  555.   checkbreak:=false;
  556.   checkeof:=false;
  557.   directvideo:=configset.directvideomod;
  558.   checksnow:=configset.checksnowmod;
  559.   r.ah:=15;
  560.   intr ($10,r);
  561.   if r.al=7
  562.     then screenseg:=$b000
  563.     else screenseg:=$b800;
  564.   textrec(system.input).mode:=fminput;
  565.   move (output,usr,sizeof(text));           { Set up device drivers }
  566.   move (output,direct,sizeof(text));
  567.   move (system.input,directin,sizeof(text));
  568.   with textrec(direct) do begin
  569.     openfunc:=@opendevice;
  570.     closefunc:=@closedevice;
  571.     flushfunc:=@directoutchars;
  572.     inoutfunc:=@directoutchars;
  573.     bufptr:=@buffer
  574.   end;
  575.   with textrec(directin) do begin
  576.     mode:=fminput;
  577.     inoutfunc:=@directinchars;
  578.     openfunc:=@ignorecommand;
  579.     flushfunc:=@ignorecommand;
  580.     closefunc:=@ignorecommand;
  581.     bufptr:=@buffer
  582.   end;
  583.   with textrec(usr) do bufptr:=@buffer;
  584.   assignname (usr,'USR');
  585.   assignname (direct,'DIRECT');
  586.   assignname (directin,'DIRECT-IN');
  587.   assignname (system.output,'OUTPUT');
  588.   assignname (system.input,'INPUT');
  589.   notvalidas:=not match(configset.sysopnam,registo);
  590. end.
  591.