home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / SETUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-04  |  25.4 KB  |  895 lines
  1. program setup;
  2.  
  3. {$R-,S+,I-,D+,F-,V-,B-,N-,L+ }
  4. {$M 16384,5000,5000 }
  5.  
  6. uses dos,crt,video,xcrt,general,gentypes,configrt,faqload3;
  7.  
  8. var i1,i2,i3:integer;
  9.            c:char;
  10.  
  11. const configver='1.00';
  12.  
  13. type ScreenType = array [0..3999] of Byte;
  14. var ScreenAddr : ScreenType absolute $B800:$0000;
  15. { TheDraw Pascal Crunched Screen Image }
  16. const
  17.   SETUP_SCR_WIDTH=80;
  18.   SETUP_SCR_DEPTH=23;
  19.   SETUP_SCR_LENGTH=743;
  20.   SETUP_SCR : array [1..743] of Char = (
  21.     #11,#16,#26,'O','▓',#24,#26,'O','▓',#24,#26,'O','▓',#24,#26,#18,'▓',
  22.     #17,#25,'(',#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,#25,#4 ,
  23.     #15,'F','A','Q',' ','S','e','t','u','p',' ','P','r','o','g','r','a',
  24.     'm',' ','V','e','r','s','i','o','n',' ','1','.','0','0',#25,#5 ,#11,
  25.     #16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#15,#17,#26,'(','─',#11,
  26.     #16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',' ',#1 ,'█','█',
  27.     '█',' ',' ',#26,#23,'█',' ','█','█',#25,#2 ,'█','█','█',' ',#11,#16,
  28.     #26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,'█','█',#25,#2 ,
  29.     '█','█',' ',' ',#15,'B',#11,'B','S',' ','I','n','f','o','r','m','a',
  30.     't','i','o','n',#25,#7 ,#1 ,'█',' ',' ','█','█',#25,#2 ,#11,#16,#26,
  31.     #19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,'█','█',' ','█',' ',
  32.     '█','█',' ','█',#15,'M',#11,'o','d','e','m',' ','I','n','f','o','r',
  33.     'm','a','t','i','o','n',#1 ,#26,#6 ,'█',' ',' ','█','█',' ','█',' ',
  34.     #11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,
  35.     '█',' ',#26,#3 ,'█',#15,'L',#11,'e','v','e','l','s',#25,#10,#1 ,#26,
  36.     #6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',
  37.     #3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#15,'T',#11,'i',
  38.     'm','e','s',#25,#11,#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,
  39.     #26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',
  40.     #26,#3 ,'█',#11,'C',#15,'o',#11,'l','o','r','s',#25,#10,#1 ,#26,#6 ,
  41.     '█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,
  42.     '▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#15,'C',#11,'o','n',
  43.     'f','e','r','e','n','c','e','s',#25,#5 ,#1 ,#26,#6 ,'█',' ',' ',#26,
  44.     #3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',
  45.     #1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#11,'C','e','l','e','r','i','t','y',
  46.     #15,'N',#11,'e','t',#25,#5 ,#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',
  47.     #11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,
  48.     '█',' ',#26,#3 ,'█',#11,'N','e','w',' ','U','s','e','r',' ',#15,'V',
  49.     #11,'o','t','i','n','g',' ',' ',#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',
  50.     ' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,
  51.     #3 ,'█',' ',#26,#3 ,'█',#15,'F',#11,'i','l','e',' ','S','e','c','t',
  52.     'i','o','n',' ','I','n','f','o',#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',
  53.     ' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',' ',#1 ,
  54.     '█','█','█',' ',' ','█','█','█',#15,'S',#11,'t','r','i','n','g','s',
  55.     #25,#9 ,#1 ,#26,#6 ,'█',#25,#2 ,'█','█','█',' ',#11,#16,#26,#19,'▓',
  56.     #24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',
  57.     #11,'M',#15,'i',#11,'s','c','e','l','l','a','n','e','o','u','s',#25,
  58.     #3 ,#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,
  59.     #26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#15,
  60.     'E',#11,'x','i','t',' ','a','n','d',' ','S','a','v','e',#25,#3 ,#1 ,
  61.     #26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,
  62.     '▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#27,'█',' ',' ',#26,
  63.     #3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,#26,'(','▓',#11,
  64.     #26,#21,'▓',#24,#26,'O','▓',#24,#26,'O','▓',#24);
  65.  
  66. procedure UNCRUNCH (var Addr1,Addr2; BlkLen:Integer);
  67. begin
  68.   inline (
  69. $1E/$C5/$B6/Addr1/$C4/$BE/Addr2/$8B/$8E/BlkLen/$8B/$D7/$33/$C0/
  70. $FC/$AC/$3C/$1B/$75/$05/$80/$F4/$80/$EB/$4D/$3C/$10/$73/$07/
  71. $80/$E4/$70/$0A/$E0/$EB/$42/$3C/$18/$74/$13/$73/$19/$2C/$10/
  72. $02/$C0/$02/$C0/$02/$C0/$02/$C0/$80/$E4/$8F/$0A/$E0/$EB/$2B/
  73. $81/$C2/$A0/$00/$8B/$FA/$EB/$23/$3C/$19/$75/$0B/$AC/$51/$32/$ED/
  74. $8A/$C8/$B0/$20/$EB/$0D/$90/$3C/$1A/$75/$0F/$AC/$49/$51/$32/$ED/
  75. $8A/$C8/$AC/$E3/$03/$AB/$E2/$FD/$59/$49/$AB/$E3/$02/$E2/$A5/$1F);
  76. end;
  77.  
  78. procedure writeconfig;
  79. var q:file of configsettype;
  80. begin
  81.   assign (q,'SETUP.CFG');
  82.   rewrite (q);
  83.   write (q,configset);
  84.   close (q)
  85. end;
  86.  
  87. procedure cursor (b:boolean);
  88. var r:registers;
  89. begin
  90.   with r do begin
  91.   ah:=$01;
  92.   if not b then begin
  93.   ch:=$20; cl:=$20
  94.   end else begin
  95.   ch:=5; cl:=7
  96.   end
  97.  end;
  98.  intr ($10,r)
  99. end;
  100.  
  101. procedure formatconfig;
  102. var cnt,i:integer;
  103. begin
  104.   versioncode:=thisversioncode;
  105.   longname[0]:=#0;
  106.   sysopname[0]:=#0;
  107.   getdir (0,faqdir);
  108.   if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
  109.   textdir:=faqdir+'MSGS\';
  110.   uploaddir:=faqdir+'GFILES\';
  111.   datadir:=faqdir+'DATA\';
  112.   asciidownload:='From a FAQ Board';
  113.   textfiledir:=faqdir+'MENUS\';
  114.   doordir:=faqdir+'DOORS\';
  115.   networkdir:=faqdir+'NETWORK\';
  116.   xferdir:=faqdir+'UPLOADS\';
  117.   bbsdatadir:=faqdir+'BBSDATA\';
  118.   lockoutpw:='No 300!';
  119.   downloadpw:='Don''t D/L with 300!';
  120.   modemsetupstr:='';
  121.   modemhangupstr:='+++~~~ATH|';
  122.   modemdialprefix:='ATDT';
  123.   modemdialsuffix:='|';
  124.   defbaudrate:=2400;
  125.   usecom:=1;
  126.   answerring:=1;
  127.   offlocal:=false;
  128.   offcall:=false;
  129.   lockport:=false;
  130.   usrspeed:=0;
  131.   inbuf:=1024;
  132.   outbuf:=1024;
  133.   anonymouslevel:=50;
  134.   defcolor1:=9;
  135.   defcolor2:=11;
  136.   defcolor3:=15;
  137.   defcolor4:=12;
  138.   defcolor5:=9;
  139.   defcolor6:=15;
  140.   numwelcomes:=1;
  141.   mintimeout:=5;
  142.   sysoplevel:=200;
  143.   defuserlevel:=1;
  144.   defudlevel:=0;
  145.   mprompt:='Gateway Command: ';
  146.   mhelp :='?';
  147.   syst1 :='1';
  148.   syst2 :='';
  149.   syst3 :='';
  150.   mnew  :='2';
  151.   mcheck:='3';
  152.   mfback:='4';
  153.   mchat :='5';
  154.   mlogoff:='6';
  155.   mansi :='7';
  156.   defudpoints:=0;
  157.   normbotcolor:=9;
  158.   normtopcolor:=15;
  159.   outlockcolor:=11;
  160.   splitcolor:=12;
  161.   statlinecolor:=3;
  162.   uploadfactor:=2;
  163.   private:=false;
  164.   autologin:=false;
  165.   useconmode:=true;
  166.   escinmsgs:=true;
  167.   bkspinmsgs:=true;
  168.   req1name:='New User Application';
  169.   require1:=true;
  170.   req2name:='';
  171.   require2:=false;
  172.   req3name:='';
  173.   require3:=false;
  174.   req4name:='';
  175.   require4:=false;
  176.   req5name:='';
  177.   require5:=false;
  178.   dotchar:='/';
  179.   supportedrates:=[b1200]+[b2400];
  180.   downloadrates:=supportedrates;
  181.   availtime:='4:00 pm';
  182.   unavailtime:='10:00 pm';
  183.   xmodemopentime:='3:00 am';
  184.   xmodemclosetime:='3:00 am';
  185.   for cnt:=1 to 100 do usertime[cnt]:=cnt*2;
  186.   logonlevel:=10;
  187.   postlevel:=10;
  188.   anonymousstr:='[ Anonymous ]';
  189.   matrixtype:=1;
  190.   newusermatrix:=true;
  191.   systempassword:='FAQRULEZ';
  192.   newuserpass[0]:=#0;
  193.   remotedoors:=false;
  194.   allowdoors:=false;
  195.   eventtime[0]:=#0;
  196.   eventbatch[0]:=#0;
  197.   directvideomode:=true;
  198.   checksnowmode:=true;
  199.   hangnewusers:=true;
  200.   msgnextlvl:=10;
  201.   useconf:=true;
  202.   for i:=1 to 5 do begin
  203.   confm[i]:=#0;
  204.   confx[i]:=#0;
  205.   confmpw[i]:=#0;
  206.   confxpw[i]:=#0;
  207.   defconfm[i]:=false;
  208.   defconfx[i]:=false;
  209.   end;
  210.   confm[1]:='Elite Posts';
  211.   confx[1]:='(MS*IBM) Files';
  212.   confm[2]:='Sysop Posts';
  213.   confx[2]:='(Sysop) Files';
  214.   qvmainl:=50;
  215.   qvxferl:=50;
  216.   qvxferp:=0;
  217.   qvgfile:=50;
  218.   qvnote :='Validated User';
  219.   appear:='The Sysop is here.';
  220.   disappear:='The Sysop is gone.';
  221.   telenumber:='ARE PRE SUFF';
  222.   allowloan:=false;
  223.   lvltoloan:=50;
  224.   maxloan:=5;
  225.   timerestlvl:=1;
  226.   timereststart[0]:=#0;
  227.   timerestend[0]:=#0;
  228.   dszlogname:=faqdir+'DSZ.LOG';
  229.   jshutup:=true;
  230.   newusernote:='New User';
  231.   system2password[0]:=#0;
  232.   system3password[0]:=#0;
  233.   availstr:='The Sysop is available for chat.';
  234.   notavailstr:='The Sysop is not available for chat.';
  235.   useqr:=true;
  236.   qrlimit:=-25;
  237.   qrmultifactor:=5;
  238.   qrexempt:=60;
  239.   usecliche:=true;
  240.   cliche:='FAQ - The RIGHT one!';
  241.   ulpercent:=50;
  242.   checkautologin:=true;
  243.   usegambling:=true;
  244.   chance     :=20;
  245.   gain       :=5;
  246.   numpoints  :=100;
  247.   numthrows  :=5;
  248.   convrate   :=10;
  249.   maxdeposit :=120;
  250.   albank     :=true;
  251.   aldarts    :=true;
  252.   alrr       :=true;
  253.   alrb       :=true;
  254.   alhl       :=true;
  255.   alr        :=true;
  256.   alc        :=true;
  257.   usetimebank:=true;
  258.   readanonlvl:=50;
  259.   listuserlvl:=40;
  260.   ems:=false;
  261.   datascrambling:=false;
  262.   internalm:=true;
  263.   pcrexempt:=70;
  264.   xferpcr:=25;
  265.   gfpcr:=20;
  266.   gfratio:=20;
  267.   udratio:=20;
  268.   udexempt:=60;
  269.   doorpcr:=15;
  270.   matrixfback:=true;
  271.   matrixreqchat:=true;
  272.   ansiedit:='C:\UTILS\THEDRAW\THEDRAW.EXE';
  273.   editor:='C:\UTILS\Q\Q.EXE';
  274.   usequote:=true;
  275.   filepw:=true;
  276.   autovalidate:=false;
  277.   pointvalue:=50;
  278.   zipcomment:=false;
  279.   netnum:=1;
  280.   netpas:='Network Password';
  281.   usenet:=false;
  282.   featurea:=false;
  283.   featureb:=false;
  284.   featurec:=false;
  285.   featured:=false;
  286.   featuree:=false;
  287.   featuref:=false;
  288.   featureg:=false;
  289.   featureh:=false;
  290.   featurej:=false;
  291.   netcomment:='The Board - ARE-PRE-SUFF [FAQ]';
  292.   netstart:='';
  293.   netend  :='';
  294.   hostphone[0]:=#0;
  295.   extender:='1';
  296.   promptformat:='^01<^03^08^01/^03^09^01>^07';
  297.   promptformat1:='^01[^03^1^01] [^03^2^01] <^03?/Help^01>^04: ';
  298.   usemouse:=false;
  299.   usenuv:=false;
  300.   newvotelvl:=50;
  301.   autonuv:=false;
  302.   valnu:=10;
  303.   delnu:=5;
  304.   volvl:=50;
  305.   voflvl:=50;
  306.   vofps:=0;
  307.   leechweek:=false;
  308.   sblaster:=false;
  309.   writeconfig
  310. end;
  311.  
  312. function getbaudstr (var q:baudset):lstr;
  313. var w:lstr;
  314.     cnt:baudratetype;
  315. begin
  316.   w[0]:=chr(0);
  317.   for cnt:=firstbaud to lastbaud do
  318.     if cnt in q then w:=w+strlong(baudarray[cnt])+' ';
  319.   if length(w)=0 then w:='None';
  320.   getbaudstr:=w
  321. end;
  322.  
  323. procedure baudconf (q:baudset; typeit:string);
  324. var i,iii:integer;
  325.        baudnum:integer;
  326.        ii:baudratetype;
  327.        c:char;
  328.        b:boolean;
  329.        s:screens;
  330.  
  331. procedure writecurrentplace (i:integer; q:baudset);
  332. var ii,iii:integer;
  333. begin
  334. textbackground (7); textcolor (15);
  335. case i of
  336. 1:begin gotoxy (7,9); if b300 in q then write ('√') else write (' '); end;
  337. 2:begin gotoxy (7,10); if b1200 in q then write ('√') else write (' '); end;
  338. 3:begin gotoxy (7,11); if b2400 in q then write ('√') else write (' '); end;
  339. 4:begin gotoxy (7,12); if b4800 in q then write ('√') else write (' '); end;
  340. 5:begin gotoxy (7,13); if b9600 in q then write ('√') else write (' '); end;
  341. 6:begin gotoxy (7,14); if b19200 in q then write ('√') else write (' '); end;
  342. 7:begin gotoxy (7,15); if b38400 in q then write ('√') else write (' '); end;
  343. end;
  344. textcolor (15);
  345. textbackground (0);
  346. end;
  347.  
  348. begin
  349. readscr (s);
  350. baudnum:=1;
  351. textbackground (1);
  352. for i:=8 to 16 do begin
  353. gotoxy (6,i); write ('          '); end;
  354. gotoxy (9,9); write ('300');
  355. gotoxy (9,10); write ('1200');
  356. gotoxy (9,11); write ('2400');
  357. gotoxy (9,12); write ('4800');
  358. gotoxy (9,13); write ('9600');
  359. gotoxy (9,14); write ('19200');
  360. gotoxy (9,15); write ('38400');
  361. for i:=9 to 16 do begin gotoxy (4,i); textbackground (0); write ('  '); end;
  362. for i:=4 to 13 do begin gotoxy (i,17); textbackground (0); write (' '); end;
  363. repeat
  364. iii:=7;
  365. textbackground (1); textcolor (15);
  366. for ii:=firstbaud to lastbaud do begin
  367. inc (iii);
  368. if ii in q then begin gotoxy (7,iii); write ('√') end else begin
  369. gotoxy (7,iii); write (' ');
  370. end; end;
  371. writecurrentplace (baudnum,q);
  372. c:=upcase (readkey);
  373. case c of
  374. #72:begin
  375. if baudnum=1 then baudnum:=8;
  376. baudnum:=baudnum-1;
  377. end;
  378. #80:begin
  379. if baudnum=7 then baudnum:=0;
  380. baudnum:=baudnum+1;
  381. end;
  382. ' ':begin
  383. case baudnum of
  384. 1:if b300 in q then q:=q-[b300] else q:=q+[b300];
  385. 2:if b1200 in q then q:=q-[b1200] else q:=q+[b1200];
  386. 3:if b2400 in q then q:=q-[b2400] else q:=q+[b2400];
  387. 4:if b4800 in q then q:=q-[b4800] else q:=q+[b4800];
  388. 5:if b9600 in q then q:=q-[b9600] else q:=q+[b9600];
  389. 6:if b19200 in q then q:=q-[b19200] else q:=q+[b19200];
  390. 7:if b38400 in q then q:=q-[b38400] else q:=q+[b38400];
  391. end;
  392. end;
  393. end;
  394. until (c=#27) or (c=#13);
  395. if typeit='S' then supportedrates:=q;
  396. if typeit='D' then downloadrates:=q;
  397. writescr (s);
  398. end;
  399.  
  400. function colorconf (currcolor:integer; backgr:boolean):integer;
  401. var i,ii,iii,
  402.     i2,ii2:integer;
  403.     b:boolean;
  404.     c:char;
  405.     s:screens;
  406.  
  407. procedure writecurcolor (color,back:integer);
  408. var i:integer;
  409. begin
  410. textbackground (3);
  411. for i:=0 to 16 do begin
  412. gotoxy (7+i,12); textcolor (15); if i=color then write ('F') else write (' ');
  413. gotoxy (7+i,14); textcolor (15); if i=back then write ('B') else write (' ');
  414. end;
  415. end;
  416.  
  417. begin
  418. readscr (s);
  419. b:=false;
  420. ii:=15;
  421. iii:=0;
  422. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,9);
  423. write (' '); end;
  424. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,10);
  425. write (' '); end;
  426. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,11);
  427. write ('─'); end;
  428. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,12);
  429. write (' '); end;
  430. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,13);
  431. write (' '); end;
  432. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,14);
  433. write (' '); end;
  434. for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,15);
  435. write (' '); end;
  436. for i:=10 to 15 do begin textcolor (15); textbackground (0); gotoxy (4,i); write ('  ');
  437. end;
  438. for i:=4 to 21 do begin textcolor (15); textbackground (0); gotoxy (i,16); write (' ');
  439. end;
  440. repeat
  441. gotoxy (8,10); textcolor (ii); textbackground (iii);
  442. write ('Current Color');
  443. gotoxy (7,12);
  444. textbackground (3); textcolor (15);
  445. for i:=0 to 15 do begin gotoxy (7+i,13); textcolor (i);
  446. write ('█'); end;
  447. gotoxy (7,12);
  448. writecurcolor (ii,iii);
  449. c:=readkey;
  450. case c of
  451. #77:begin if ii=15 then ii:=-1;
  452. ii:=ii+1;
  453. end;
  454. #75:begin if ii=0 then ii:=16;
  455. ii:=ii-1;
  456. end;
  457. #72:begin if iii=7 then iii:=-1;
  458. iii:=iii+1;
  459. end;
  460. #80:begin if iii=0 then iii:=8;
  461. iii:=iii-1;
  462. end;
  463. #27:colorconf:=currcolor;
  464. #13:begin iii:=iii*16;
  465. b:=true;
  466. if backgr then
  467. colorconf:=ii+iii else colorconf:=ii; end;
  468. end
  469. until (b=true) or (c=#27);
  470. writescr (s);
  471. end;
  472.  
  473. { procedure dousertime;
  474.   var input:lstr;
  475.       n:integer;
  476.       buffer:array [1..4096] of byte;
  477.       b:block;
  478.  
  479.     procedure refresh;
  480.     var cnt:integer;
  481.     begin
  482.       clearwindow (normalcolor);
  483.       gotoxy (1,1);
  484.       cn;
  485.       writeln('Level Time │ Level Time │ Level Time │ Level Time │ Level Time');
  486.       writeln('───────────┼────────────┼────────────┼────────────┼───────────');
  487.       gotoxy (1,3);
  488.       for cnt:=1 to 100 do begin
  489.         write (cnt:4,': ',usertime[cnt]:4);
  490.         if (cnt mod 5)=0 then writeln else write (' │ ')
  491.       end
  492.     end;
  493.  
  494.     procedure setone (n,v:integer);
  495.     var x,y:integer;
  496.     begin
  497.       x:=((n-1) mod 5)*13+7;
  498.       y:=((n-1) div 5)+3;
  499.       gotoxy (x,y);
  500.       write (v:4);
  501.       usertime[n]:=v
  502.     end;
  503.  
  504.     procedure getone (n:integer);
  505.     var x,y,v:integer;
  506.     begin
  507.       x:=((n-1) mod 5)*13+7;
  508.       y:=((n-1) div 5)+3;
  509.       gotoxy (x,y);
  510.       write ('    ');
  511.       gotoxy (x,y);
  512.       buflen:=4;
  513.       readln (input);
  514.       v:=valu(input);
  515.       if (v<1) or (v>1000) then v:=usertime[n];
  516.       setone (n,v)
  517.     end;
  518.  
  519.     function getn (txt:lstr):integer;
  520.     var input:lstr;
  521.     begin
  522.       gotoxy (2,23);
  523.       write (txt,': ');
  524.       clreol;
  525.       buflen:=4;
  526.       readln (input);
  527.       getn:=valu(input)
  528.     end;
  529.  
  530.     function getlvl (txt:lstr):integer;
  531.     var n:integer;
  532.     begin
  533.       n:=getn (txt);
  534.       if (n<1) or (n>100) then n:=0;
  535.       getlvl:=n
  536.     end;
  537.  
  538.     procedure pattern;
  539.     var st,en,ba,se,cn:integer;
  540.     begin
  541.       st:=getlvl ('Starting level of pattern');
  542.       if st=0 then exit;
  543.       en:=getlvl ('Ending level of pattern');
  544.       if en<st then exit;
  545.       ba:=getn ('Time for level '+strr(st));
  546.       if (ba<1) or (ba>1000) then exit;
  547.       se:=getn ('Additional time per level');
  548.       if (se<0) or (se>1000) then exit;
  549.       cn:=st;
  550.       repeat
  551.         setone (cn,ba);
  552.         if ba+se<1000
  553.           then ba:=ba+se
  554.           else ba:=1000;
  555.         cn:=cn+1
  556.       until cn>en
  557.     end;
  558.  
  559.   var k:char;
  560.   begin
  561.     setblock (b,1,1,80,25);
  562.     readblock (b,buffer);
  563.     refresh;
  564.     repeat
  565.       repeat
  566.         gotoxy (1,24);
  567.         write ('Number to change, [P]attern, or [Q]uit: ');
  568.         clreol;
  569.         readln (input)
  570.       until length(input)>0;
  571.       k:=upcase(input[1]);
  572.       n:=valu(input);
  573.       if (n>=1) and (n<=100) then getone(n) else
  574.         case k of
  575.           'P':pattern
  576.         end
  577.     until k='Q';
  578.     writeblock (b,buffer)
  579.   end; }
  580.  
  581. procedure maybemakeconfig;
  582. var f:file of configsettype;
  583.     a:char;
  584.     s,w:integer;
  585. begin
  586.   s:=ofs(filler)-ofs(versioncode);
  587.   w:=sizeof(configsettype);
  588.    if s>w then begin
  589.     writeln;
  590.     writeln ('       ERROR! Size of configuration is: ',s);
  591.     writeln ('              Bytes being written     : ',w);
  592.     writeln;
  593.     a:=upcase(readkey);
  594.     cursor (true);
  595.   textcolor (7);
  596.   textbackground (0);
  597.   clrscr;
  598.     halt
  599.   end;
  600.   assign (f,'SETUP.CFG');
  601.   reset (f);
  602.   if ioresult=0 then begin
  603.     close (f);
  604.     exit
  605.   end;
  606.   fillchar (configset,sizeof(configset),0);
  607.   formatconfig
  608. end;
  609.  
  610. function inputinfo (desc1:string; desc2:string; writeto:string; buflength:integer):string;
  611. var i,ii:byte;
  612.     temp:string;
  613.        s:screens;
  614.       ss:string[2];
  615. begin
  616. readscr (s);
  617. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
  618. write (' '); end;
  619. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
  620. write ('─'); end;
  621. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
  622. write (' '); end;
  623. for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write ('  ');
  624. end;
  625. for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
  626. end;
  627. gotoxy (1,24); textcolor (15); textbackground (1); clreol;
  628. gotoxy (2,24); textcolor (15); textbackground (1); write (desc1);
  629. gotoxy (1,25); textcolor (15); textbackground (1); clreol;
  630. gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
  631. gotoxy (5,10); textcolor (15); textbackground (1);
  632. if length(writeto)>0 then
  633. write ('Current Setting: '+writeto) else write ('No Setting!');
  634. gotoxy (5,12); textcolor (15); textbackground (1);
  635. write ('Input: ');
  636. textcolor (11);
  637. cursor (true);
  638. ii:=1;
  639. temp:=writeto;
  640. while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
  641. editline(temp,ii,12,12,buflength,ss);
  642. cursor (false);
  643. if length(temp)<1 then temp:=writeto else writeto:=temp;
  644. if upstring(temp)='N' then temp:='';
  645. inputinfo:=temp;
  646. writescr (s);
  647. textcolor (15);
  648. textbackground (0);
  649. end;
  650.  
  651. function inputcharinfo (desc1:string; desc2:string; writeto:char; buflength:integer):char;
  652. var i,ii:byte;
  653.     temp:string;
  654.        s:screens;
  655.       ss:string[2];
  656. begin
  657. readscr (s);
  658. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
  659. write (' '); end;
  660. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
  661. write ('─'); end;
  662. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
  663. write (' '); end;
  664. for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write ('  ');
  665. end;
  666. for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
  667. end;
  668. gotoxy (1,24); textcolor (15); textbackground (1); clreol;
  669. gotoxy (2,24); textcolor (15); textbackground (1); write (desc1);
  670. gotoxy (1,25); textcolor (15); textbackground (1); clreol;
  671. gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
  672. gotoxy (5,10); textcolor (15); textbackground (1);
  673. if length(writeto)>0 then
  674. write ('Current Setting: '+writeto) else write ('No Setting!');
  675. gotoxy (5,12); textcolor (15); textbackground (1);
  676. write ('Input: ');
  677. textcolor (11);
  678. cursor (true);
  679. ii:=1;
  680. temp:=writeto;
  681. while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
  682. editline(temp,ii,12,12,buflength,ss);
  683. cursor (false);
  684. if length(temp)<1 then temp:=writeto else writeto:=temp[1];
  685. if upstring(temp)='N' then temp:='';
  686. inputcharinfo:=temp[1];
  687. writescr (s);
  688. textcolor (15);
  689. textbackground (0);
  690. end;
  691.  
  692. function inputintinfo (desc1:string; desc2:string; writeto:string; buflength,lowrange,highrange
  693. :longint):longint;
  694. var i,ii:byte;
  695.     temp:string;
  696.        s:screens;
  697.       ss:string[2];
  698. begin
  699. readscr (s);
  700. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
  701. write (' '); end;
  702. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
  703. write ('─'); end;
  704. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
  705. write (' '); end;
  706. for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write ('  ');
  707. end;
  708. for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
  709. end;
  710. repeat
  711. gotoxy (1,24); textcolor (15); textbackground (1); clreol;
  712. gotoxy (2,24); textcolor (15); textbackground (1); write (desc1+' - Range: ',lowrange,'-',highrange);
  713. gotoxy (1,25); textcolor (15); textbackground (1); clreol;
  714. gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
  715. gotoxy (5,10); textcolor (15); textbackground (1);
  716. if length(writeto)>0 then
  717. write ('Current Setting: '+writeto) else write ('No Setting!');
  718. gotoxy (5,12); textcolor (15); textbackground (1);
  719. write ('Input: ');
  720. textcolor (11);
  721. cursor (true);
  722. ii:=1;
  723. temp:=writeto;
  724. while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
  725. editline(temp,ii,12,12,buflength,ss);
  726. cursor (false);
  727. until (valul(temp)<=highrange) and (valul(temp)>=lowrange);
  728. if length(temp)<1 then temp:=writeto else writeto:=temp;
  729. inputintinfo:=valul(temp);
  730. writescr (s);
  731. textcolor (15);
  732. textbackground (0);
  733. end;
  734.  
  735. function inputbooinfo (desc1:string; desc2:string; writeto:boolean; buflength:integer):boolean;
  736. var i,ii:byte;
  737.     temp:string;
  738.        s:screens;
  739.       ss:string[2];
  740. begin
  741. readscr (s);
  742. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
  743. write (' '); end;
  744. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
  745. write ('─'); end;
  746. for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
  747. write (' '); end;
  748. for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write ('  ');
  749. end;
  750. for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
  751. end;
  752. gotoxy (1,24); textcolor (15); textbackground (1); clreol;
  753. gotoxy (2,24); textcolor (15); textbackground (1); write (desc1);
  754. gotoxy (1,25); textcolor (15); textbackground (1); clreol;
  755. gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
  756. gotoxy (5,10); textcolor (15); textbackground (1); write ('Current Setting: ',writeto);
  757. gotoxy (5,12); textcolor (15); textbackground (1);
  758. write ('Input: ');
  759. textcolor (11);
  760. cursor (true);
  761. ii:=1;
  762. if writeto=true then temp:='Y' else if writeto=false then temp:='N';
  763. while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
  764. editline(temp,ii,12,12,buflength,ss);
  765. cursor (false);
  766. if length(temp)<1 then begin
  767. if writeto=true then temp:='Y' else if writeto=false then temp:='N';
  768. end else begin
  769. if upstring(temp)='Y' then writeto:=true else if upstring(temp)='N' then writeto:=false;
  770. end;
  771. if upstring(temp)='Y' then inputbooinfo:=true else
  772. if upstring(temp)='N' then inputbooinfo:=false;
  773. writescr (s);
  774. textcolor (15);
  775. textbackground (0);
  776. end;
  777.  
  778. {$I setup2.pas}
  779.  
  780. procedure writecurrentplace(i:integer);
  781. begin
  782. if i=1 then begin
  783. gotoxy (28,8); textcolor (15); textbackground (7); write ('» BBS Information        ');
  784. end;
  785. if i=2 then begin
  786. gotoxy (28,9); textcolor (15); textbackground (7); write ('» Modem Information      ');
  787. end;
  788. if i=3 then begin
  789. gotoxy (28,10); textcolor (15); textbackground (7); write ('» Levels                 ');
  790. end;
  791. if i=4 then begin
  792. gotoxy (28,11); textcolor (15); textbackground (7); write ('» Times                  ');
  793. end;
  794. if i=5 then begin
  795. gotoxy (28,12); textcolor (15); textbackground (7); write ('» Colors                 ');
  796. end;
  797. if i=6 then begin
  798. gotoxy (28,13); textcolor (15); textbackground (7); write ('» Conferences            ');
  799. end;
  800. if i=7 then begin
  801. gotoxy (28,14); textcolor (15); textbackground (7); write ('» CelerityNet            ');
  802. end;
  803. if i=8 then begin
  804. gotoxy (28,15); textcolor (15); textbackground (7); write ('» New User Voting        ');
  805. end;
  806. if i=9 then begin
  807. gotoxy (28,16); textcolor (15); textbackground (7); write ('» File Section Info      ');
  808. end;
  809. if i=10 then begin
  810. gotoxy (28,17); textcolor (15); textbackground (7); write ('» Strings                ');
  811. end;
  812. if i=11 then begin
  813. gotoxy (28,18); textcolor (15); textbackground (7); write ('» Miscellaneous          ');
  814. end;
  815. if i=12 then begin
  816. gotoxy (28,19); textcolor (15); textbackground (7); write ('» Exit and Save          ');
  817. end;
  818. textcolor (15);
  819. textbackground (0);
  820. end;
  821.  
  822. procedure writemainmenu;
  823. begin
  824. UNCRUNCH(SETUP_SCR,ScreenAddr[(1*2)+(1*160)-162],SETUP_SCR_LENGTH);
  825. end;
  826.  
  827. var d:char;
  828. begin
  829. clrscr;
  830. write ('View VGA Loader? [Must have VGA] [Y] ');
  831. d:=upcase(readkey);
  832. cursor (false);
  833. if (d='Y') or (d=#13) then begin mainloader; clrscr; end else
  834. if d='N' then clrscr;
  835. cursor (false);
  836. maybemakeconfig;
  837. readconfig;
  838. i1:=1;
  839. repeat
  840. writemainmenu;
  841. writecurrentplace(i1);
  842. c:=upcase(readkey);
  843. case c of
  844. 'B':begin i1:=1;
  845. end;
  846. 'M':begin i1:=2;
  847. end;
  848. 'L':begin i1:=3;
  849. end;
  850. 'T':begin i1:=4;
  851. end;
  852. 'O':begin i1:=5;
  853. end;
  854. 'C':begin i1:=6;
  855. end;
  856. 'N':begin i1:=7;
  857. end;
  858. 'V':begin i1:=8;
  859. end;
  860. 'F':begin i1:=9;
  861. end;
  862. 'S':begin i1:=10;
  863. end;
  864. 'I':begin i1:=11;
  865. end;
  866. 'E':begin i1:=12;
  867. end;
  868. #72:begin
  869. if i1=1 then i1:=13;
  870. i1:=i1-1;
  871. end;
  872. #80:begin
  873. if i1=12 then i1:=0;
  874. i1:=i1+1;
  875. end;
  876. #13:begin
  877. case i1 of
  878. 1:bbsinfo;
  879. 2:modeminfo;
  880. 3:levels;
  881. {4:usertime;}
  882. 5:colors;
  883. 6:conf;
  884. 7:netinfo;
  885. 8:nuv;
  886. 9:filesect;
  887. 10:strings;
  888. {11:misc;}
  889. 12:begin writeconfig; clrscr; cursor (true); halt (0); end;
  890. end;
  891. end;
  892. #27:begin clrscr; cursor (true); halt (0); end;
  893. end;
  894. until (0=1);
  895. end.