L'exemple suivant illustre comment les API de sous-fichier sont codées dans un
programme source ILE COBOL.
PROCESS NOMONOPRC APOST.
IDENTIFICATION DIVISION.
PROGRAM-ID. WDSCSRV.
AUTHOR. Nom du programmeur.
INSTALLATION. IBM Toronto Lab.
DATE-WRITTEN. 15 juillet 2003.
DATE-COMPILED.
*---------------------------------------------------------------------
* DESCRIPTION DU PROGRAMME
*
* Ce programme illustre l'appel de procédure destiné aux API de
* sous-fichier dans le programme de service QDTSSFL.
*
* Compile :
* 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).
*** Paramètres des API
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 - Ajout d'un enregistrement
CALL PROCEDURE 'QdtsAppendSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RETURNING RC.
*** API QdtsChainSF - Chaînage à un enregistrement
CALL PROCEDURE 'QdtsChainSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RELATIVE-REC-NUMBER
RETURNING RC.
*** API QdtsClearSF - Effacement d'un sous-fichier
CALL PROCEDURE 'QdtsClearSF' USING BY VALUE SPACE-NAME-PTR
RETURNING RC.
*** API QdtsCountSF - Décompte des enregistrements de sous-fichier
CALL PROCEDURE 'QdtsCountSF' USING BY VALUE SPACE-NAME-PTR
RETURNING RECORD-COUNT.
*** API QdtsDeleteSF - Suppression d'un enregistrement de sous-fichier
CALL PROCEDURE 'QdtsDeleteSF' USING BY VALUE SPACE-NAME-PTR
RELATIVE-REC-NUMBER
RETURNING RC.
*** API QdtsInitSF - Initialisation du sous-fichier
CALL PROCEDURE 'QdtsInitSF' USING BY VALUE SPACE-NAME-PTR
DUMMY-PTR
RECORD-LENGTH
RETURNING RC.
*** API QdtsReadcSF - Lecture d'un enregistrement
CALL PROCEDURE 'QdtsReadcSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RELATIVE-REC-NUMBER
RETURNING RC.
*** API QdtsUpdateSF - Mise à jour d'un enregistrement
CALL PROCEDURE 'QdtsUpdateSF' USING BY VALUE SPACE-NAME-PTR
RECORD-PTR
RECORD-LENGTH
RELATIVE-REC-NUMBER
RETURNING RC.
STOP RUN.