S=1850;
MODULE BACKUP;
/*--------------------------------------------------------------------*/
/* KOPIERPROGRAMM, UM UNTER DEM NEUEN RTOS MASSENKOPIEN EINER DISK    */
/* ANZUFERTIGEN. DIESES PROGRAMM IST EINE WEITERENTWICKLUNG DES       */
/* PROGRAMMES BACKUP DER UTILITY DISKETTE.                            */
/* ES WURDEN FOLGENDE ERWEITERUNGEN EINGEFUEHRT:                      */
/* - ES LASSEN SICH JETZT BEIDE LAUFWERKE VERWENDEN -                 */
/* - DAS PROGRAMM ERKENNT NICHT- ODER FREMDFORMATIERTE DISKETTEN BZW. */
/*   BESCHRIEBENE DISKETTEN UND FRAGT OB DIESE FORMATIERT WERDEN      */
/*   SOLLEN.                                                          */
/* - DAS PROGRAMM FORMATIERT DISKETTEN.                               */
/* - MIT DER TASK NOTAUS LASSEN SICH DIE IN DEN SPEICHER GELADENEN    */
/*   FILES DER QUELLDISK WIEDER ENTFERNEN, FALLS MAN DAS PROGRAMM     */
/*   ABBRICHT ODER ES AUS ANDEREN GRUENDEN ZUM ABBRUCH KOMMT.         */
/*   DIE TASK PRODUZIERT EINE GANZE REIHE FEHLERMELDUNGEN, DIE MAN    */
/*   ABER IGNORIEREN KANN. SIE ARBEITET WIE MAN ES ERWARTET.          */
/* - DAS PROGRAMM WIRD MIT START GESTARTET.                           */
/*                                                                    */
/* H. EHRLICH                                    HANNOVER MAI 1988    */
/*--------------------------------------------------------------------*/
/*-L-*/
SYSTEM;
   COM:XC->;
   VO:VO.BACKUP;
   VI:VI.BACKUP;
   DIALOG:A1 <->;
   DISK0 :F0(NE);
   DISK1 :F1(NE);
PROBLEM;
   SPC (COM,VO) DATION   OUT ALPHIC CONTROL(ALL);
   SPC VI       DATION IN    ALPHIC CONTROL(ALL);
   SPC DIALOG   DATION INOUT ALPHIC CONTROL(ALL);
   SPC DISK0    DATION INOUT ALPHIC CONTROL(ALL);
   SPC DISK1    DATION INOUT ALPHIC CONTROL(ALL);
   SPC (COP,NOTAUS) TASK;
   DCL TN CHAR(8);            /* MAX. 8STELLIGER TASK-NAME   */
   DCL (QF,ZF) CHAR(2);
   DCL FORMINFO CHAR(16);

/*====================================================================*/
/*                           PROZEDUREN                               */
/*--------------------------------------------------------------------*/
WENNJA:PROC RETURNS (BIT);         /* RETURNS '1', WENN 'J' GEDRUECKT */
       DCL  JA BIT INIT ('0'B),
            IN CHAR INIT (' ');
     GET IN FROM DIALOG BY SKIP,A;
     IF (IN=='J') OR (IN=='j') THEN JA='1'B;
       FIN;
     PUT TO DIALOG BY SKIP;
     RETURN (JA);
END;
/*--------------------------------------------------------------------*/
FORM: PROC (INFO CHAR(16));
   PUT 'SU COP; ' CAT INFO CAT ' -- C COP' TO COM BY LIST, SKIP;
