home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / pics16.ark / PICS2B.INC < prev    next >
Encoding:
Text File  |  1987-05-25  |  8.9 KB  |  268 lines
  1. { PICS2B.INC - Pascal Integrated Communications System: File Sub-system }
  2. { 5/25/87 vers 1.6 Copyright 1987 by les archambault}
  3.  
  4. overlay procedure toggle_st_switch;
  5. { Toggle file size display }
  6.   begin
  7.     writeln(USR);
  8.     st_switch := not st_switch;
  9.     write(USR, 'File sizes will be shown in ');
  10.     if st_switch
  11.       then writeln(USR, 'bytes, where "k" is 1024.')
  12.       else writeln(USR, 'minutes and seconds of transfer time.')
  13.   end;
  14.  
  15. overlay procedure newin_list;
  16. { List new uploads }
  17.   var
  18.     i, line_count,conf_num: integer;
  19.     str: StrTAD;
  20.     temp_user_rec: user_list;
  21.     this:sectptr;
  22.     pages,none_found:boolean;
  23.     Fname,work:filename;
  24.  
  25.   begin
  26.     fname:='';  none_found:=true;
  27.     if ask('Search for file(s)') then
  28.       begin
  29.         fname:=prompt('Filename (wildcards ok) ',12,'ES');
  30.         if fname<>' ' then fname:=expand_filename(fname)
  31.         else fname:='';
  32.       end;
  33.     pages:=ask('Do you want page breaks');
  34.     line_count := 0;
  35.     i := pred(FileSize(nwin_file));
  36.     while (not brk) and (i >= 0) do
  37.       begin
  38.         seek(nwin_file, i);
  39.         read(nwin_file, nwin_rec);
  40.         this:=sectbase;
  41.         with nwin_rec do
  42.           begin
  43.             if status = public
  44.               then
  45.                 begin
  46.                   while (this<>nil) and (this^.sectname<>sectn) do
  47.                     this:=this^.next;
  48.                   conf_num:=this^.sectconf;
  49.                   if ((user_rec.access>=this^.sectaccs) or (test_bit(user_rec.conf_flags,conf_num))) and
  50.                   ((sectn=sectreq) or (sectreq='NEWIN') or (sectreq='SYSTEM')) then
  51.                     begin
  52.                       work:=expand_filename(name);
  53.                       if (fname='') or (equal_names(fname,work)) then
  54.                         begin
  55.                           none_found:=false;
  56.                           str := intstr(date[4],2)+'/'+intstr(date[3],2)+'/'+intstr(date[5],2);
  57.                           if (user>0) and (user<=FileLen(DatF)) then
  58.                             begin
  59.                               GetRec(DatF, user, temp_user_rec);
  60.                               if temp_user_rec.used<>0 then
  61.                                 begin
  62.                                   temp_user_rec.fn:='';
  63.                                   temp_user_rec.ln:='';
  64.                                 end;
  65.                             end
  66.                           else
  67.                             begin
  68.                               temp_user_rec.fn:='Unknown';
  69.                               temp_user_rec.ln:='Sender';
  70.                             end;
  71.  
  72.                           writeln(USR);
  73.                           write(USR, pad(name, 15),sectn,' Section ', str,'  ');
  74.                           writeln(usr,temp_user_rec.fn, ' ', temp_user_rec.ln);
  75.                           str := intstr(last_dnload[4],2)+'/'+intstr(last_dnload[3],2)+'/'+intstr(last_dnload[5],2);
  76.                           writeln(usr,'Downloads ',dnloads,'  Last download ',str);
  77.                           writeln(usr,'    ',descr);
  78.                           if (user_rec.lines <> 99) and pages
  79.                             then
  80.                               begin
  81.                                 line_count := succ(line_count);
  82.                                 if line_count mod (user_rec.lines div 4) = 0
  83.                                 then pause;
  84.                               end;
  85.                         end; {fname='' or equal names}
  86.                     end;   {print out}
  87.                 end;
  88.           end;
  89.         i := pred(i);
  90.       end;
  91.     if (none_found) and (filesize(nwin_file)>0) then
  92.       begin
  93.         writeln(usr);
  94.         write(usr,'No File(s) found in Newin list');
  95.         if (sectreq<>'NEWIN') and (sectreq<>'SYSTEM') then
  96.           begin
  97.             writeln(usr,' for this file area.');
  98.             writeln(usr,'NEWIN file area lists ALL available files.');
  99.           end
  100.         else writeln(usr,'.');
  101.         writeln(usr);
  102.       end;
  103.     if filesize(nwin_file)=0 then
  104.       begin
  105.         writeln(usr);
  106.         writeln(usr,'Newin List is empty.');
  107.         writeln(usr);
  108.       end;
  109.   end;
  110.  
  111. overlay procedure file_area_change(req: filename);
  112. { View and set up file area for use }
  113.   type
  114.      section_rec=
  115.        record
  116.          sdrive:char;
  117.          suser:integer;
  118.          saccs:integer;
  119.          confnum:integer;
  120.          sname:filename;
  121.          sdesc:strpr;
  122.          mode:char;
  123.        end;
  124.   var
  125.     sect_file:file of section_rec;
  126.     Drive, User,conf_num,line_count: integer;
  127.     sect_rec:section_rec;
  128.     this: SectPtr;
  129.     pr: StrPr;
  130.  
  131.   begin   {file area change}
  132.     assign(sect_file,sect_name+ext);
  133.     reset(sect_file);
  134.     pr:='File area';
  135.     while (not new_dir) and (req <> Sectreq) and (online) do
  136.       begin
  137.         this := SectBase;
  138.         if req = '' then
  139.           begin
  140.             req := prompt(pr, 12, 'ES?M');
  141.             if req=' ' then req:=SectReq;
  142.           end;
  143.         if req = '?' then
  144.             begin
  145.               writeln(USR, 'Available file areas:');
  146.               writeln(USR);
  147.               line_count:=2;
  148.               while (not brk) and (this <> nil) do
  149.                 begin
  150.                   conf_num:=this^.SectConf;
  151.                   if (user_rec.access >= this^.SectAccs)
  152.                   or (test_bit(user_rec.conf_flags,conf_num)) then
  153.                     begin
  154.                       seek(sect_file,this^.sectrec);
  155.                       read(sect_file,sect_rec);
  156.                       writeln(USR, pad(this^.SectName, 14), sect_rec.sdesc);
  157.                       if user_rec.lines <> 99 then
  158.                         begin
  159.                           line_count := succ(line_count);
  160.                           if line_count mod user_rec.lines = 0 then pause;
  161.                         end;
  162.                     end;
  163.                   this := this^.next
  164.                 end;
  165.               writeln(USR);
  166.               req := '';
  167.             end
  168.         else if req <> ''
  169.           then
  170.             begin
  171.               FindSect(req, Drive, User, OK);
  172.               if OK
  173.                 then
  174.                   begin
  175.                     SectReq := req;
  176.                     SetDrv  := Drive;
  177.                     SetUsr  := User;
  178.                     ReadDir(DirEntries, DirSpace, DirBase);
  179.                   end
  180.                 else
  181.                   begin
  182.                     writeln(USR, '"', req, '" not found.');
  183.                     writeln(USR);
  184.                     req:='';
  185.                   end;
  186.             end;
  187.       end;
  188.     close(sect_file);
  189.   end;
  190.  
  191. overlay procedure library;
  192. { Open and close a library }
  193.   var
  194.     i: integer;
  195.     this: FilePtr;
  196.   begin { library }
  197.     if in_library
  198.       then
  199.         begin
  200.           SetSect(SetDrv, SetUsr);          { Close file }
  201.           Close(libr_file);
  202.           SetSect(HomDrv, HomUsr);
  203.           while LibBase <> nil do           { Clean out old list }
  204.             begin
  205.               this := LibBase;
  206.               LibBase := LibBase^.Next;     { Go to next on chain }
  207.               dispose(this)                 { Reclaim space }
  208.             end;
  209.           in_library := FALSE;
  210.           writeln(USR, 'Library ', LibReq, ' closed.')
  211.         end
  212.       else
  213.         begin
  214.           LibReq := prompt('Library', 12, 'ES');
  215.           delete(LibReq, 1, pos(':', LibReq));
  216.           if LibReq <> ''
  217.             then
  218.               begin
  219.                 if pos('.', LibReq) = 0
  220.                   then LibReq := LibReq + '.LBR';
  221.                 if copy(LibReq, succ(pos('.', LibReq)), 3) = 'LBR'
  222.                   then LibReadDir(LibEntries, LibSpace, LibBase);
  223.                 if not in_library
  224.                   then writeln(USR, 'Cannot open ', LibReq, '.')
  225.               end
  226.         end
  227.   end;
  228.  
  229. overlay procedure Arc;
  230. { Open and close an Arc File }
  231.   var
  232.     i: integer;
  233.     this: FilePtr;
  234.   begin { Arc }
  235.     if in_arc
  236.       then
  237.         begin
  238.           SetSect(SetDrv,SetUsr);          { Close file }
  239.           Close(Arc_file);
  240.           SetSect(HomDrv,HomUsr);
  241.           while ArcBase <> nil do           { Clean out old list }
  242.             begin
  243.               this := ArcBase;
  244.               ArcBase := ArcBase^.Next;     { Go to next on chain }
  245.               dispose(this)                 { Reclaim space }
  246.             end;
  247.           in_arc := FALSE;
  248.           writeln(USR, 'Arc File ', ArcReq, ' closed.')
  249.         end
  250.       else
  251.         begin
  252.           ArcReq := prompt('Arc File', 12, 'ES');
  253.           delete(ArcReq, 1, pos(':', ArcReq));
  254.           if ArcReq <> ''
  255.             then
  256.               begin
  257.                 if pos('.', ArcReq) = 0
  258.                   then ArcReq := ArcReq + '.ARC';
  259.                 if copy(ArcReq, succ(pos('.', ArcReq)), 3) = 'ARC'
  260.                   then ArcReadDir(ArcEntries, ArcSpace, ArcBase);
  261.                 if not in_Arc
  262.                   then writeln(USR, 'Cannot open ', ArcReq, '.')
  263.               end
  264.         end
  265.   end;
  266.  
  267. {end of PICS2B.INC }
  268.