home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / pics16.ark / PICS2G.INC < prev    next >
Encoding:
Text File  |  1987-05-25  |  12.1 KB  |  335 lines
  1. { PICS2G.INC - Pascal Integrated Communications System Overlays}
  2. { 5/25/87 Ver 1.6 Copyright 1987 by Les Archambault}
  3.  
  4. overlay procedure toggle_printer;
  5. { Turn printer on and off }
  6.   begin
  7.     if printer_copy
  8.       then printer_copy := FALSE
  9.       else printer_copy := ask('Turn on printer');
  10.     write(USR, 'Printer o');
  11.     if printer_copy
  12.       then writeln(USR, 'n.')
  13.       else writeln(USR, 'ff.')
  14.   end;
  15.  
  16. overlay procedure process_newin;
  17. { Process and update newin file (add, delete, edit, hide, and release) }
  18.   var
  19.     ch, ch_sel: char;
  20.     i,x,TmpDrv, TmpUsr,rec: integer;
  21.     str: StrTAD;
  22.     ed_descr,line: StrStd;
  23.     temp_user_rec: user_list;
  24.     fname,work:filename;
  25.     found,none_found:boolean;
  26.  
  27.   begin
  28.     fname:=''; none_found:=true; found:=false; rec:=0;
  29.     line:=' |---------- File Description -----------------------------------------------|';
  30.     FindSect('NEWIN', TmpDrv, TmpUsr, OK);
  31.     if OK
  32.       then rec := pred(FileSize(nwin_file))
  33.       else writeln(USR, 'NEWIN section not found.');
  34.     writeln(usr);
  35.     If (OK) and (rec<0)
  36.       then if (ask('File Empty: Add first Record')) then
  37.       with Nwin_rec do
  38.       begin
  39.         name := correct_fn(prompt('File name', 12, 'ES'));
  40.         if name <> '' then
  41.           begin
  42.             while (length(name) - pos('.', name)) < 2 do
  43.               name := name + '-';
  44.             writeln(USR, line);
  45.             descr := prompt('', 75, 'EL');
  46.             GetTAD(date);
  47.             user := user_loc;
  48.             sectn:=get_section_name('D');
  49.             rec := FileSize(nwin_file);
  50.             status := public;
  51.             dnloads:=0;
  52.             for x:=0 to 5 do last_dnload[x]:=0;
  53.             rec:=0;
  54.             seek(nwin_file,rec);
  55.             write(nwin_file,nwin_rec);
  56.             writeln(usr);
  57.             writeln(usr,'First Record recorded.');
  58.             writeln(usr);
  59.           end;
  60.       end;
  61.     if ok and (rec>=0) and ask('Search for File') then
  62.       fname:=Prompt('Enter filename  (wildcards ok) ',12,'ES');
  63.     if (fname<>' ') and (fname<>'') then fname:=expand_filename(fname);
  64.     while Online and OK and (rec >= 0) and (not BRK) do
  65.       with nwin_rec do
  66.       begin
  67.           if (fname='') or (fname<>' ') then
  68.             begin
  69.               seek(nwin_file, rec);
  70.               read(nwin_file, nwin_rec);
  71.             end
  72.           else
  73.             begin
  74.               found:=false;
  75.               while OK and (rec>=0) and (not found) and (not BRK) and online do
  76.                 begin
  77.                   seek(nwin_file,rec);
  78.                   read(nwin_file,nwin_rec);
  79.                   work:=expand_filename(name);
  80.                   if equal_names(fname,work) then
  81.                     begin
  82.                       found:=true;
  83.                       none_found:=false;
  84.                     end
  85.                   else rec:=pred(rec);
  86.                 end;
  87.               if (not found) and (rec<0) then
  88.                 begin
  89.                   OK:=false;
  90.                   writeln(usr);
  91.                   if none_found then
  92.                   writeln(usr,'File not found in Newin listings.');
  93.                 end;
  94.             end;
  95.         If ok then
  96.         begin
  97.           if (user>0) and (user<=FileLen(DatF)) then
  98.             begin
  99.               GetRec(DatF, user, temp_user_rec);
  100.               if temp_user_rec.used<>0 then
  101.                 begin
  102.                   temp_user_rec.fn:='Purged';
  103.                   temp_user_rec.ln:='User';
  104.                 end;
  105.             end
  106.           else
  107.             begin
  108.               temp_user_rec.fn:='Unknown';
  109.               temp_user_rec.ln:='Sender';
  110.             end;
  111.           writeln(USR);
  112.           case status of
  113.             private: write(USR, 'Hidden    ');
  114.             public:  write(USR, 'Released  ');
  115.             deleted: write(USR, 'Deleted   ')
  116.           end;
  117.           str := intstr(date[4],2)+'/'+intstr(date[3],2)+'/'+intstr(date[5],2);
  118.           write(usr,pad(name,15),' Section: ',sectn,' ',str,'  ');
  119.           writeln(usr,temp_user_rec.fn, ' ', temp_user_rec.ln);
  120.           str := intstr(last_dnload[4],2)+'/'+intstr(last_dnload[3],2)+'/'+intstr(last_dnload[5],2);
  121.           writeln(usr,'Number downloads ',dnloads,'  Last download ',str);
  122.           writeln(usr,descr);
  123.         repeat
  124.           writeln(USR);
  125.           st:=prompt('Newin command <A><D><E><H><P><R><S><Q><?> ',80, 'ES?');
  126.           if st=' ' then ch_sel:='S'
  127.           else
  128.           if length(st)=1 then ch_sel:=st[1]
  129.           else ch_sel:='?';
  130.           case ch_sel of
  131.             'A': begin
  132.                    name := correct_fn(prompt('File name', 12, 'ES'));
  133.                    if name <> ''
  134.                      then
  135.                        begin
  136.                          while (length(name) - pos('.', name)) < 2 do
  137.                            name := name + '-';
  138.                          writeln(USR, line);
  139.                          descr := prompt('', 75, 'EL');
  140.                          GetTAD(date);
  141.                          user := user_loc;
  142.                          sectn:=get_section_name('L');
  143.                          rec := FileSize(nwin_file);
  144.                          status := public;
  145.                          dnloads:=0;
  146.                          for x:=0 to 5 do last_dnload[x]:=0;
  147.                        end
  148.                  end;
  149.             'D': status := deleted;
  150.             'E': begin
  151.                    writeln(USR);
  152.                    if ask('Change File name') then
  153.                      name:=correct_fn(prompt('New File Name',12,'ES'));
  154.                    writeln(USR, line); write(usr,'  ');
  155.                    ed_descr := descr;
  156.                    GetStr(ed_descr, ch, 75, 'E');
  157.                    descr := ed_descr;  writeln(usr);
  158.                    writeln(usr,'present Section ',sectn);
  159.                    if ask('change it') then sectn:=get_section_name('L');
  160.                    writeln(USR);
  161.                  end;
  162.             'H': status := private;
  163.             'R': status := public;
  164.             'P': begin
  165.                    if (fname<>'') and (fname<>' ') then
  166.                      begin
  167.                        found:=false;
  168.                        if rec<pred(filesize(nwin_file)) then rec:=succ(rec);
  169.                        while OK and (rec<filesize(nwin_file)) and online
  170.                        and (not found) and (not brk) do
  171.                          begin
  172.                            seek(nwin_file,rec);
  173.                            read(nwin_file,nwin_rec);
  174.                            work:=expand_filename(nwin_rec.name);
  175.                            if equal_names(fname,work) then found:=true
  176.                            else
  177.                            if rec<pred(filesize(nwin_file)) then rec:=succ(rec)
  178.                            else OK:=False;
  179.                          end;
  180.                      end
  181.                    else
  182.                      begin
  183.                        if rec<pred(filesize(nwin_file)) then rec:=succ(rec)
  184.                        else OK:=false;
  185.                      end;
  186.                  end;
  187.             'S': begin   {skip function dummy}
  188.                  end;
  189.             'Q': ok:=false;
  190.           else writeln(USR, '<A>dd, <D>elete, <E>dit, <H>ide, <P>revious, <R>elease, <S>kip, <Q>uit')
  191.           end;
  192.         until (ch_sel in ['A','D','E','H','P','R','S','Q']) or (not online);
  193.           if ch_sel in ['H', 'R']
  194.             then
  195.               begin
  196.                 SetSect(homDrv, homUsr);  {set up for loading overlay}
  197.                 hide_release(name, status,tmpdrv,tmpusr);
  198.                 SetSect(HomDrv, HomUsr);   {re-set after using overlay}
  199.               end;
  200.           if ch_sel in ['A', 'D', 'E', 'H', 'R']
  201.             then
  202.               begin
  203.                 seek(nwin_file, rec);
  204.                 write(nwin_file, nwin_rec);
  205.                 write(usr,'Newin Entry ');
  206.                 case ch_sel of
  207.                    'A' : Writeln(usr,'Added.');
  208.                    'D' : Writeln(usr,'Deleted.');
  209.                    'E' : Writeln(usr,'Recorded.');
  210.                    'H' : Writeln(usr,'Marked Hidden.');
  211.                    'R' : Writeln(usr,'Marked Released.');
  212.                  end;
  213.               end;
  214.           if (ch_sel<>'P') and (ch_sel<>'A') then rec := pred(rec);
  215.         end;  {ok}
  216.       end;    {while}
  217.   end;
  218.  
  219. overlay procedure toggle_audit;
  220. { Turn the audit trail on and off }
  221.   var
  222.     i, ext,space: integer;
  223.     t: tad_array;
  224.     AuditName,sect_name: FileName;
  225.     done:boolean;
  226.     this:sectptr;
  227.  
  228.   begin
  229.     if audit_on
  230.       then
  231.         begin
  232.           setsect(AudDrv,AudUsr);
  233.           {$I-}  Close(AuditFile); {$I+}
  234.           if ioresult=0 then
  235.           writeln(USR, 'Audit file closed.')
  236.           else writeln(usr,'Possible Audit file problem. Audit OFF.');
  237.           audit_on := FALSE;
  238.           setsect(homdrv,homusr);
  239.         end
  240.       else
  241.         begin
  242.          done:=false;
  243.          this:=sectbase;
  244.          while (this<>nil) and (this^.sectdrive<>AudDrv) and (this^.sectuser<>AudUsr) do
  245.          this:=this^.next;
  246.          if (this^.sectdrive=AudDrv) and (this^.sectuser=AudUsr) then
  247.          sect_name:=this^.sectname
  248.          else
  249.            begin
  250.              sect_name:='SYSTEM';
  251.              Auddrv:=homdrv;
  252.              Audusr:=homusr;
  253.            end;
  254.          repeat
  255.           Writeln(usr);
  256.           Write(usr,'Audit File will be written to Section: ',sect_name,' ');
  257.           Done:= (not Ask('Change it'));
  258.           if (not done) then
  259.             begin
  260.               writeln(usr);
  261.               sect_name:=get_section_name(' ');
  262.               this:=sectbase;
  263.               while (this<>nil) and (this^.sectname<>sect_name) do
  264.               this:=this^.next;
  265.               if this^.sectname=sect_name then
  266.                 begin
  267.                   Auddrv:=this^.sectdrive;
  268.                   Audusr:=this^.sectuser;
  269.                 end
  270.               else
  271.                 begin
  272.                   Auddrv:=homdrv;
  273.                   Audusr:=homusr;
  274.                 end;
  275.             end;
  276.          until (not online) or done;
  277.           GetTAD(t);
  278.           ext := 0;
  279.           setsect(AudDrv,Audusr);
  280.           repeat
  281.             AuditName := intstr(t[4], 2) + '-' + intstr(t[3], 2) + '-' +
  282.               intstr(t[5], 2) + '.' + intstr(ext, 3);
  283.             for i:= 1 to length(AuditName) do
  284.               if AuditName[i] = ' '
  285.                 then AuditName[i]:= '0';
  286.             Assign(AuditFile, AuditName);
  287.             {$I-} Reset(AuditFile) {$I+};   { Make sure it's a new file }
  288.             ext := succ(ext)
  289.           until IOresult <> 0;
  290.           Rewrite(AuditFile);
  291.           setsect(homdrv,homusr);
  292.           space:=diskfree(auddrv,audusr);
  293.           writeln(USR, 'Audit file, ', AuditName, ', ready.');
  294.           writeln(usr,'There is currently ',space,
  295.           'K space available for the audit file.');
  296.           writeln(usr,'No further disk space checking will be performed.');
  297.           writeln(usr);
  298.           audit_on := TRUE
  299.         end
  300.   end;
  301.  
  302. Overlay Procedure Clear_Heaps;
  303.   var
  304.     thisM: MesgPtr;
  305.     thisF,thisA: FilePtr;
  306.  
  307.   begin
  308.     while DirBase <> nil do            { Delete out directory linked list }
  309.       begin
  310.         thisF := DirBase;
  311.         DirBase := DirBase^.Next;      { Go to next on chain }
  312.         dispose(thisF)                  { Reclaim space }
  313.       end;
  314.     while MesgBase <> nil do                { Delete messages linked list}
  315.       begin
  316.         thisM := MesgBase;
  317.         MesgBase := MesgBase^.next;         { Go to next on list }
  318.         dispose(thisM)                       { Reclaim space }
  319.       end;
  320.     while LibBase <> nil do            { Delete out directory linked list }
  321.       begin
  322.         thisF := LibBase;
  323.         LibBase := LibBase^.Next;      { Go to next on chain }
  324.         dispose(thisF)                  { Reclaim space }
  325.       end;
  326.     while ArcBase <> nil do            { Delete out directory linked list }
  327.       begin
  328.         thisA := ArcBase;
  329.         ArcBase := ArcBase^.Next;      { Go to next on chain }
  330.         dispose(thisA)                  { Reclaim space }
  331.       end;
  332.   end;
  333.  
  334.  { end of PICS2G.inc }
  335.