{ PICS2G.INC - Pascal Integrated Communications System Overlays}
{ 5/25/87 Ver 1.6 Copyright 1987 by Les Archambault}

overlay procedure toggle_printer;
{ Turn printer on and off }
  begin
    if printer_copy
      then printer_copy := FALSE
      else printer_copy := ask('Drucker einschalten');
    write(USR, 'Drucker a');
    if printer_copy
      then writeln(USR, 'n.')
      else writeln(USR, 'us.')
  end;

overlay procedure process_newin;
{ Process and update newin file (add, delete, edit, hide, and release) }
  var
    ch, ch_sel: char;
    i,x,TmpDrv, TmpUsr,rec: integer;
    str: StrTAD;
    ed_descr,line: StrStd;
    temp_user_rec: user_list;
    fname,work:filename;
    found,none_found:boolean;

  begin
    fname:=''; none_found:=true; found:=false; rec:=0;
    line:=' |---------- Datei-Beschreibung ---------------------------------------------|';
    FindSect('NEWIN', TmpDrv, TmpUsr, OK);
    if OK
      then rec := pred(FileSize(nwin_file))
      else writeln(USR, 'Bereich NEWIN nicht gefunden.');
    writeln(usr);
    If (OK) and (rec<0)
      then if (ask('Datei ist leer: Ersten Eintrag machen')) then
      with Nwin_rec do
      begin
        name := correct_fn(prompt('Dateiname ', 12, 'ES'));
        if name <> '' then
          begin
            while (length(name) - pos('.', name)) < 2 do
              name := name + '-';
            writeln(USR, line);
            descr := prompt('', 75, 'EL');
            GetTAD(date);
            user := user_loc;
            sectn:=get_section_name('D');
            rec := FileSize(nwin_file);
            status := public;
            dnloads:=0;
            for x:=0 to 5 do last_dnload[x]:=0;
            rec:=0;
            seek(nwin_file,rec);
            write(nwin_file,nwin_rec);
            writeln(usr);
            writeln(usr, 'Erster Eintrag gespeichert.');
            writeln(usr);
          end;
      end;
    if ok and (rec>=0) and ask('Datei suchen') then
      fname:=Prompt('Dateiname  (Wildcards ok) ',12,'ES');
    if (fname<>' ') and (fname<>'') then fname:=expand_filename(fname);
    while Online and OK and (rec >= 0) and (not BRK) do
      with nwin_rec do
      begin
          if (fname='') or (fname=' ') then
            begin
              seek(nwin_file, rec);
              read(nwin_file, nwin_rec);
            end
          else
            begin
              found:=false;
              while OK and (rec>=0) and (not found) and (not BRK) and online do
                begin
                  seek(nwin_file,rec);
                  read(nwin_file,nwin_rec);
                  work:=expand_filename(name);
                  if equal_names(fname,work) then
                    begin
                      found:=true;
                      none_found:=false;
                    end
                  else rec:=pred(rec);
                end;
              if (not found) and (rec<0) then
                begin
                  OK:=false;
                  writeln(usr);
                  if none_found then
                  writeln(usr,'Datei nicht gefunden in Newin Listings.');
                end;
            end;
        If ok then
        begin
          if (user>0) and (user<=FileLen(DatF)) then
            begin
              GetRec(DatF, user, temp_user_rec);
              if temp_user_rec.used<>0 then
                begin
                  temp_user_rec.fn:='Benutzer:';
                  temp_user_rec.ln:='Bereinigt';
                end;
            end
          else
            begin
              temp_user_rec.fn:='Absender:';
              temp_user_rec.ln:='Unbekannt';
            end;
          writeln(USR);
          case status of
            private: write(USR, 'Versteckt    ');
            public:  write(USR, 'Freigegeben  ');
            deleted: write(USR, 'Geloescht    ')
          end;
          str := intstr(date[3],2)+'-'+intstr(date[4],2)+'-'+intstr(date[5],2);
          write(usr,pad(name,15),' Bereich: ',sectn,' ',str,'  ');
          writeln(usr,temp_user_rec.fn, ' ', temp_user_rec.ln);
          str := intstr(last_dnload[3],2)+'-'+intstr(last_dnload[4],2)+'-'+intstr(last_dnload[5],2);
          writeln(usr,'Anzahl Downloads ',dnloads,' -- Letzter Zugriff: ',str);
          writeln(usr,descr);
        repeat
          writeln(USR);
          st:=prompt('Newin Befehl <A><F><H><L><V><W><Z><Q><?> ',80, 'ES?');
          if st=' ' then ch_sel:='W'
          else
          if length(st)=1 then ch_sel:=st[1]
          else ch_sel:='?';
          case ch_sel of
            'H': begin
                   name := correct_fn(prompt('Dateiname ', 12, 'ES'));
                   if name <> ''
                     then
                       begin
                         while (length(name) - pos('.', name)) < 2 do
                           name := name + '-';
                         writeln(USR, line);
                         descr := prompt('', 75, 'EL');
                         GetTAD(date);
                         user := user_loc;
                         sectn:=get_section_name('L');
                         rec := FileSize(nwin_file);
                         status := public;
                         dnloads:=0;
                         for x:=0 to 5 do last_dnload[x]:=0;
                       end
                 end;
            'L': status := deleted;
            'A': begin
                   writeln(USR);
                   if ask('Dateiname aendern') then
                     name:=correct_fn(prompt('Neuer Dateiname ',12,'ES'));
                   writeln(USR, line); write(usr,'  ');
                   ed_descr := descr;
                   GetStr(ed_descr, ch, 75, 'E');
                   descr := ed_descr;  writeln(usr);
                   writeln(usr,'gegenwaertiger Bereich ',sectn);
                   if ask('Aendern') then sectn:=get_section_name('L');
                   writeln(USR);
                 end;
            'V': status := private;
            'F': status := public;
            'Z': begin
                   if (fname<>'') and (fname<>' ') then
                     begin
                       found:=false;
                       if rec<pred(filesize(nwin_file)) then rec:=succ(rec);
                       while OK and (rec<filesize(nwin_file)) and online
                       and (not found) and (not brk) do
                         begin
                           seek(nwin_file,rec);
                           read(nwin_file,nwin_rec);
                           work:=expand_filename(nwin_rec.name);
                           if equal_names(fname,work) then found:=true
                           else
                           if rec<pred(filesize(nwin_file)) then rec:=succ(rec)
                           else OK:=False;
                         end;
                     end
                   else
                     begin
                       if rec<pred(filesize(nwin_file)) then rec:=succ(rec)
                       else OK:=false;
                     end;
                 end;
            'W': begin   {skip function dummy}
                 end;
            'Q': ok:=false;
          else
            begin
              writeln(USR, '<A>endern, <F>reigeben, <H>inzufuegen, <L>oeschen,');
              writeln(USR, '<V>erstecken, <W>eiter, <Z>urueck, <Q>uit')
            end
          end;
        until (ch_sel in ['A','F','H','L','V','W','Z','Q']) or (not online);
          if ch_sel in ['V', 'F']
            then
              begin
                SetSect(homDrv, homUsr);  {set up for loading overlay}
                hide_release(name, status,tmpdrv,tmpusr);
                SetSect(HomDrv, HomUsr);   {re-set after using overlay}
              end;
          if ch_sel in ['H', 'L', 'A', 'V', 'F']
            then
              begin
                seek(nwin_file, rec);
                write(nwin_file, nwin_rec);
                write(usr,'Newin Eintrag ');
                case ch_sel of
                   'H' : Writeln(usr,'hinzugefuegt.');
                   'L' : Writeln(usr,'geloescht.');
                   'A' : Writeln(usr,'geaendert.');
                   'V' : Writeln(usr,'versteckt.');
                   'F' : Writeln(usr,'freigegeben.');
                 end;
              end;
          if (ch_sel<>'Z') and (ch_sel<>'H') then rec := pred(rec);
        end;  {ok}
      end;    {while}
  end;

