home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / picssup.ark / SETUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-10-18  |  15.4 KB  |  461 lines
  1. { 8/8/86 Pascal Integrated Communications System }
  2. {Installation and editor for File Sections, Message Areas and Articles.}
  3.  
  4. Program Install_sections;
  5.  
  6. const
  7.    fname='SECTION.BB#';
  8.    version='1.0';
  9.    ver_date='8/8/86';
  10.  
  11. type
  12.    str10=string[10];
  13.    strpr=string[50];
  14.    str12=string[12];
  15.  
  16.    Section_rec=
  17.      record
  18.        drive:char;
  19.        user:integer;
  20.        accs:integer;
  21.        confnum:integer;
  22.        name:str12;
  23.        desc:strpr;
  24.        mode:char;
  25.      end;
  26.  
  27. var
  28.    sect_file,temp_file: file of Section_rec;
  29.    sec_rec,temp_rec:Section_rec;
  30.    rec,i,n,x,num,err,ednum,msg_area,hi_num,lo_num:integer;
  31.    OK,edit,add,delete,found:boolean;
  32.    cur_mode,ch,dr:char;
  33.    reply:str10;
  34.    work:strpr;
  35.    new_name:str12;
  36.    line:string[80];
  37.  
  38. procedure Display;
  39.   begin
  40.     found:=false;
  41.     with sec_rec do
  42.       begin
  43.         rec:=0; hi_num:=0; lo_num:=1000;
  44.         seek(sect_file,rec);
  45.         if (cur_mode<>'Q') then
  46.           begin
  47.             writeln;  writeln;
  48.             write('                             ');
  49.             case cur_mode of
  50.               'M' : writeln('MESSAGE AREAS');
  51.               'F' : writeln('FILE AREAS');
  52.               'A' : writeln('ARTICLES');
  53.             end;
  54.             writeln(line);
  55.             write(' #     ');
  56.             if (cur_mode<>'M') then write('D/U   ');
  57.             write('accs    ');
  58.             if (cur_mode='A') then writeln('  Filename      Title')
  59.             else writeln('   Name   Cn      Description');
  60.             writeln(line);
  61.           end;
  62.         while (not eof(sect_file)) and (cur_mode<>'Q') do
  63.           begin
  64.             read(sect_file,sec_rec);
  65.             if mode=cur_mode then
  66.               begin
  67.                 found:=true;
  68.                 write(rec:3,'    ');
  69.                 if cur_mode<>'M' then
  70.                   begin
  71.                     write(drive,':');
  72.                     write(user:2,'  ');
  73.                   end;
  74.                 write(accs:3,'  ',name:12);
  75.                 if confnum>0 then write(confnum:2)
  76.                 else write(' ');
  77.                 writeln('   ',desc);
  78.                 if lo_num>rec then lo_num:=rec;
  79.                 if hi_num<rec then hi_num:=rec;
  80.               end;
  81.             if (mode='M') and (user>msg_area) then
  82.               msg_area:=user;
  83.             rec:=succ(rec);
  84.           end;
  85.         if (not found) and (cur_mode<>'Q') then writeln('No Entries Found');
  86.       end;
  87.   end;
  88.  
  89. Procedure get_reply;
  90.   begin
  91.     if OK then
  92.       begin
  93.         reply:='';
  94.         write(' > ');
  95.         readln(reply);
  96.         val(reply,num,err);
  97.         if (length(reply)>=1) and (err<>0) then ch:=upcase(reply[1])
  98.         else ch:=' ';
  99.         if (ch=' ') and (err<>0) and (cur_mode<>'X') then OK:=false;
  100.         if (cur_mode<>'X') then writeln;
  101.       end;
  102.   end;
  103.  
  104. begin  {install}
  105.   clrscr;
  106.   writeln;
  107.   writeln('Pascal Integrated Communications System');
  108.   writeln('    Version ',version,'  ',ver_date);
  109.   writeln;
  110.   line:='------------------------------------------------------------------------------';
  111.   Assign(sect_file,fname);
  112.   {$I-}  Reset(sect_file); {$I+}
  113.   OK:=(IOresult=0);
  114.   If OK then
  115.     begin  {file exists}
  116.       repeat
  117.         OK:=true;  msg_area:=0;
  118.         add:=false; edit:=false; delete:=false;
  119.         writeln;
  120.         writeln('  EDITING PICS SYSTEM SETUP FILE ');
  121.         writeln; writeln;
  122.         writeln('     <M>.....Message Areas.');
  123.         writeln('     <F>.....File Sections.');
  124.         writeln('     <A>.....Articles.');
  125.         writeln('     <CR>....Finished.');
  126.         writeln;
  127.         write('           Enter letter');
  128.         get_reply;
  129.         if ( ch in ['A','F','M']) and (reply<>'') then cur_mode:=ch
  130.         else cur_mode:='Q';
  131.       display;
  132.       If (cur_mode<>'Q') and OK then
  133.         begin
  134.           if found then
  135.             begin
  136.               writeln;
  137.               write('     <A>dd,  <D>elete,  <E>dit,  <CR> to exit');
  138.               get_reply;
  139.             end
  140.           else ch:='A';
  141.           if (ch in ['A','D','E']) and (reply<>'') then
  142.             begin
  143.               add:=false; edit:=false; delete:=false;
  144.               case ch of
  145.                 'A' : add:=true;
  146.                 'D' : delete:=true;
  147.                 'E' : edit:=true;
  148.               end;
  149.             end
  150.           else OK:=false;
  151.         end;
  152.       if OK and (cur_mode<>'Q') then
  153.         begin
  154.          repeat
  155.           writeln;
  156.           if add and OK then
  157.             begin
  158.               sec_rec.mode:=cur_mode;
  159.               writeln; writeln;
  160.               write('ADDING ');
  161.               case cur_mode of
  162.                 'M' : write('MESSAGE');
  163.                 'F' : write('FILE');
  164.                 'A' : write('ARTICLE');
  165.               end;
  166.               writeln(' ENTRY.  <Return> to exit.');
  167.               writeln;
  168.             end
  169.           else
  170.           If delete and OK then
  171.             begin
  172.               if found then
  173.                 begin
  174.                   repeat
  175.                     writeln;
  176.                     write('Number to Delete  <CR> to exit');
  177.                     get_reply;
  178.                   until (not OK) or (reply='') or ((num>=lo_num) and (num<=hi_num));
  179.                   if reply='' then ok:=false;
  180.                 end
  181.               else OK:=false;
  182.               if OK then
  183.                 begin
  184.                   writeln;
  185.                   writeln('Please wait...Deleting entry.');
  186.                   writeln;
  187.                   assign(temp_file,'SECTION.$$$');
  188.                   rewrite(temp_file);
  189.                   for x:=0 to num-1 do
  190.                     begin
  191.                       seek(sect_file,x);
  192.                       read(sect_file,sec_rec);
  193.                       write(temp_file,sec_rec);
  194.                     end;
  195.                   for x:=num+1 to filesize(sect_file)-1 do
  196.                     begin
  197.                       seek(sect_file,x);
  198.                       read(sect_file,sec_rec);
  199.                       write(temp_file,sec_rec);
  200.                     end;
  201.                   close(temp_file); close(sect_file);
  202.                   erase(sect_file);
  203.                   rename(temp_file,fname);
  204.                   reset(sect_file);
  205.                   display;
  206.                 end;
  207.             end
  208.           else
  209.           if (edit) and OK then
  210.             begin
  211.               repeat
  212.                 writeln;
  213.                 write('Number to Edit,  <CR> to exit');
  214.                 get_reply;
  215.               until (reply='') or ((num>=lo_num) and (num<=hi_num)) or (not OK);
  216.               if ok and (reply<>'') then
  217.                 begin
  218.                   ednum:=num;
  219.                   writeln;writeln;
  220.                   write('EDITING ');
  221.                   case cur_mode of
  222.                     'M' : write('MESSAGE');
  223.                     'F' : write('FILE');
  224.                     'A' : write('ARTICLE');
  225.                   end;
  226.                   writeln(' ENTRY,   <CR> if OK'); writeln;
  227.                   seek(sect_file,ednum);
  228.                   read(sect_file,sec_rec);
  229.                 end
  230.               else OK:=false;
  231.             end
  232.           else OK:=false;           {fall through}
  233.           if (not delete) and OK then
  234.             begin
  235.               if OK  then
  236.                 begin
  237.                   if cur_mode<>'A' then write('Name')
  238.                   else write('Filename');
  239.                   if edit then write(' [',sec_rec.name,'] > ')
  240.                   else write(' > ');
  241.                   write('|------------|');
  242.                   for i:=1 to 13 do write(chr(8));
  243.                   readln(new_name);
  244.                   if new_name<>'' then
  245.                     begin
  246.                       for n:=1 to length(new_name) do
  247.                         new_name[n]:=upcase(new_name[n]);
  248.                       sec_rec.name:=new_name;
  249.                     end
  250.                   else if add then OK:=false;
  251.                   writeln;
  252.                 end;
  253.               if OK then
  254.                 begin
  255.                   if edit then
  256.                     begin
  257.                       if cur_mode<>'A' then write('Description   ')
  258.                       else write('Article Title ');
  259.                       writeln(' [',sec_rec.desc,']')
  260.                     end;
  261.                   write('Description > |--------------------------------------------------|');
  262.                   for i:=1 to 51 do write(chr(8));
  263.                   readln(work);
  264.                   if work<>'' then sec_rec.desc:=work
  265.                   else if add then OK:=false;
  266.                 end;
  267.               if OK and (cur_mode<>'M') then
  268.                 begin
  269.                   writeln;
  270.                   write('Drive letter (A-P)');
  271.                   if edit then write('  [',sec_rec.drive,']');
  272.                   get_reply;
  273.                   if OK and (ch in ['A'..'P']) and (reply<>'') then
  274.                      sec_rec.drive:=ch
  275.                   else if add then OK:=false;
  276.                 end
  277.                 else sec_rec.drive:=' ';
  278.               if OK and (cur_mode<>'M') then
  279.                 begin
  280.                   write('User Area (0-15)');
  281.                   if edit then write('  [',sec_rec.user,']');
  282.                   get_reply;
  283.                   if OK and (reply<>'') then sec_rec.user:=num
  284.                   else if add then OK:=false;
  285.                 end
  286.                 else if add then sec_rec.user:=msg_area+1;
  287.               if OK then
  288.                  begin
  289.                   write('Access level required (0-255)');
  290.                   if edit then write('  [',sec_rec.accs,']');
  291.                   get_reply;
  292.                   if OK and (reply<>'') then sec_rec.accs:=num
  293.                   else if add then OK:=false;
  294.                 end;
  295.               if Ok then
  296.                 begin
  297.                   if cur_mode<>'A' then
  298.                     begin
  299.                       write('Will it be a conference (Y/N)');
  300.                       if edit then
  301.                         begin
  302.                           if sec_rec.confnum>0 then write('  [Y]')
  303.                           else write('  [N]');
  304.                         end;
  305.                       get_reply;
  306.                       if edit and (reply='') then
  307.                          if sec_rec.confnum>0 then ch:='Y'
  308.                          else ch:='N';
  309.                       if OK and (ch='Y') then
  310.                         begin
  311.                           write('Enter conference number (1-7)');
  312.                           if edit and (sec_rec.confnum>0) then
  313.                             write(' [',sec_rec.confnum,']');
  314.                           get_reply;
  315.                           if ok and (reply<>'') then sec_rec.confnum:=num
  316.                           else if add then OK:=false;
  317.                         end
  318.                         else sec_rec.confnum:=0;
  319.                     end;
  320.                 end;
  321.               if OK then
  322.                 begin
  323.                   if add then seek(sect_file,filesize(sect_file))
  324.                   else seek(sect_file,ednum);
  325.                   write(sect_file,sec_rec);
  326.                   if edit or add then display;
  327.                 end;
  328.             end;      {not delete}
  329.          until (not OK);
  330.         end;          {OK to edit or add}
  331.       until cur_mode='Q';
  332.       close(sect_file);
  333.     end
  334.   else     {file doesn't exist}
  335.     begin
  336.       OK:=true;
  337.       cur_mode:='X';
  338.       Writeln(' PICS  Sections file not found -- Creating new file.');
  339.       writeln;
  340.       Rewrite(sect_file);
  341.       writeln('The following Message Areas and File Sections are required.');
  342.       writeln('All newly created entries may be edited later by re-running');
  343.       writeln('the program on the new file.');
  344.       writeln;
  345.       writeln('Two Message Area entries will be generated without asking questions.');
  346.       writeln('Then there will be three File Section entries where you will be ');
  347.       writeln('asked for Drive and User information for your system.');
  348.       writeln;
  349.       write('Press Return to continue...');
  350.       readln(reply);
  351.       writeln;
  352.       writeln('Creating Message Area: SYSTEM');
  353.       Writeln('         Description : System global message area.');
  354.       Writeln('         Access Level: 250');
  355.       writeln;
  356.       with sec_rec do
  357.         begin
  358.           drive:=' ';
  359.           user:=0;
  360.           accs:=250;
  361.           confnum:=0;
  362.           name:='SYSTEM';
  363.           Desc:='System Message Area';
  364.           mode:='M';
  365.         end;
  366.       write(sect_file,sec_rec);
  367.       writeln;
  368.       Writeln('Creating Message Area: POST');
  369.       writeln('         Description : Initial area for entering messages.');
  370.       writeln('         Access Level: 0');
  371.       writeln;
  372.       with sec_rec do
  373.         begin
  374.           drive:=' ';
  375.           user:=1;
  376.           accs:=0;
  377.           confnum:=0;
  378.           name:='POST';
  379.           Desc:='Initial Area for entering messages';
  380.           mode:='M';
  381.         end;
  382.       write(sect_file,sec_rec);
  383.       writeln;
  384.       writeln('Creating File Section: SYSTEM');
  385.       writeln('         Description : System Command and data files.');
  386.       writeln('         Access Level: 250');
  387.       writeln;
  388.       with sec_rec do
  389.         begin
  390.           repeat
  391.             write('          Drive where System files will reside [A-J]');
  392.             get_reply;
  393.           until (ch in ['A'..'J']);
  394.           drive:=ch;
  395.           repeat
  396.             write('          User area where System files will reside [0-15]');
  397.             get_reply;
  398.           until (num in [0..15]);
  399.           user:=num;
  400.           accs:=250;
  401.           confnum:=0;      {no conference}
  402.           name:='SYSTEM';
  403.           Desc:='System Command and Data Files';
  404.           mode:='F';
  405.         end;
  406.       write(sect_file,sec_rec);
  407.       writeln;
  408.       writeln('Creating File Section: LOGIN');
  409.       writeln('         Description : Initial Section for file access.');
  410.       writeln('         Access Level: 0');
  411.       writeln;
  412.       with sec_rec do
  413.         begin
  414.           repeat
  415.             write('          Drive where you want this Section [A-J]');
  416.             get_reply;
  417.           until (ch in ['A'..'J']);
  418.           drive:=ch;
  419.           repeat
  420.             write('          User Area where you want this Section [0-15]');
  421.             get_reply;
  422.           until (num in [0..15]);
  423.           user:=num;
  424.           accs:=0;
  425.           confnum:=0;
  426.           name:='LOGIN';
  427.           Desc:='Initial Section for file access';
  428.           mode:='F';
  429.         end;
  430.         write(sect_file,sec_rec);
  431.         writeln;
  432.         writeln('Creating File Section: NEWIN');
  433.         writeln('         Description : Section for new uploaded files.');
  434.         writeln('         Access Level: 20');
  435.         writeln;
  436.         with sec_rec do
  437.           begin
  438.             repeat
  439.               write('          Drive where you want this Section [A-J]');
  440.               get_reply;
  441.             until (ch in ['A'..'J']);
  442.             drive:=ch;
  443.             repeat
  444.               write('          User Area where you want this Section [0-15]');
  445.               get_reply;
  446.             until (num in [0..15]);
  447.             user:=num;
  448.             accs:=20;
  449.             confnum:=0;
  450.             name:='NEWIN';
  451.             Desc:='New Uploaded Files Section';
  452.             mode:='F';
  453.           end;
  454.         write(sect_file,sec_rec);
  455.         writeln;
  456.         close(sect_file);
  457.         writeln('New file ',fname,' Created');
  458.     end;
  459. end.
  460.  
  461.