END;
/*--------------------------------------------------------------------*/
DTEST: PROC (LW CHAR(2)) RETURNS (BIT);    /* RETURNS '1' FALLS DIE   */
   DCL GUT INV BIT INIT ('1'B),            /* DISK FORMATIERT IST     */
       NIX INV BIT INIT ('0'B);
   DCL OK BIT;
   DCL DUMMY CHAR;
   DCL STATUS FIXED(15);
   IF FORMINFO EQ 'IST FORMATIERT !' 
   THEN RETURN (GUT);
   FIN;
   IF LW EQ 'F0'
   THEN GET DUMMY FROM DISK0 BY A;
        STATUS=ST(DISK0);
   ELSE GET DUMMY FROM DISK1 BY A;
        STATUS=ST(DISK1);
   FIN;
   PUT 'STATUS ',LW,':= ',STATUS, ' SIEHE HANDBUCH C-III-18' 
   TO DIALOG BY (3)A,F(3),A,SKIP;
   IF STATUS EQ 34 THEN STATUS = 1; FIN;
   IF STATUS EQ 45 THEN STATUS = 2; FIN;
   IF (STATUS EQ 00 OR STATUS EQ 50) THEN STATUS = 3; FIN;
   CASE STATUS
      ALT /* DISK NICHT FORMATIERT */
         CALL FORM (FORMINFO);
         RETURN (GUT);
      ALT /* KEIN RTOS FORMAT */
         PUT 'DIE DISKETTE HAT EIN FREMDFORMAT !' TO DIALOG BY A,SKIP;
         PUT 'SOLL ICH FORMATIEREN ? (J/N)      ' TO DIALOG BY A;
         OK= WENNJA;
         IF OK THEN
            CALL FORM (FORMINFO);
            RETURN (GUT);
         ELSE
            PUT 'LEGEN SIE EINE ANDERE DISKETTE EIN ODER DRUECKEN SIE J,
             ' TO DIALOG BY A,SKIP;
            PUT 'WENN ICH DIESE NEHMEN SOLL' TO DIALOG BY A,SKIP;
            PUT 'STARTKLAR ? (J/N)' TO DIALOG BY A,SKIP;
            OK =WENNJA;
            IF OK THEN
              CALL FORM (FORMINFO);
              RETURN (GUT);
            ELSE
              RETURN (NIX);
            FIN;
         FIN;
      ALT /* DIE DISKETTE IST IM RTOS FORMAT, ABER NICHT LEER */
         PUT 'SU ',TN,'; DIR ',ZF,': -- C ',TN TO COM BY (6)A, SKIP;
         PUT 'SOLL ICH DIE DISK FORMATIEREN? (J/N)' TO DIALOG BY A;
         OK =WENNJA;
         IF OK THEN
            CALL FORM (FORMINFO);
         ELSE
            PUT 'LEGEN SIE EINE ANDERE DISKETTE EIN ODER DRUECKEN SIE J,
             ' TO DIALOG BY A,SKIP;
            PUT 'WENN ICH DIESE NEHMEN SOLL' TO DIALOG BY A,SKIP;
            PUT 'STARTKLAR ? (J/N)' TO DIALOG BY A,SKIP;
            OK =WENNJA;
            IF OK THEN
              CALL FORM (FORMINFO);
              RETURN (GUT);
            ELSE
              RETURN (NIX);
            FIN;
         FIN;
      OUT /* IRGENDETWAS STIMMT NICHT */
         PUT 'IRGENDETWAS STIMMT NICHT!' TO DIALOG BY A,SKIP;
         RETURN (NIX);
      FIN;
END;
/*--------------------------------------------------------------------*/
/* EXTRAHIERT ALLE DATEINAMEN AUS DEM DIRECTORY                       */
/*   EINGABEN:  LAUFWERK, MAX. ANZAHL DER DATEIEN                     */
/*   AUSGABEN:  FELD MIT DATEINAMEN, ANZAHL DER DATEIEN               */
/* BEI FLOPPYFEHLER WIRD DIE RUFENDE TASK TERMINIERT                  */

