Loading...
Select Version
The following COBOL program contains the functions listed below:
Open a subroutine access (INIT)
Incorporate a file as a member (ADD)
Search the directory for a member (TOCPRIM)
Open a member (OPENGET)
Read a member record by record (GET)
Close a member (CLOSE)
Terminate the subroutine access (END)
To make the example easier to understand, comments have been included.
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. LMSUPCOB.
******************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
TERMINAL IS MONITOR
SYMBOLIC CHARACTERS
COPY LMSCOBEQ.
.
* THE ABOVE PERIOD IS MANDATORY IN THAT IT COMPLETES THE *
* SPECIAL-NAMES PARAGRAPH *
/
DATA DIVISION.
WORKING-STORAGE SECTION.
*****************************************************************
*****************************************************************
** **
** THE CONTROL BLOCKS FOR USING LMS AS A SUBROUTINE **
** ARE STORED AS COPY MEMBERS IN THE LIBRARY **
** SYSLIB.LMS.<VERS>. **
*****************************************************************
*****************************************************************
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.
*****************************************************************
* MEMBER RECORD (FOR TRANSFERRING MEMBERS VIA PUT/GET) *
*****************************************************************
01 LMSUP-ER.
05 SATZKOPF.
10 SATZLAENGE PIC S9(04) BINARY.
10 FILLER PIC X(02).
05 SATZPUFFER PIC X(256).
*****************************************************************
* AUXILIARY FIELDS, CONSTANTS DEFINED FOR THE PROGRAM *
*****************************************************************
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.
*****************************************************************
* OUTPUT AREAS FOR MEMBER RECORD *
*****************************************************************
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.
*****************************************************************
* PREPARE CONTROL BLOCK FOR INITIALIZATION *
*****************************************************************
MOVE LMSUP-UPINIT TO FUNC IN LMSUP-SCB.
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB.
CALL "LMSUP1" USING LMSUP-SCB.
*****************************************************************
* EVALUATE RETURN CODE *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "INITIALIZATION COMPLETED"
UPON MONITOR
ELSE
DISPLAY "ERROR OCCURRED DURING INITIALIZATION"
UPON MONITOR
END-IF.
LMS-INIT-ENDE.
EXIT.
/
LMS-AUFNEHMEN SECTION.
LMS-AUF-ANFANG.
*****************************************************************
* THE FILE WITH "DATEI-LINKNAME" IS ENTERED UNDER "ELEMENT-NAME"*
* IN THE LIBRARY WITH "BIBLIOTHEK-LINKNAME". *
* *
* CONTROL BLOCK, FILE DESCRIPTION, LIBRARY DESCRIPTION AND *
* ELEMENT DESCRIPTION ARE TO BE PREPARED FOR ADDITION OF *
* A MEMBER. *
* *
* (ALL OTHER FIELDS SAME AS FOR 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.
*****************************************************************
* EVALUATE RETURN CODE *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "MEMBER " H01-ELEMENT-NAME
" ADDED"
UPON MONITOR
ELSE
DISPLAY "ERROR DURING ADDITION OF A MEMBER"
UPON MONITOR
END-IF.
LMS-AUF-ENDE.
EXIT.
/
LMS-INHALT SECTION.
LMS-INHALT-ANFANG.
*****************************************************************
* SEARCH FOR A PARTICULAR MEMBER WITH "ELEMENT-NAME" *
* AND "ELEMENT-TYP". *
* *
* CONTROL BLOCK AND ELEMENT MASK ARE TO BE PREPARED FOR *
* A SEARCH FOR A MEMBER (TOCPRIM). *
* (LIBRARY DEFINITION AS PREDEFINED) *
*****************************************************************
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.
*****************************************************************
* EVALUATE RETURN CODE, *
* OUTPUT ELEMENT INFORMATION IN EDITED FORM. *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "SEARCH FOR MEMBER PERFORMED: "
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 "ERROR DURING SEARCH FOR A MEMBER"
UPON MONITOR
END-IF.
LMS-INHALT-ENDE.
EXIT.
/
LMS-ELEM-BEARBEITEN SECTION.
LMS-ELEM-BEA-ANFANG.
*****************************************************************
* A MEMBER IS OPENED FOR PROCESSING, READ RECORD-BY-RECORD *
* AND THEN CLOSED AGAIN *
*****************************************************************
*****************************************************************
* CONTROL BLOCK AND ELEMENT DESCRIPTION ARE TO BE PREPARED FOR *
* OPENING A MEMBER. *
* (LIBRARY DESCRIPTION SAME AS BEFORE, BUT MUST BE SUPPLIED. *
* THE MEMBER MUST BE UNIQUELY DESCRIBED BY THE THREE *
* ATTRIBUTES: TYPE, NAME AND VERSION) *
*****************************************************************
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,
LMSUP-ED.
*****************************************************************
* EVALUATE RETURN CODE; *
* IF NO ERROR HAS OCCURRED, READING STARTS *
*****************************************************************
IF LMSRET-OK
THEN
*****************************************************************
* CONTROL BLOCK AND RECORD DESCRIPTION ARE TO BE PREPARED FOR *
* RECORD-BY-RECORD READING OF A MEMBER. *
* (PUFFER-LAENGE SPECIFIES THE MAXIMUM EXPECTED RECORD *
* LENGTH) *
*****************************************************************
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
*****************************************************************
* READING LOOP UNTIL END OF MEMBER IS REACHED *
*****************************************************************
PERFORM UNTIL NOT LMSRET-OK
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-RD,
LMSUP-ER
*****************************************************************
* EVALUATE RETURN CODE *
*****************************************************************
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 "END OF MEMBER REACHED"
UPON MONITOR
WHEN LMSRET-TRUNC
DISPLAY "RECORD BUFFER NOT SUFFICIENT"
UPON MONITOR
WHEN OTHER
DISPLAY "ERROR DURING READING OF A RECORD"
UPON MONITOR
END-EVALUATE
END-PERFORM
*****************************************************************
* CONTROL BLOCK AND RECORD DESCRIPTION ARE TO BE PREPARED *
* FOR CLOSING A MEMBER *
*****************************************************************
MOVE LMSUP-CLOSE TO FUNC IN LMSUP-SCB
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB
CALL "LMSUP1" USING LMSUP-SCB,
LMSUP-RD
*****************************************************************
* EVALUATE RETURN CODE *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "MEMBER " H01-ELEMENT-NAME
" CLOSED"
UPON MONITOR
ELSE
DISPLAY "ERROR DURING CLOSING OF A MEMBER"
UPON MONITOR
END-IF
ELSE
DISPLAY "ERROR DURING OPENING OF A MEMBER"
UPON MONITOR
END-IF.
LMS-ELEM-BEA-ENDE.
EXIT.
/
LMS-BEENDEN SECTION.
LMS-BEENDEN-ANFANG.
*****************************************************************
* PREPARE CONTROL BLOCK FOR LMS TERMINATION *
*****************************************************************
MOVE LMSUP-UPEND TO FUNC IN LMSUP-SCB.
MOVE LMSUP-UNUSED TO SUBCODE IN LMSUP-SCB.
*****************************************************************
* EVALUATE RETURN CODE *
*****************************************************************
IF LMSRET-OK
THEN
DISPLAY "LMS TERMINATED"
UPON MONITOR
ELSE
DISPLAY "ERROR DURING LMS TERMINATION"
UPON MONITOR
END-IF.
LMS-BEENDEN-ENDE.
EXIT.