|
> -----Original Message----- > From: A. Sivasubrahmanian > [mailto:sivasubrahmanian.ananthakrishnan@xxxxxxxxx] > Sent: Tuesday, June 24, 2003 7:44 AM > To: cobol400-l@xxxxxxxxxxxx > Subject: QUSPTRUS > Importance: High > Hi > > After getting to know how to use QUSRTVUS API, I would like > to know how to use QUSPTRUS API. How do I declare a pointer > variable in COBOL and call this API using the declared pointer? > How do I move the value > referenced by the pointer to a program > work variable? > > A sample code would be much helpful. > > Thanks & Regards > Siva Here's an old program called RTVFD that I believe was originally published in the News400 magazine. Maybe it will be of some help. Note: I have not tested or used this program.... Good Luck, Terry IDENTIFICATION DIVISION. *************************************************************** *************************************************************** * * Program: RTVFD * * Language: COBOL/400 * * Description: This program retrieves a file definition * template to a user space. * * APIs Used: QDBRTVFD - Retrieve File Description * QUSCRTUS - Create User Space * QUSCUSAT - Change User Space Attributes * QUSPTRUS - Retrieve a pointer to a User Space * *************************************************************** *************************************************************** PROGRAM-ID. RTVFD. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. DATA DIVISION. WORKING-STORAGE SECTION. * * Error Code parameter include. As this sample program * uses COPY to include the error code structure, only the first * 16 bytes of the error code structure are available. If the * application program needs to access the variable length * exception data for the error, the developer should physically * copy the QSYSINC include and modify the copied include to * define additional storage for the exception data. * COPY QUSEC OF QSYSINC-QLBLSRC. * * Misc. elements * 01 MISC. 05 EXIT-POINT-NAME PIC X(20) VALUE "EXAMPLE_EXIT_POINT". 05 EXIT-PGM-NBR PIC S9(09) VALUE -1 BINARY. 05 EXIT-PARAMETERS PIC X(10). 05 FILE-USED PIC X(20). 05 LIBRARY-NAME PIC X(10). 05 SPACE-SIZE PIC S9(09) BINARY. 05 SPACE-INIT PIC X(01) VALUE "X'00'". 05 SPACE-POINTER POINTER. 05 FORMAT-NAME-1 PIC X(08). 05 OVERRIDES PIC X(01) VALUE "0". 05 SYSTEM PIC X(10) VALUE "*LCL". 05 FORMAT-1 PIC X(10) VALUE "*INT". 05 EXT-ATTR PIC X(10). 05 SPACE-AUT PIC X(10) VALUE "*CHANGE". 05 SPACE-TEXT PIC X(50) VALUE "QDBRTVFD". 05 SPACE-REPLACE PIC X(10) VALUE "*YES". 05 SPACE-DOMAIN PIC X(10) VALUE "*USER". 05 API-NAME PIC X(10). 01 CHG-US-ATTR. 05 NBR-OF-ATTR PIC S9(09) VALUE 1 BINARY. 05 ATTR-KEY PIC S9(09) VALUE 3 BINARY. 05 DATA-SIZE PIC S9(09) VALUE 1 BINARY. 05 ATTR-DATA PIC X(01) VALUE "1". * LINKAGE SECTION. 01 SPACE-NAME PIC X(20). 01 FILE-NAME PIC X(20). 01 FORMAT-NAME-PARM PIC X(10). * * Retrieve File Description API include. * COPY QDBRTVFD OF QSYSINC-QLBLSRC. * * Beginning of mainline * PROCEDURE DIVISION USING SPACE-NAME, FILE-NAME, FORMAT-NAME-PARM. MAIN-LINE. * PERFORM INITIALIZE-SPACE. PERFORM PROCESS-SPACE. PERFORM PROGRAM-DONE. * * Start of subroutines * *************************************************************** ** PROCESS-SPACE. * * The template returned from QDBRTVFD is now addressable by way * of SPACE-POINTER; as an example the program will now display * the access method for the file: * DISPLAY QDBFPACT OF QDB-QDBFH. * *************************************************************** ** * INITIALIZE-SPACE. * * One time initialization code for this program * * Set Error Code structure to not use exceptions * MOVE 16 TO BYTES-PROVIDED OF QUS-EC. * * Create a User Space for QDBRTVFD * MOVE 1024 TO SPACE-SIZE. CALL "QUSCRTUS" USING SPACE-NAME, EXT-ATTR, SPACE-SIZE, SPACE-INIT, SPACE-AUT, SPACE-TEXT, SPACE-REPLACE, QUS-EC, SPACE-DOMAIN. * * Check for errors on QUSCRTUS * IF BYTES-AVAILABLE OF QUS-EC > 0 MOVE "QUSCRTUS" TO API-NAME, PERFORM API-ERROR-FOUND. * * Change the User Space so that it is extendable * CALL "QUSCUSAT" USING LIBRARY-NAME, SPACE-NAME, CHG-US-ATTR, QUS-EC. * * Check for errors on QUSCUSAT * IF BYTES-AVAILABLE OF QUS-EC > 0 MOVE "QUSCUSAT" TO API-NAME, PERFORM API-ERROR-FOUND. * * Get a resolved pointer to the User Space * CALL "QUSPTRUS" USING SPACE-NAME, SPACE-POINTER, QUS-EC. * * Check for errors on QUSPTRUS * IF BYTES-AVAILABLE OF QUS-EC > 0 MOVE "QUSPTRAT" TO API-NAME, PERFORM API-ERROR-FOUND. * * If no errors, then call QDBRTVFD passing the address of the * User Space as the receiver variable. To accomplish this, * assign the address of QDB-QDBFH to SPACE-POINTER and then * pass QDB-QDBFH. * SET ADDRESS OF QDB-QDBFH TO SPACE-POINTER. * MOVE 16776704 TO SPACE-SIZE. MOVE "FILD0100" TO FORMAT-NAME-1. * CALL "QDBRTVFD" USING QDB-QDBFH, SPACE-SIZE, FILE-USED, FORMAT-NAME-1, FILE-NAME, FORMAT-NAME-PARM, OVERRIDES, SYSTEM OF MISC, FORMAT-1, QUS-EC. * * Check for errors on QDBRTVFD * IF BYTES-AVAILABLE OF QUS-EC > 0 MOVE "QDBRTVFD" TO API-NAME, PERFORM API-ERROR-FOUND. *************************************************************** ** API-ERROR-FOUND. * * Log any error encountered, and exit the program * DISPLAY API-NAME. DISPLAY EXCEPTION-ID OF QUS-EC. PERFORM PROGRAM-DONE. *************************************************************** ** PROGRAM-DONE. * * Exit the program * STOP RUN.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
