Loading...
Select Version
Das folgende COBOL-Programm beinhaltet folgende Funktionen:
- Eröffnen eines Unterprogrammzugriffs (INIT)
- Aufnehmen einer Datei als Element (ADD)
- Suchen eines Elementes in einem Inhaltsverzeichnis (TOCPRIM)
- Eröffnen eines Elementes (OPENGET)
- Satzweise Lesen eines Elementes (GET)
- Schließen des Elementes (CLOSE)
- Beenden des Unterprogrammzugriffs (END)
Zum besseren Verständnis wurden Kommentare in das Beispiel aufgenommen.
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. LMSUPCOB.
******************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
TERMINAL IS MONITOR
SYMBOLIC CHARACTERS
COPY LMSCOBEQ.
.
* DER OBIGE PUNKT MUSS GESCHRIEBEN WERDEN, UM DEN *
* SPECIAL-NAMES PARAGRAPHEN ABZUSCHLIESSEN *
/
DATA DIVISION.
WORKING-STORAGE SECTION.
*****************************************************************
*****************************************************************
** **
** DIE KONTROLLBLOECKE FUER DAS ARBEITEN MIT LMS ALS **
** UNTERPROGRAMM LIEGEN IN DER BIBLIOTHEK SYSLIB.LMS.<VERS> **
** ALS COPY-ELEMENTE VOR **
*****************************************************************
*****************************************************************
COPY LMSCOBCB.
COPY LMSCOBED.
COPY LMSCOBEI.
COPY LMSCOBEM.
COPY LMSCOBFD.
COPY LMSCOBLD.
COPY LMSCOBRD.
*****************************************************************
* TOC-IDENTIFICATION *
*****************************************************************
01 LMSUP-TID PIC 9(08) BINARY VALUE 1.
*****************************************************************
* ELEMENT RECORD (ZUM UEBERGEBEN VON ELEMENTEN MIT PUT/GET) *
*****************************************************************
01 LMSUP-ER.
05 SATZKOPF.
10 SATZLAENGE PIC S9(04) BINARY.
10 FILLER PIC X(02).
05 SATZPUFFER PIC X(256).
*****************************************************************
* HILFSFELDER, KONSTANTENDEFINITIONEN FUER DAS PROGRAMM *
*****************************************************************
01 H01-HILFSFELDER.
05 H01-DATEI-LINKNAME PIC X(08) VALUE "FILELINK".
05 H01-BIBLIOTHEK-LINKNAME PIC X(08) VALUE "LIBLINK".
05 H01-ELEMENT-NAME PIC X(54) VALUE "PROBEELEM".
05 H01-ELEMENT-TYP PIC X VALUE "S".
05 H01-ELEMENT-VERSION PIC X(24) VALUE "1".
05 H01-PUFFER-LAENGE PIC 9(09) BINARY VALUE 260.
*****************************************************************
* AUSGABEBEREICHE FUER ELEMENTSATZ *
*****************************************************************
01 A01-AUSGABE-FELDER.
05 A01-SATZLAENGE PIC 9(04) BINARY.
05 A01-AUSGABE-SATZ.
10 FILLER PIC X OCCURS 1 TO 256
DEPENDING ON
A01-SATZLAENGE.
/
***************************************************************
PROCEDURE DIVISION.
***************************************************************
STEUER SECTION.
ST-ANFANG.
PERFORM LMS-INITIALISIEREN.
IF LMSRET-OK
THEN
PERFORM LMS-AUFNEHMEN
PERFORM LMS-INHALT
PERFORM LMS-ELEM-BEARBEITEN
PERFORM LMS-BEENDEN
END-IF.
ST-ENDE.
STOP RUN.
/
LMS-INITIALISIEREN SECTION.
LMS-INIT-ANFANG.
*****************************************************************
* CONTROL BLOCK VORBEREITEN FUER DIE INITIALISIERUNG *
*****************************************************************
MOVE LMSUP-UPINIT TO FUNC IN LMSUP-SCB.
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB.
CALL "LMSUP1" USING LMSUP-SCB.
*****************************************************************
* RETURN-CODE AUSWERTEN *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "INITIALISIEREN DURCHGEFUEHRT"
UPON MONITOR
ELSE
DISPLAY "FEHLER BEIM INITIALISIEREN AUFGETRETEN"
UPON MONITOR
END-IF.
LMS-INIT-ENDE.
EXIT.
/
LMS-AUFNEHMEN SECTION.
LMS-AUF-ANFANG.
*****************************************************************
* DIE DATEI MIT "DATEI-LINKNAME" WIRD UNTER "ELEMENT-NAME" *
* IN DIE BIBLIOTHEK MIT "BIBLIOTHEK-LINKNAME" EINGETRAGEN *
* *
* CONTROL BLOCK, FILE DESCRIPTION, LIBRARY DESCRIPTION UND *
* ELEMENT DESCRIPTION VORBEREITEN FUER DAS AUFNEHMEN *
* EINES ELEMENTES *
* *
* (DIE ANDEREN FELDER BLEIBEN WIE BEIM INIT) *
*****************************************************************
MOVE LMSUP-ADD TO FUNC IN LMSUP-SCB.
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB.
MOVE LMSUP-YES TO OVERWRITE IN LMSUP-SCB.
MOVE H01-DATEI-LINKNAME TO LINK IN LMSUP-FD.
MOVE H01-BIBLIOTHEK-LINKNAME TO LINK IN LMSUP-LD.
MOVE H01-ELEMENT-TYP TO TYP IN LMSUP-ED.
MOVE H01-ELEMENT-NAME TO NAME IN LMSUP-ED.
MOVE H01-ELEMENT-VERSION TO VERSION IN LMSUP-ED.
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-FD,
LMSUP-LD,
LMSUP-ED.
*****************************************************************
* RETURN-CODE AUSWERTEN *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "AUFNEHMEN DES ELEMENTS " H01-ELEMENT-NAME
" DURCHGEFUEHRT"
UPON MONITOR
ELSE
DISPLAY "FEHLER BEIM AUFNEHMEN EINES ELEMENTES"
UPON MONITOR
END-IF.
LMS-AUF-ENDE.
EXIT.
/
LMS-INHALT SECTION.
LMS-INHALT-ANFANG.
*****************************************************************
* ES WIRD NACH EINEM BESTIMMTEN ELEMENT MIT "ELEMENT-NAME" *
* UND "ELEMENT-TYP" GESUCHT. *
* *
* CONTROL BLOCK UND ELEMENT MASK VORBEREITEN ZUM SUCHEN *
* EINES ELEMENTES (TOCPRIM) *
* (LIBRARY DEFINITION BLEIBT WIE VORBELEGT) *
*****************************************************************
MOVE LMSUP-TOCPRIM TO FUNC IN LMSUP-SCB.
MOVE LMSUP-LONG TO SUBCODE IN LMSUP-SCB.
MOVE H01-ELEMENT-TYP TO TYP IN LMSUP-EM.
MOVE H01-ELEMENT-NAME TO NAME IN LMSUP-EM.
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-TID,
LMSUP-EI,
LMSUP-LD,
LMSUP-EM.
*****************************************************************
* RETURN-CODE AUSWERTEN, *
* DRUCKAUFBEREITETE AUSGABE DER ELEMENTINFORMATION *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "SUCHEN EINES ELEMENTES DURCHGEFUEHRT: "
UPON MONITOR
DISPLAY "TYP ", TYP IN LMSUP-EI
UPON MONITOR
DISPLAY "NAME ", NAME IN LMSUP-EI
UPON MONITOR
DISPLAY "VERSION ", VERSION IN LMSUP-EI
UPON MONITOR
DISPLAY "FORMAT ", STORE-FORM IN LMSUP-EI
UPON MONITOR
DISPLAY "USER-DATE ", USER-DATE IN LMSUP-EI
UPON MONITOR
DISPLAY "USER-TIME ", USER-TIME IN LMSUP-EI
UPON MONITOR
DISPLAY "CR-DATE ", CREATION-DATE IN LMSUP-EI
UPON MONITOR
DISPLAY "CR-TIME ", CREATION-TIME IN LMSUP-EI
UPON MONITOR
DISPLAY "MOD-DATE ", MODIFI-DATE IN LMSUP-EI
UPON MONITOR
DISPLAY "MOD-TIME ", MODIFI-TIME IN LMSUP-EI
UPON MONITOR
DISPLAY "SEC-NAME ", SEC-NAME IN LMSUP-EI
UPON MONITOR
DISPLAY "SEC-ATTR ", SEC-ATTRIBUTE IN LMSUP-EI
UPON MONITOR
ELSE
DISPLAY "FEHLER BEIM SUCHEN EINES ELEMENTES"
UPON MONITOR
END-IF.
LMS-INHALT-ENDE.
EXIT.
/
LMS-ELEM-BEARBEITEN SECTION.
LMS-ELEM-BEA-ANFANG.
*****************************************************************
* EIN ELEMENT WIRD ZUR BEARBEITUNG GEOEFFNET, SATZWEISE *
* GELESEN UND WIEDER GESCHLOSSEN *
*****************************************************************
*****************************************************************
* CONTROL BLOCK UND ELEMENT DESCRIPTION VORBEREITEN FUER DAS *
* OEFFNEN EINES ELEMENTES. *
* (LIBRARY DESCRIPTION BLEIBT WIE BISHER, MUSS ABER VERSORGT *
* SEIN. DAS ELEMENT MUSS DURCH DIE DREI EIGENSCHAFTEN TYP, *
* NAME UND VERSION EINDEUTIG BESCHRIEBEN SEIN) *
*****************************************************************
MOVE LMSUP-OPEN-GET TO FUNC IN LMSUP-SCB.
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB.
MOVE H01-ELEMENT-NAME TO NAME IN LMSUP-ED.
MOVE H01-ELEMENT-TYP TO TYP IN LMSUP-ED.
MOVE H01-ELEMENT-VERSION TO VERSION IN LMSUP-ED.
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-RD,
LMSUP-LD,
*****************************************************************
* RETURN-CODE AUSWERTEN, *
* WENN KEIN FEHLER AUFGETRETEN IST, WIRD GELESEN *
*****************************************************************
IF LMSRET-OK
THEN
*****************************************************************
* CONTROL BLOCK UND RECORD DESCRIPTION VORBEREITEN FUER *
* DAS SATZWEISE LESEN EINES ELEMENTES. *
* (MIT PUFFER-LAENGE WIRD DIE MAX. ERWARTETE SATZLAENGE *
* ANGEGEBEN) *
*****************************************************************
MOVE LMSUP-GET TO FUNC IN LMSUP-SCB
MOVE LMSUP-SEQ TO SUBCODE IN LMSUP-SCB
MOVE H01-PUFFER-LAENGE TO BUFFER-LEN IN LMSUP-RD
*****************************************************************
* LESESCHLEIFE BIS ELEMENTENDE *
*****************************************************************
PERFORM UNTIL NOT LMSRET-OK
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-RD,
LMSUP-ER
*****************************************************************
* RETURN-CODE AUSWERTEN *
*****************************************************************
EVALUATE TRUE
WHEN LMSRET-OK
SUBTRACT 4 FROM SATZLAENGE IN LMSUP-ER
GIVING A01-SATZLAENGE
MOVE SATZPUFFER TO A01-AUSGABE-SATZ
DISPLAY A01-AUSGABE-SATZ UPON MONITOR
WHEN LMSRET-EOF
DISPLAY "ELEMENTENDE ERREICHT"
UPON MONITOR
WHEN LMSRET-TRUNC
DISPLAY "SATZPUFFER ZU KURZ ANGEGEBEN"
UPON MONITOR
WHEN OTHER
DISPLAY "FEHLER BEIM LESEN EINES SATZES"
UPON MONITOR
END-EVALUATE
END-PERFORM
*****************************************************************
* CONTROL BLOCK UND RECORD DESCRIPTION VORBEREITEN FUER *
* DAS SCHLIESSEN EINES ELEMENTES. *
*****************************************************************
MOVE LMSUP-CLOSE TO FUNC IN LMSUP-SCB
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-RD
*****************************************************************
* RETURN-CODE AUSWERTEN *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "ELEMENT '" H01-ELEMENT-NAME "' WURDE "
"GESCHLOSSEN"
UPON MONITOR
ELSE
DISPLAY "FEHLER BEIM SCHLIESSEN EINES ELEMENTES"
UPON MONITOR
END-IF
ELSE
DISPLAY "FEHLER BEIM OEFFNEN EINES ELEMENTES"
UPON MONITOR
END-IF.
LMS-ELEM-BEA-ENDE.
EXIT.
/
LMS-BEENDEN SECTION.
LMS-BEENDEN-ANFANG.
*****************************************************************
* CONTROL BLOCK VORBEREITEN FUER DAS BEENDEN DES LMS *
*****************************************************************
MOVE LMSUP-UPEND TO FUNC IN LMSUP-SCB.
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB.
*****************************************************************
* RETURN-CODE AUSWERTEN *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "LMS BEENDET"
UPON MONITOR
ELSE
DISPLAY "FEHLER BEIM BEENDEN DES LMS"
UPON MONITOR
END-IF.
LMS-BEENDEN-ENDE.
EXIT.