overlay procedure toggle_audit;
{ Turn the audit trail on and off }
  var
    i, ext,space: integer;
    t: tad_array;
    AuditName,sect_name: FileName;
    done:boolean;
    this:sectptr;

  begin
    if audit_on
      then
        begin
          setsect(AudDrv,AudUsr);
          {$I-}  Close(AuditFile); {$I+}
          if ioresult=0 then
          writeln(USR, 'Audit File geschlossen.')
          else writeln(usr,'Moegliches Audit File Problem. Audit AUS.');
          audit_on := FALSE;
          setsect(homdrv,homusr);
        end
      else
        begin
         done:=false;
         this:=sectbase;
         while (this<>nil) and (this^.sectdrive<>AudDrv) and (this^.sectuser<>AudUsr) do
         this:=this^.next;
         if (this^.sectdrive=AudDrv) and (this^.sectuser=AudUsr) then
         sect_name:=this^.sectname
         else
           begin
             sect_name:='SYSTEM';
             Auddrv:=homdrv;
             Audusr:=homusr;
           end;
         repeat
          Writeln(usr);
          Write(usr,'Audit File wird in den Bereich: ',sect_name,' geschrieben ');
          Done:= (not Ask('Aendern'));
          if (not done) then
            begin
              writeln(usr);
              sect_name:=get_section_name(' ');
              this:=sectbase;
              while (this<>nil) and (this^.sectname<>sect_name) do
              this:=this^.next;
              if this^.sectname=sect_name then
                begin
                  Auddrv:=this^.sectdrive;
                  Audusr:=this^.sectuser;
                end
              else
                begin
                  Auddrv:=homdrv;
                  Audusr:=homusr;
                end;
            end;
         until (not online) or done;
          GetTAD(t);
          ext := 0;
          setsect(AudDrv,Audusr);
          repeat
            AuditName := intstr(t[3], 2) + '-' + intstr(t[4], 2) + '-' +
              intstr(t[5], 2) + '.' + intstr(ext, 3);
            for i:= 1 to length(AuditName) do
              if AuditName[i] = ' '
                then AuditName[i]:= '0';
            Assign(AuditFile, AuditName);
            {$I-} Reset(AuditFile) {$I+};   { Make sure it's a new file }
            ext := succ(ext)
          until IOresult <> 0;
          Rewrite(AuditFile);
          setsect(homdrv,homusr);
          space:=diskfree(auddrv,audusr);
          writeln(USR, 'Audit File, ', AuditName, ', ist aktiv.');
          writeln(usr,'Momentan ist ',space,'k Speicher fuer das Audit File vorhanden.');
          writeln(usr);
          audit_on := TRUE
        end
  end;

Overlay Procedure Clear_Heaps;
  var
    thisM: MesgPtr;
    thisF,thisA: FilePtr;

  begin
    while DirBase <> nil do            { Delete out directory linked list }
      begin
        thisF := DirBase;
        DirBase := DirBase^.Next;      { Go to next on chain }
        dispose(thisF)                  { Reclaim space }
      end;
    while MesgBase <> nil do                { Delete messages linked list}
      begin
        thisM := MesgBase;
        MesgBase := MesgBase^.next;         { Go to next on list }
        dispose(thisM)                       { Reclaim space }
      end;
    while LibBase <> nil do            { Delete out directory linked list }
      begin
        thisF := LibBase;
        LibBase := LibBase^.Next;      { Go to next on chain }
        dispose(thisF)                  { Reclaim space }
      end;
    while ArcBase <> nil do            { Delete out directory linked list }
      begin
        thisA := ArcBase;
        ArcBase := ArcBase^.Next;      { Go to next on chain }
        dispose(thisA)                  { Reclaim space }
      end;
  end;

 { end of PICS2G.inc }