Code:
- DCL SPCPTR .srvPgm INIT(srvPgm) ;
- DCL DD srvPgm CHAR(20) ;
- DCL DD srvPgmObj CHAR(10) DEF(srvPgm) POS( 1) INIT('QP0LLIB1') ;
- DCL DD srvPgmLib CHAR(10) DEF(srvPgm) POS(11) INIT('QSYS') ;
-
- DCL SPCPTR .procName INIT(procName) ;
- DCL DD procName CHAR(512) ;
-
- DCL SPCPTR .rtnValFmt INIT(rtnValFmt) ;
- DCL DD rtnValFmt BIN(4) INIT(1) /* Returns integer */ ;
-
- DCL SPCPTR .parmFmts ;
-
- DCL SPCPTR .nbrParms INIT(nbrParms) ;
- DCL DD nbrParms BIN(4) INIT(4) ;
-
- DCL SPCPTR .errStr INIT(errStr) ;
- DCL DD errStr CHAR(528) ;
- DCL DD errStrProv BIN( 4) DEF(errStr) POS( 1) INIT(528) ;
- DCL DD errStrAvl BIN( 4) DEF(errStr) POS( 5) INIT( 0) ;
- DCL DD errStrID CHAR( 7) DEF(errStr) POS( 9) INIT(' ') ;
- DCL DD * CHAR( 1) DEF(errStr) POS(16) INIT(' ') ;
- DCL DD errStrDta CHAR(512) DEF(errStr) POS(17) INIT(' ') ;
-
- DCL SPCPTR .rtnVal ;
- DCL SPCPTR .parm1 ;
- DCL SPCPTR .parm2 ;
- DCL SPCPTR .parm3 ;
- DCL SPCPTR .parm4 ;
- DCL SPCPTR .parm5 ;
- DCL SPCPTR .parm6 ;
- DCL SPCPTR .parm7 ;
-
- DCL SYSPTR .QZRUCLSP INIT('QZRUCLSP', CTX('QSYS'), TYPE(PGM)) ;
-
- DCL OL QZRUCLSP (.srvPgm, .procName, .rtnValFmt, .parmFmts
- , .nbrParms, .errStr, .rtnVal
- , .parm1, .parm2, .parm3, .parm4
- , .parm5, .parm6, .parm7) ARG ;
-
-
- DCL DD fileHandle BIN( 4) ;
- DCL DD DBGHANDLE BIN( 4) DEF(fileHandle) ;
- DCL DD fileName CHAR(128) ;
- DCL DD openFlag CHAR(4) INIT(X'0100004A') ;
- /* TEXT+CREAT+TRUNC+WRONLY */ ;
- DCL DD permission BIN(4) INIT(438) /* rw-rw-rw- */ ;
- DCL DD PERMISSION BIN(4) DEF(permission) POS(1) ;
- DCL DD fileccsid BIN(4) INIT(819) ;
- DCL DD openccsid BIN(4) INIT( 37) ;
-
- DCL DD rc+errno CHAR(8) ;
- DCL DD rc BIN( 4) DEF(rc+errno) POS(1) INIT(0) ;
- DCL DD errno BIN( 4) DEF(rc+errno) POS(5) INIT(0) ;
- DCL DD DBGRCERR CHAR(8) DEF(rc+errno) POS(1) ;
- DCL DD unlinkFmts(1) BIN(4) INIT(2) /* 1 Pointer */ ;
- DCL DD openFmts(4) BIN(4)
- INIT(2, 1, 1, 1) /* Pointer and 3 Ints */ ;
- DCL DD writefmts(3) BIN(4)
- INIT(1, 2, 1) /* Int, Ptr, Int */ ;
- DCL DD closeFmts(1) BIN(4) INIT(1) /* 1 binary */ ;
-
-
- DCL DD writeThis CHAR(512) ;
- DCL DD * CHAR(27) INIT('Here is some data to write.') ;
- DCL DD CR CHAR( 1) INIT(X'25') ;
- DCL DD LF CHAR( 1) INIT(X'0A') ;
- DCL DD writeLen BIN( 4) INIT(29) ;
-
-
-
-
-
- CPYBLAP fileName, 'mi-ifs-file.txt', X'00' ;
-
- newTextFile: ;
-
- /* First, we unlink the file in case it already exists */ ;
-
- CPYBLAP procName, 'unlink', X'00' /* Remove IFS file */ ;
- CPYNV rtnValFmt, 3 /* rtncode + errno */ ;
- SETSPP .parmFmts, unlinkFmts /* Set formats for OPEN */ ;
- CPYNV nbrParms, 1 /* Four parameters */ ;
- SETSPP .rtnVal, rc+errno /* Return code */ ;
- SETSPP .parm1, fileName /* Name of file to open */ ;
- CALLX .QZRUCLSP, QZRUCLSP, * /* Unlink the file */ ;
-
- BRK 'UNLINKED' ;
-
- CPYNV errno, 0 ;
-
- /* Now, let's create a new file */ ;
-
- CPYBLAP procName, 'open', X'00' /* Open an IFS file */ ;
- CPYNV rtnValFmt, 3 /* rtncode + errno */ ;
- SETSPP .parmFmts, openFmts /* Set formats for OPEN */ ;
- CPYNV nbrParms, 4 /* Four parameters */ ;
- CPYBLA openFlag, X'0100004A' ;
- /* TEXT+CREAT+TRUNC+WRONLY */ ;
- SETSPP .rtnVal, rc+errno /* Return our handle */ ;
- SETSPP .parm1, fileName /* Name of file to open */ ;
- SETSPP .parm2, openFlag /* Open flags */ ;
- SETSPP .parm3, permission /* Permissions */ ;
- SETSPP .parm4, fileccsid /* CCSID of new file */ ;
- CALLX .QZRUCLSP, QZRUCLSP, * /* Open the file */ ;
-
- CPYNV fileHandle, rc ; /* Copy the file handle */ ;
-
- BRK 'OPENED' ;
-
- CMPNV(B) fileHandle, 0 /LO(getOut) ;
- CPYNV errno, 0 ;
-
- writeLine:
-
- CPYBLAP procName, 'write', X'00' /* Write line */ ;
- CPYNV rtnValFmt, 3 /* rtncode + errno */ ;
- SETSPP .parmFmts ,writefmts /* int, pointer, int */ ;
- CPYNV nbrParms, 3 /* hdl, data, len */ ;
- SETSPP .rtnVal, rc+errno /* rtncode + errno */ ;
- SETSPP .parm1, fileHandle /* Handle to our file */ ;
- SETSPP .parm2, writeThis /* Data to write */ ;
- SETSPP .parm3, writeLen /* Length to write */ ;
- CALLX .QZRUCLSP, QZRUCLSP, * /* Write the line */ ;
-
- BRK 'WROTELINE1' ;
-
- CPYNV errno, 0 ;
-
- /* Close the new file, prepare to open for append... */
-
- CPYBLAP procName, 'close', X'00' /* Close IFS file */ ;
- CPYNV rtnValFmt, 3 /* Returns integer */ ;
- SETSPP .parmFmts, closeFmts /* Set formats for close */;
- CPYNV nbrParms, 1 /* One parameter */ ;
- SETSPP .rtnVal, rc+errno /* Capture return code */ ;
- SETSPP .parm1, fileHandle /* File to close */ ;
- CALLX .QZRUCLSP, QZRUCLSP, * /* Call the procedure */ ;
-
- BRK 'CLOSED2' ;
-
- CPYNV errno, 0 ;
-
- getOut: ;
-
- RTX * ;
-
|
|