{ PICS2J.INC - Pascal Integrated Communications System }
{ 5/25/87 vers 1.6 Copyright 1987 by Les Archambault}

overlay  procedure delete_file;
  { Delete file from disk }
    var
      DelName: FileName;
      DelFile: file;
    begin
      if (not in_library) and (not in_arc) and ((user_rec.access > 250)
      or (not remote_copy)) then
       begin
         DelName := correct_fn(prompt('Name der zu loeschenden Datei ', 12, 'ESU'));
         if (DelName <> '') and (delname<>' ') then
           begin
             Assign(DelFile, DelName);
             SetSect(SetDrv, SetUsr);
             {$I-} Reset(DelFile) {$I+};             { Ensure file exists }
             OK := (IOresult = 0);
             if OK then
               begin
                 if ask('Wirklich loeschen') then
                   begin
                     Close(DelFile);
                     Erase(DelFile);
                     writeln(USR, DelName, ' geloescht.')
                   end
               end
             else writeln(USR, DelName, ' nicht gefunden.');
           end;
         SetSect(HomDrv, HomUsr);
         ReadDir(direntries,dirspace,dirbase);
       end
      else
      if in_library or in_arc then Writeln(usr,'Loeschen nicht zulaessig.');
    end;

 overlay procedure copy_file;
  { Copy file from one file area to another }
    var
      DstDrv, DstUsr, Remaining: integer;
      DstSect, SrcName: FileName;
      SrcFile, DstFile: file;

    procedure do_copy;
      const
        BufSize = 4;
        BufBytSize = 512;                     { BufSize * 128 }
      var
        NoOfRecsToRead: Integer;
        Buffer: array[1..BufBytSize] of Byte;
      begin
        while OK and (Remaining > 0) do
          begin
            if BufSize <= Remaining
              then NoOfRecsToRead := BufSize
              else NoOfRecsToRead := Remaining;
            SetSect(SetDrv, SetUsr);
            {$I-} BlockRead(SrcFile, Buffer, NoOfRecsToRead) {$I+};
            OK := (IOresult = 0);
            if OK
              then
                begin
                  SetSect(DstDrv, DstUsr);
                  {$I-} BlockWrite(DstFile, Buffer, NoOfRecsToRead) {$I+};
                  OK := (IOresult = 0);
                  if OK
                    then Remaining := Remaining - NoOfRecsToRead
                    else writeln(USR, 'Schreiben nicht moeglich.')
                end
              else writeln(USR, 'Lesen nicht moeglich.')
          end
      end;

    begin { copy_file }
    if (not in_library) and (not in_arc) and ((user_rec.access > 250)
    or (not remote_copy)) then
     begin
      SrcName := Correct_fn(prompt('Name der zu kopierenden Datei ', 12, 'ESU'));
      if (SrcName='') or (SrcName=' ') then OK:=False else OK:=true;
      if OK then
        begin
          Assign(SrcFile, SrcName);
          SetSect(SetDrv, SetUsr);
          {$I-} Reset(SrcFile) {$I+};           { Ensure file exists }
          OK := (IOresult = 0);
        end;
      if OK
        then
          begin
            Remaining := FileSize(SrcFile);
            SetSect(homdrv,homusr);
            DstSect := get_section_name('L');
            SetSect(setdrv,setusr);
            FindSect(DstSect, DstDrv, DstUsr, OK);
            if OK
              then
                begin
                  Assign(DstFile, SrcName);
                  SetSect(DstDrv, DstUsr);
                  {$I-} Reset(DstFile) {$I+};    { Ensure file doesn't already exist }
                  OK := (IOresult <> 0);
                  if OK
                    then
                      begin
                        {$I-} Rewrite(DstFile) {$I+};
                        OK := (IOresult = 0);
                          if OK
                            then
                              begin
                                do_copy;
                                SetSect(DstDrv, DstUsr);
                                {$I-} Close(DstFile) {$I+};
                                OK := OK and (IOresult = 0);
                                SetSect(SetDrv, SetUsr);
                                Close(SrcFile);
                                if OK
                                  then
                                    begin
                                      writeln(USR, SrcName, ' erfolgreich kopiert.');
                                      if ask('Original-Datei loeschen')
                                        then
                                          begin
                                            Erase(SrcFile);
                                            writeln(USR, 'Original-Datei geloescht.')
                                          end
                                        else writeln(USR, 'Original-Datei bleibt erhalten.')
                                    end
                                  else
                                    begin
                                      setsect(dstdrv,dstusr);
                                      close(dstfile);
                                      Erase(DstFile);
                                      writeln(USR, 'Kopieren nicht moeglich. Unvollstaendige Datei geloescht.')
                                    end
                              end
                            else writeln(USR, 'Datei kann im eingestellten Bereich nicht angelegt werden.')
                      end
                    else writeln(usr,'Datei existiert bereits im eingestellten Bereich.')
                end
              else writeln(USR, 'Eingestellten Bereich ', DstSect, ' nicht gefunden.')
          end
        else writeln(USR, 'Datei ', SrcName, ' nicht gefunden.');
      SetSect(HomDrv, HomUsr);
      ReadDir(direntries,dirspace,dirbase);
     end
     else
     if in_library or in_arc then Writeln(usr,'Kopieren nicht zulaessig.');
    end;

   overlay Procedure Rename_file;
      var
      oldname,newname:filename;
      newfile,oldfile:file;

    Begin
    if (not in_library) and (not in_arc) and ((user_rec.access > 250)
    or (not remote_copy)) then
     begin
      Writeln(usr);
      oldname:=correct_fn(prompt('Alter Dateiname ',12,'ESU'));
      If (oldname<>'') and (oldname<>' ') then
        Begin
          assign(oldfile,oldname);
          setsect(setdrv,setusr);
          {$I-} reset(oldfile); {$I+}
          ok:=(ioresult=0);
          setsect(homdrv,homusr);
          if ok then
            begin
              newname:=correct_fn(prompt('Neuer Dateiname ',12,'ESU'));
              If (newname<>'') and (newname<>' ') then
                begin
                  assign(newfile,newname);
                  setsect(setdrv,setusr);
                  {$I-} Reset(newfile); {$I+}
                  ok:=(ioresult<>0);
                  if ok then
                    begin
                      rename(oldfile,newname);
                      writeln(usr,'Datei ist umbenannt');
                    end
                  else
                    begin
                      writeln(usr,newname,' existiert bereits.');
                      close(newfile);
                      setsect(homdrv,homusr);
                    end;
                end
            else
            writeln(usr,oldname,' nicht gefunden.');
            end;
        end;
      setsect(homdrv,homusr);
      ReadDir(direntries,dirspace,dirbase);
     end
     else
     if in_library or in_arc then writeln(usr,'Umbenennen nicht zulaessig.');
    end;

(* FUER CP/M 2.2 DIESE VERSION EINSETZEN...

   overlay Procedure File_Status;
      var
      temp_file:file;
      name,workname:filename;
      i:integer;
      visible:boolean;
      this:fileptr;

    begin
    if (not in_library) and (not in_arc) and ((user_rec.access > 250)
    or (not remote_copy)) then
     begin
      writeln(usr);
      name:=correct_fn(prompt('Dateiname',12,'ESU'));
      if (name<>'') and (name<>' ') then
        begin
          this:=dirbase; workname:='';
          while (this<>nil) and (workname<>name) do
            begin
              workname:=this^.fname; {used to compare names}
              visible:=(($80 and ord(workname[11]))=0); {true when hi bit off}
              while pos(' ',workname)>0 do
                delete(workname,pos(' ',workname),1); {remove spaces}
              for i:=1 to length(workname) do
                workname[i]:=chr($7f and ord(workname[i])); {reset high bits}
              this:=this^.next;
            end;
          if workname=name then
            begin
              Write(usr,'Datei ',name,' ist ');
              if visible then writeln(usr,'sichtbar.')
              else writeln(usr,'unsichtbar.');
              if ask('Soll der Status geaendert werden') then
                begin
                  setsect(setdrv,setusr);
                  assign(temp_file,name);
                  i:=pos('.',name)+2;
                  if visible then
                      name[i]:=chr($80 or ord(name[i])); {turn sys bit on}
                  {$I-} Rename(Temp_file,name); {$I+}
                  if ioresult=0 then  writeln(usr,'Status geaendert.')
                  else writeln(usr,'Fehler - Status nicht geaendert.');
                end;
            end
          else
          Writeln(usr,name,' nicht gefunden.');
        end;
      setsect(homdrv,homusr);
      ReadDir(direntries,dirspace,dirbase);
     end
     else
     if in_library or in_arc then Writeln(usr,'ARC/LBR Status aendern nicht moeglich.');
    end;

    ...ENDE DES PATCH FUER CP/M 2.2 *)

   overlay Procedure File_Status;
      var
      temp_file:file;
      FIB: array [0..23] of byte absolute temp_file;
      name,workname:filename;
      i:integer;
      visible:boolean;
      this:fileptr;

    begin
    if (not in_library) and (not in_arc) and ((user_rec.access > 250)
    or (not remote_copy)) then
     begin
      writeln(usr);
      name:=correct_fn(prompt('Dateiname ',12,'ESU'));
      if (name<>'') and (name<>' ') then
        begin
          this:=dirbase; workname:='';
          while (this<>nil) and (workname<>name) do
            begin
              workname:=this^.fname; {used to compare names}
              visible:=(($80 and ord(workname[11]))=0); {true when hi bit off}
              while pos(' ',workname)>0 do
                delete(workname,pos(' ',workname),1); {remove spaces}
              for i:=1 to length(workname) do
                workname[i]:=chr($7f and ord(workname[i])); {reset high bits}
              this:=this^.next;
            end;
          if workname=name then
            begin
              Write(usr,'Datei ',name,' ist ');
              if visible then writeln(usr,'sichtbar.')
              else writeln(usr,'unsichtbar.');
              if ask('Soll der Status geaendert werden') then
                begin
                  setsect(setdrv,setusr);
                  assign(temp_file,name);
                  if visible then
                      FIB[22]:=$80 or FIB[22]; {turn sys bit on}
                  if BDOS(SetAttr,addr(FIB)+12)=0 then  writeln(usr,'Status geaendert.')
                  else writeln(usr,'Fehler - Status nicht geaendert.');
                end;
            end
          else
          Writeln(usr,name,' nicht gefunden.');
        end;
      setsect(homdrv,homusr);
      ReadDir(direntries,dirspace,dirbase);
     end
     else
     if in_library or in_arc then Writeln(usr,'ARC/LBR Status aendern nicht moeglich.');
    end;

overlay procedure config_sys;
  var num:integer;
      menu,ets,co,am,ll,r300,rp:char;

  procedure display_settings;
    begin
      writeln(usr);
      writeln(usr,'1...Minimum Disk Space fuer Uploads................  ', maxfree_uplds);
      writeln(usr,'2...Minimum Disk Space fuer Neue Benutzer..........  ', maxfree_logs);
      writeln(usr,'3...Minimum Disk Space fuer UNBEGRENZTE Briefe.....  ', maxfree_mslimit);
      writeln(usr,'4...Erlaubte Zeilen-Anzahl bei Begrenzter Eingabe..  ', maxfree_lines);
      writeln(usr,'5...Absolutes Minimum fuer irgendeine Operation....  ', maxfree_abs);
        write(usr,'6...Sonderzeit waehrend gewisser Zeiten............  ');
      if extra_time_sw then writeln(usr,'AN')
      else writeln(usr,'AUS');
      writeln(usr,'7...Zeit, in der Sonderzeit erlaubt ist............  ', extra_time_start,'-',extra_time_stop);
      writeln(usr,'8...Minuten der Sonderzeit.........................  ', extra_time_val);
        write(usr,'9...Dialog Funktion ist............................  ');
      if chat_ok then writeln(usr,'AN')
      else Writeln(usr,'AUS');
      writeln(usr,'10..Zeit fuer die Dialog-Funktion..................  ', chatstart,'-',chatend);
      writeln(usr,'11..Anzahl Sekunden fuer Eingabe-Timeout...........  ', sleepy_time);
      writeln(usr,'12..Maximum Versuche fuer Namen, Passwort Eingabe..  ', max_tries);
        write(usr,'13..Automatische Makro-Operation..............:....  ');
      if auto_macro then writeln(usr,'AN')
      else writeln(usr,'AUS');
      writeln(usr,'14..Start-Zeitpunkt fuer Auto-Makro-Ausfuehrung....  ', auto_macro_start);
        write(usr,'15..Limit fuer maximale Anzahl Zeilen in Brief.....  ');
      if limit_lines then writeln(usr,'AN')
      else writeln(usr,'AUS');
      writeln(usr,'16..Maximum Anzahl erlaubter Zeilen in Brief.......  ', max_msg_lines);
        write(usr,'17..300 Baud Anrufer-Sperre........................  ');
      if restrict300 then writeln(usr,'AN')
      else writeln(usr,'AUS');
      writeln(usr,'18..Zeit fuer 300 Baud Anrufer-Sperre..............  ', start_restrict300,'-',end_restrict300);
      writeln(usr,'19..Erlaubte Downloads pro Upload [0=unbegrenzt]...  ', up_down_ratio);
        write(usr,'20..Oeffentl. Briefe muessen auf Sysop-OK warten...  ');
      if restrict_public then writeln(usr,'JA')
      else writeln(usr,'NEIN');
      seek(logr_file,0); read(logr_file,logr_rec);
      writeln(usr,'21..Anrufer Nummer.................................  ', logr_rec.user);
    end;

begin  {config sys}
  repeat
    writeln(usr);
    st:=prompt('<S>ystem-, <R>einigungs-Parameter, <Q>uit ',10,'ES');
    if (length(st)=1) and (st<>' ') then menu:=st[1]
    else menu:='Q';
    if (menu in ['S','R']) then
      repeat
        writeln(usr);
        if menu='S' then display_settings
        else display_purge_settings;
        writeln(usr);
        num:=strint(prompt('Nummer zu aendern...mit <Return> weiter ',2,'E'));
        if Menu='S' then change_settings(num)
        else change_purge_settings(num);
      until (num=0) or (not online);
  until (menu='Q') or (not online);
  if online then Write_Config_File;
end;

Overlay Procedure Articles;
  type
     section_rec=
       record
         sdrive:char;
         suser:integer;
         saccs:integer;
         confnum:integer;
         sname:filename;
         sdesc:strpr;
         mode:char;
       end;
  var
       sect_file:file of section_rec;
       this:artptr;
       sect_rec:section_rec;
       num:integer;
  begin
    If ArtBase<>Nil then
      begin
        assign(sect_file,sect_name+ext);
        reset(sect_file);
        repeat
          this:=artbase;
          writeln(usr);
          writeln(usr,'VORHANDENE ARTIKEL ZUM LESEN');
          writeln(usr);
          while (this<>nil) do      
            begin
              seek(sect_file,this^.artrec);
              read(sect_file,sect_rec);
              if (user_rec.access>=this^.artaccs) then
              writeln(usr,this^.artnum,'   ',sect_rec.sdesc);
              this:=this^.next;
            end;
          writeln(usr);
          num:=strint(prompt('Nummer des zu lesenden Artikels [0 = Ende] ',3,'E'));
          this:=artbase;
          while (this<>nil) and (this^.artnum<>num) do this:=this^.next;
          if (this^.artnum=num) and (user_rec.access>=this^.artaccs) then
            List_file(this^.artname,this^.artdrive,this^.artuser);
        until (not online) or (num=0);
        close(sect_file);
      end
    else
      begin
        writeln(usr);
        writeln(usr,' Momentan sind keine Artikel erreichbar.');
        writeln(usr);
      end;
  end;

{ end of PICS2J.inc }