EXTNAMEN: PROC (LW CHAR(2), NAME() CHAR(8) IDENT,
                LIMIT FIXED, ANZAHL FIXED IDENT);
          DCL LINE CHAR(80), LAST CHAR(8) INIT ('* ENDE *'),
              NAM  CHAR(8), (A,NUMMER) FIXED;
 PUT 'SU ',TN,';O VO.BACKUP;DIR ',LW,'.--C ',TN TO COM BY (6)A,SKIP;
 PUT LAST >< TOCHAR(13) TO VO BY A;
 GET LINE FROM VI BY A;
 NAM=LINE;
 IF NAM==LAST
    THEN PUT 'Floppyfehler: DIR nicht lesbar','Abbruch'
              TO DIALOG BY SKIP,A,SKIP,A,(2)SKIP;
         TERMINATE;
   FIN;
 ANZAHL=0; NUMMER=0;
 WHILE (ANZAHL<LIMIT) AND (NAM/=LAST) REPEAT;
   IF NUMMER==0 THEN GET LINE FROM VI BY A;
      FIN;
   FOR I TO 8 REPEAT;
     NAM.CHAR(I)=LINE.CHAR(NUMMER*16+I);
    END;
   IF (NAM.CHAR(1)/='*') AND (NAM.CHAR(1)/=' ')
                THEN ANZAHL=ANZAHL+1;
                     NAME(ANZAHL)=NAM;
      FIN;
   IF NUMMER==4 THEN NUMMER=0;
                ELSE NUMMER=NUMMER+1;
      FIN;
  END;
END;
/*--------------------------------------------------------------------*/
LOESCHEN: PROC (NAME() CHAR(8) IDENT, ANZAHL FIXED);
    FOR I TO ANZAHL REPEAT;
       PUT 'ERASE ED.',NAME(I) TO COM BY (2)A,SKIP;
    END;                                                               
END;
/*--------------------------------------------------------------------*/
LESEN: PROC (LW CHAR(2), NAME() CHAR(8) IDENT, ANZAHL FIXED);
    PUT TO DIALOG BY SKIP;
    FOR I TO ANZAHL REPEAT
       PUT LW,'.',NAME(I),' --> ED' TO DIALOG BY SKIP,(4)A;
       PUT 'SU ',TN,';COPY ',LW,'.',NAME(I),'>ED.',NAME(I),'--C ',TN
           TO COM BY (10)A,SKIP;
     END;
END;
/*--------------------------------------------------------------------*/
SCHREIBEN: PROC (LW CHAR(2), NAME() CHAR(8) IDENT, ANZAHL FIXED);
    DCL OK BIT;
    PUT TO DIALOG BY SKIP;
    FOR I TO ANZAHL REPEAT
       PUT 'ED.',NAME(I),' --> ',LW TO DIALOG BY SKIP,(4)A;
       PUT 'SU ',TN,';COPY ED.',NAME(I),'>',LW,'.',NAME(I),'--C ',TN
            TO COM BY (10)A,SKIP;
     END;
END;
/*--------------------------------------------------------------------*/
ACTION: PROC (NAME() CHAR(8) IDENT, ANZAHL FIXED);
    DCL (OK, GUT) BIT;
    CALL LESEN (QF,NAME,ANZAHL);
    PUT 'Liegt eine neue Disk in ',ZF,': ? (J/N) '
         TO DIALOG BY SKIP,(3)A;
    OK=WENNJA;
    IF NOT OK
       THEN PUT 'Achtung! Ein erneutes NEIN fuehrt zum Programmabbruch',
                'Eine Kopie? Ja oder nein? '
                 TO DIALOG BY SKIP,A;
            OK=WENNJA;
      FIN;
    GUT= DTEST (ZF);
    WHILE (OK AND GUT) REPEAT
       CALL SCHREIBEN (ZF,NAME,ANZAHL);
       PUT 'Noch eine Kopie? (J/N) ' TO DIALOG BY SKIP,A;
       OK=WENNJA;
       IF NOT OK
          THEN PUT 'War das "NEIN" ernst gemeint? '
                    TO DIALOG BY A;
               OK=NOT WENNJA;
        FIN;
      END;
    IF NOT GUT 
    THEN PUT 'DAS FORMATIEREN HAT NICHT GEKLAPPT !!!'
         TO DIALOG BY A, SKIP;
         PUT 'NEU STARTEN !!!' TO DIALOG BY A,  SKIP;
    FIN;
    CALL LOESCHEN (NAME,ANZAHL);
