home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / bbs / prpics10.arc / PRPICS10.PAS < prev   
Pascal/Delphi Source File  |  1991-08-11  |  4KB  |  153 lines
  1. { Print out listings  for Pics File Sections, Message Areas and Articles. }
  2. { Version 1.0 4/27/87 -      Written by Byron McKay, wrote original program
  3. from Les Archambault's Setup.pas program, added printout and usage of Epson
  4. printer codes to spice things up - change lines noted for different printer
  5. type. - BAM
  6. }
  7. { Thanks to Les Archambault, who wrote the original Setup.pas file for PICS
  8.   This program is released freely to the public domain, unsupported, with
  9.   no gaurantees, and my heartfelt best wishes... the way it should be!
  10.  
  11. Usage:
  12.  
  13. Place on same drive and user (subdirectory) as PICS setup file, then type:
  14.  
  15.    PRSETUP<CR>
  16.  
  17. IT'S ALL DOWNHILL FROM THERE!
  18. }
  19.  
  20. Program Print_sections;
  21.  
  22. const
  23.    fname='SECTION.BB#';
  24.    version='1.0';
  25.    ver_date='8/8/86';
  26.  
  27. type
  28.    str10=string[10];
  29.    strpr=string[50];
  30.    str12=string[12];
  31.  
  32.    Section_rec=
  33.      record
  34.        drive:char;
  35.        user:integer;
  36.        accs:integer;
  37.        confnum:integer;
  38.        name:str12;
  39.        desc:strpr;
  40.        mode:char;
  41.      end;
  42.  
  43. var
  44.    sect_file,temp_file: file of Section_rec;
  45.    sec_rec,temp_rec:Section_rec;
  46.    rec,i,n,x,num,err,ednum,msg_area,hi_num,lo_num:integer;
  47.    OK,found:boolean;
  48.    cur_mode,ch,dr:char;
  49.    reply:str10;
  50.    work:strpr;
  51.    new_name:str12;
  52.    line:string[80];
  53.  
  54. procedure Display;
  55.   begin
  56.     found:=false;
  57.     with sec_rec do
  58.       begin
  59.         rec:=0; hi_num:=0; lo_num:=1000;
  60.         seek(sect_file,rec);
  61.         if (cur_mode<>'Q') then
  62.           begin
  63.             writeln(lst,#27'@');  writeln(lst);
  64.             case cur_mode of
  65.               'M' : writeln(lst,#14'MESSAGE AREAS');
  66.               'F' : writeln(lst,#14'FILE AREAS');
  67.               'A' : writeln(lst,#14'ARTICLES');
  68.             end;
  69.             writeln(lst,line);
  70.             write(lst,' #     ');
  71.             if (cur_mode<>'M') then write(lst,'D/U   ');
  72.             write(lst,'accs    ');
  73.             if (cur_mode='A') then writeln(lst,'  Filename      Title')
  74.             else writeln(lst,'   Name   Cn      Description');
  75.             writeln(lst,line);
  76.           end;
  77.         while (not eof(sect_file)) and (cur_mode<>'Q') do
  78.           begin
  79.             read(sect_file,sec_rec);
  80.             if mode=cur_mode then
  81.               begin
  82.                 found:=true;
  83.                 write(lst,rec:3,'    ');
  84.                 if cur_mode<>'M' then
  85.                   begin
  86.                     write(lst,drive,':');
  87.                     write(lst,user:2,'  ');
  88.                   end;
  89.                 write(lst,accs:3,'  ',name:12);
  90.                 if confnum>0 then write(lst,confnum:2)
  91.                 else write(lst,' ');
  92.                 writeln(lst,'   ',desc);
  93.                 if lo_num>rec then lo_num:=rec;
  94.                 if hi_num<rec then hi_num:=rec;
  95.               end;
  96.             if (mode='M') and (user>msg_area) then
  97.               msg_area:=user;
  98.             rec:=succ(rec);
  99.           end;
  100.         if (not found) and (cur_mode<>'Q') then writeln(lst,'No Entries Found');
  101.       end;
  102.   end;
  103.  
  104. Procedure get_reply;
  105.   begin
  106.     if OK then
  107.       begin
  108.         reply:='';
  109.         write(' > ');
  110.         readln(reply);
  111.         val(reply,num,err);
  112.         if (length(reply)>=1) and (err<>0) then ch:=upcase(reply[1])
  113.         else ch:=' ';
  114.         if (ch=' ') and (err<>0) and (cur_mode<>'X') then OK:=false;
  115.         if (cur_mode<>'X') then writeln;
  116.       end;
  117.   end;
  118.  
  119. begin  {install}
  120.   clrscr;
  121.   writeln;
  122.   writeln('Pascal Integrated Communications System');
  123.   writeln('    Version ',version,'  ',ver_date);
  124.   writeln;
  125.   line:='------------------------------------------------------------------------------';
  126.   Assign(sect_file,fname);
  127.   {$I-}  Reset(sect_file); {$I+}
  128.   OK:=(IOresult=0);
  129.   If OK then
  130.     begin  {file exists}
  131.       repeat
  132.         OK:=true;  msg_area:=0;
  133.         writeln;
  134.         writeln('  EDITING PICS SYSTEM SETUP FILE ');
  135.         writeln; writeln;
  136.         writeln('     <M>.....Message Areas.');
  137.         writeln('     <F>.....File Sections.');
  138.         writeln('     <A>.....Articles.');
  139.         writeln('     <CR>....Finished.');
  140.         writeln;
  141.         write('           Enter letter');
  142.         get_reply;
  143.         if ( ch in ['A','F','M']) and (reply<>'') then cur_mode:=ch
  144.         else cur_mode:='Q';
  145.       display;
  146.       writeln(lst,^l);
  147.       until cur_mode='Q';
  148.       close(sect_file);
  149.     end
  150.  end.
  151. end.
  152.  
  153.