Das folgende Beispiel zeigt, wie die Subdatei-APIs in einem ILE COBOL-Quellenprogramm codiert werden.
PROCESS NOMONOPRC APOST.
IDENTIFICATION DIVISION.
PROGRAM-ID. WDSCSRV.
AUTHOR. Programmer Name.
INSTALLATION. IBM Toronto Lab.
DATE-WRITTEN. July 15, 2003.
DATE-COMPILED.
*---------------------------------------------------------------------
* PROGRAM DESCRIPTION
*
* Dieses Programm illustriert den Prozeduraufruf an die Subdatei-APIs
* in Serviceprogramm QDTSSFL.
*
* Kompilieren:
* CRTCBLMOD MODULE(WDSCSRV)
* CRTPGM PGM(WDSCSRV) BNDSRVPGM(QGPL/QDTSSFL)
*---------------------------------------------------------------------
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-I5/OS.
OBJECT-COMPUTER. IBM-I5/OS.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 CUSTOMER-REC.
05 CUSTOMER-NUMBER PIC X(07).
05 CUSTOMER-NAME PIC X(40).
05 REP-IDENTIFIER PIC X(05).
05 CUSTOMER-NAME PIC X(30).
05 CUSTOMER-PHONE-NUMBER PIC X(17).
05 CUSTOMER-FAX-NUMBER PIC X(17).
05 CUSTOMER-ADDRESS PIC X(40).
05 CUSTOMER-CITY PIC X(30).
05 CUSTOMER-COUNTRY PIC X(20).
05 CUSTOMER-POSTAL-CODE PIC X(10).
05 CUSTOMER-PC-LOCATION PIC X(01).
01 MY-BUFFER PIC X(1000).
01 DUMMY PIC X(10).
*** Parameter für APIs
01 SPACE-NAME-PTR USAGE POINTER.
01 RECORD-PTR USAGE POINTER.
01 DUMMY-PTR USAGE POINTER.
01 RECORD-LENGTH PIC S9(09) USAGE BINARY.
01 RELATIVE-REC-NUMBER PIC S9(09) USAGE BINARY.
01 RC PIC S9(09) USAGE BINARY.
01 RECORD-COUNT PIC S9(09) USAGE BINARY.
LINKAGE SECTION.
PROCEDURE DIVISION.
0000-MAIN.
SET SPACE-NAME-PTR TO ADDRESS OF MY-BUFFER.
SET RECORD-PTR TO ADDRESS OF CUSTOMER-REC.
SET FILLER-PTR TO ADDRESS OF DUMMY.
MOVE 217 TO RECORD-LENGTH.
*** API QdtsAppendSF - Satz hinzufügen
CALL PROCEDURE 'QdtsAppendSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RETURNING RC.
*** API QdtsChainSF - Satz verketten
CALL PROCEDURE 'QdtsChainSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RELATIVE-REC-NUMBER
RETURNING RC.
*** API QdtsClearSF - Subdatei-Inhalt löschen
CALL PROCEDURE 'QdtsClearSF' USING BY VALUE SPACE-NAME-PTR
RETURNING RC.
*** API QdtsCountSF - Subdateisätze zählen
CALL PROCEDURE 'QdtsCountSF' USING BY VALUE SPACE-NAME-PTR
RETURNING RECORD-COUNT.
*** API QdtsDeleteSF - Subdateisatz löschen
CALL PROCEDURE 'QdtsDeleteSF' USING BY VALUE SPACE-NAME-PTR
RELATIVE-REC-NUMBER
RETURNING RC.
*** API QdtsInitSF - Subdatei initialisieren
CALL PROCEDURE 'QdtsInitSF' USING BY VALUE SPACE-NAME-PTR
DUMMY-PTR
RECORD-LENGTH
RETURNING RC.
*** API QdtsReadcSF - Satz lesen
CALL PROCEDURE 'QdtsReadcSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RELATIVE-REC-NUMBER
RETURNING RC.
*** API QdtsUpdateSF - Satz aktualisieren
CALL PROCEDURE 'QdtsUpdateSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RELATIVE-REC-NUMBER
RETURNING RC.
STOP RUN.