END;
/*====================================================================*/
/*                           TASKS                                    */
COP: TASK PRIO 100;
DCL NAME(160) CHAR(8), LIMIT FIXED INIT(160), ANZAHL FIXED;
DCL OK BIT INIT ('0'B);
  TN = 'COP     ';
  WHILE NOT OK REPEAT
   PUT 'Bitte die Master-Diskette in ',QF,': einlegen und ',
       'mit RETURN quittieren. ' TO DIALOG BY SKIP,(3)A;
   GET FROM DIALOG BY SKIP;
   PUT TO   DIALOG BY SKIP;
   CALL EXTNAMEN (QF,NAME,LIMIT,ANZAHL);
     IF ANZAHL==0
        THEN PUT 'Die Diskette ist ja leer! Nein danke...'
                  TO DIALOG BY SKIP,A,(2)SKIP;
                  TERMINATE;
        ELSE PUT ANZAHL,' Dateien:'
                 TO DIALOG BY SKIP,F(3),A,(2)SKIP;
             FOR I TO ANZAHL REPEAT;
                 PUT NAME(I) TO DIALOG BY A,X(2);
               END;
             PUT TO DIALOG BY (2)SKIP;
        FIN;
   PUT 'Ist das die richtige Disk? (J/N) '
        TO DIALOG BY A;
   OK=WENNJA;
  END; /* OF WHILE */
  CALL ACTION (NAME,ANZAHL);
  PUT 'Das war''s. Tschuess.' TO DIALOG BY SKIP,A,(2)SKIP;
  TERMINATE;
 END; /* OF TASK */
/*====================================================================*/
NOTAUS: TASK PRIO 50;
DCL NAME(160) CHAR(8), LIMIT FIXED INIT(160), ANZAHL FIXED;
   CALL LOESCHEN(NAME,ANZAHL);
   TERMINATE COP;
END;
/*====================================================================*/
START: TASK;
DCL ANTW FIXED;
   PUT TOCHAR(27) CAT '*' TO DIALOG BY A;
   PUT 'In welches Laufwerk soll die Quelldiskette? (F0/F1)'
       TO DIALOG BY A;
   GET QF FROM DIALOG BY SKIP, A(2);
   PUT TOCHAR(27) CAT '*' TO DIALOG BY A;
   PUT 'In welches Laufwerk soll die Zieldiskette?  (F0/F1)'
       TO DIALOG BY A;
   GET ZF FROM DIALOG BY SKIP, A(2);
   PUT 'Daten des Ziellaufwerkes ' TO DIALOG BY (2)SKIP,A,SKIP;
   PUT '80 SPUREN - 2 SEITEN  (1)' TO DIALOG BY A,SKIP;
   PUT '80 SPUREN - 1 SEITE   (2)' TO DIALOG BY A,SKIP;
   PUT '40 SPUREN - 2 SEITEN  (3)' TO DIALOG BY A,SKIP;
   PUT '40 SPUREN - 1 SEITE   (4)' TO DIALOG BY A,SKIP;
   PUT 'ZIELDISKETTE IST SCHON   ' TO DIALOG BY A,SKIP;
   PUT 'FORMATIERT            (5)' TO DIALOG BY A,SKIP;
   PUT 'BITTE WAEHLEN         >'   TO DIALOG BY A;
   GET ANTW FROM DIALOG BY SKIP, F(1);
   PUT TOCHAR(27) CAT '*' TO DIALOG BY A;
   CASE ANTW
       ALT /* DSDD */
          FORMINFO = 'FORM D 'CAT ZF CAT':B5DS80';
       ALT /* SSDD */
          FORMINFO = 'FORM D 'CAT ZF CAT':B5SS80';
       ALT /* DSSD */
          FORMINFO = 'FORM S 'CAT ZF CAT':B5DS40';
       ALT /* SSSD */
          FORMINFO = 'FORM S 'CAT ZF CAT':B5SS40';
       ALT /* DISK IST FORMATIERT */
          FORMINFO = 'IST FORMATIERT !';
       OUT /* FEHLER */
          PUT 'EINGABEFEHLER --> NEU STARTEN!!!' TO DIALOG BY A,SKIP;
          TERMINATE START;
   FIN;
   ACTIVATE COP;
END;
MODEND;