home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 04 / cobol / nonummer.cbl < prev    next >
Encoding:
Text File  |  1991-01-29  |  4.4 KB  |  115 lines
  1.        IDENTIFICATION DIVISION .
  2.        PROGRAM-ID . NONUMMER .
  3.        AUTHOR . (c) 1991 H.-G. Schima & TOOLBOX
  4.       *Compiler: Microsoft COBOL
  5.       *Zu beachten ist, daß die führenden 6 Leerzeichen
  6.       *in jeder Zeile beim Abdruck weggelassen wurden!
  7.       *Kommentare beginnen somit in der 7. Spalte!
  8.       *
  9.        ENVIRONMENT DIVISION .
  10.        SPECIAL-NAMES .
  11.            CONSOLE IS CRT .
  12.        INPUT-OUTPUT SECTION .
  13.        FILE-CONTROL .
  14.            SELECT EINGABE ASSIGN TO EXTERNAL EINGABE
  15.                           ORGANIZATION IS LINE SEQUENTIAL .
  16.            SELECT AUSGABE ASSIGN TO EXTERNAL AUSGABE
  17.                           ORGANIZATION IS LINE SEQUENTIAL .
  18.        DATA DIVISION .
  19.        FILE SECTION .
  20.        FD EINGABE .
  21.        01 EINGABE-RC .
  22.            05 NUMMER-EIN PIC X(6) .
  23.            05 REST-EIN PIC X(80) .
  24.        FD AUSGABE .
  25.        01 AUSGABE-RC .
  26.            05 FILLER1-AUS PIC X(6) .
  27.            05 REST-AUS PIC X(66) .
  28.        WORKING-STORAGE SECTION .
  29.        01  DATEIENDE PIC 9 VALUE 0 .
  30.        01  JA PIC 9 VALUE 1 .
  31.        01  NEIN PIC 9 VALUE 0 .
  32.        01  ABBRUCH PIC 9 .
  33.        01  BILDSCHIRM .
  34.            05 ZEILE OCCURS 24 TIMES .
  35.               10 SPALTE OCCURS 80 TIMES .
  36.                  15 FELD-ELEM  PIC X .
  37.        SCREEN SECTION .
  38.        01  SCHIRM-1 .
  39.            05 HIGHLIGHT
  40.               FOREGROUND-COLOUR 0
  41.               BACKGROUND-COLOUR 7
  42.               LINE 1
  43.               COLUMN 1
  44.               SIZE IS 2400
  45.               PIC IS X(2400)
  46.               FROM BILDSCHIRM .
  47.        PROCEDURE DIVISION .
  48.        ACTION-HAUPT SECTION .
  49.        HAUPT .
  50.       *Initialisieren des Ausgabebereichs, damit alle Felder
  51.       *auf " " stehen
  52.            INITIALIZE BILDSCHIRM .
  53.       *Füllen der Zeile 1 mit 80 "-"
  54.            MOVE ALL "-" TO ZEILE (1) .
  55.       *Eintragen einer Zeichenkette linksbündig
  56.            MOVE "NONUMMER (C) 1991 H.-G. Schima & toolbox"
  57.                TO ZEILE (2) .
  58.            MOVE ALL "-" TO ZEILE (3) .
  59.       *Der Vorteil ist jetzt auch mit Quick C, Version 2.0, zu
  60.       *erreichen - nämlich die Nutzung von logischen Namen für
  61.       *Dateien. Daher der Hinweis.
  62.            MOVE "Zwei logische Namen müssen gesetzt sein!"
  63.                TO ZEILE (8) .
  64.            MOVE "SET EINGABE='Pfad\Dateiname' für Eingabedatei,"
  65.                TO ZEILE (9) .
  66.            MOVE "SET AUSGABE='Pfad\Dateiname' für Ausgabedatei."
  67.                TO ZEILE (10) .
  68.       *Es wird immer der gesamte Schirm gefüllt. Da dieses
  69.       *Programm im Textmodus arbeitet, sollte es eigentlich auf
  70.       *jeder Hardware laufen.
  71.            DISPLAY Schirm-1 .
  72.       *Öffnen der Eingabedatei lesend
  73.            OPEN INPUT EINGABE .
  74.       *Öffnen der Ausgabedatei schreibend. Sollte die Datei
  75.       *schon vorhanden sein, wird sie überschrieben.
  76.            OPEN OUTPUT AUSGABE .
  77.       *Ausführen der Umsetzroutine, bis kein einzulesender Satz
  78.       *mehr vorhanden ist
  79.            PERFORM UEBERTRAGEN UNTIL DATEIENDE = JA .
  80.       *Schließen der beiden Dateien
  81.            CLOSE EINGABE, AUSGABE .
  82.       *Programmende
  83.            STOP RUN .
  84.        UEBERTRAGEN .
  85.       *Beim Lesen in einer Datei wird vom Environment immer dann
  86.       *EOF gesetzt, wenn die Datei zu Ende ist. Nur gibt es in
  87.       *COBOL innerhalb des Lesebefehls READ die direkte Abfrage
  88.       *auf EOF.
  89.            READ EINGABE
  90.               AT END
  91.                  MOVE "Datei ist zu Ende!" TO ZEILE(23)
  92.                  DISPLAY SCHIRM-1
  93.                  MOVE JA TO DATEIENDE
  94.            END-READ .
  95.            IF DATEIENDE = NEIN
  96.       *Das Übertragen der Informationen findet nur durch den
  97.       *MOVE-Befehl statt. Bei diesem Befehl wird bei Strings
  98.       *linksbündig aufgesetzt und bei numerischen Werten rechts-
  99.       *bündig.
  100.               MOVE EINGABE-RC TO AUSGABE-RC
  101.               MOVE SPACE TO FILLER1-AUS
  102.       *Der eingelesene Satz und der Satz, der geschrieben wird,
  103.       *werden in den Bildschirmpuffer geschoben und
  104.       *anschließend angezeigt.
  105.               MOVE eingabe-rc TO ZEILE (5)
  106.               MOVE ausgabe-rc TO ZEILE (6)
  107.               DISPLAY SCHIRM-1
  108.       *Sollte der zu schreibende Datensatz ab der 7. Spalte nur
  109.       *Leerzeichen enthalten, wird der Schreibvorgang
  110.       *unterlassen.
  111.               IF AUSGABE-RC (7:) not = space
  112.                  WRITE AUSGABE-RC .
  113.       * ------------------------------------------------------ *
  114.       *                 Ende von NONUMMER.CBL                  *
  115.