|
midrange.com
Since David tells me that attachments don't always work through the list so
this is the code that Ray Bills of Rochester used in his "IFS and RPG" sessions
at Common. The source is heavily commented so you should be able to understand
it. Ray mentions in the comments that you should break out the prototypes
into a separate source. My own preference would also be to "wrap" the API
calls into procedures - for example a single "OpenAscii" procedure which could
test if the file exists and create it if needed before opening it. I'll
happily try to answer any questions on the code here on the list if you have
any.
*********************************************************************
*
* This program is an example of using AS/400 Unix-style APIs
* in an ILE-RPG program.
*
* The express purpose of this program is for demonstration
* purposes only. While every attempt has been made to be
* accurate and complete, there are no doubt errors in this code.
* There is no guarantee of any kind on this code, etc...
*
* I have included everything that is needed to compile and run
* this program within this one source member. I don't
* recommend this as a programming practice, it was just easier
* for me to code and print it this way. I would strongly suggest
* that you remove all of the function prototypes into their
* own RPG include file. That way, when IBM comes out with the
* official version of the RPG include file, your code won't be
* impacted that much. I have no idea when IBM will produce the
* "official" version of these function prototypes....
*
* The program reads through a DDS-defined AS/400 Physical File
* and creates an ASCII version of it. There is no attempt
* to do any selection criteria, but that could be easily added
* in your real versions. Also, the format of the lines of
* output can be easily changed to match the format of whatever
* PC or Unix file you desire.
*
* Questions about this code are freely answered by ME
*
* Ray Bills (IBM) 507-253-4699
* RCHASA03(RAY)
* RAINFALL@VNET.IBM.COM
*
*
* Please Note: I freely stole large protions of this code from
* Massimo Marasco of IBM Italy, so if this turns
* out to be successful and usefull, he should
* get much of the credit.
*
*********************************************************************
*
* START OF WHAT SHOULD BE IN A RPG INCLUDE FILE
*
* (from member ERRNO, file H, library QCLE)
*
* extern int *__errno(void);
*
*********************************************************************
* return value = the value global "errno" variable.
D errnoF PR * EXTPROC('__errno')
*
D errno S 10I 0 BASED(errnoP)
*
*********************************************************************
*
* (from member STDIO, file H, library QSYSINC)
*
* QBFC_EXTERN int sprintf(const char *, const char *, ...);
*
*********************************************************************
* value returned = 0 (OK), -1 (error)
D sprintf PR 10I 0 EXTPROC('sprintf')
* string to be filled
D * VALUE
* format string
D * VALUE
*
D 10I 0 VALUE OPTIONS(*NOPASS)
*
D * VALUE OPTIONS(*NOPASS)
*********************************************************************
*********************************************************************
*
* (from member FCNTL, file H, library QSYSINC)
*
* QBFC_EXTERN int open(const char *, int, ...);
*
*********************************************************************
* value returned = file descriptor (OK), -1 (error)
D open PR 10I 0 EXTPROC('open')
* path to be opened.
D * VALUE
* Open flags
D 10I 0 VALUE
* (OPTIONAL) mode (describes access rights to the file)
D 10U 0 VALUE OPTIONS(*NOPASS)
* (OPTIONAL) codepage (specified for ascii data)
D 10U 0 VALUE OPTIONS(*NOPASS)
*********************************************************************
*********************************************************************
*
* (from member UNISTD, file H, library QSYSINC)
*
* QBFC_EXTERN ssize_t read(int, void *, size_t);
*
*********************************************************************
* value returned = number of bytes actually read, or -1
Dread PR 10I 0 EXTPROC('read')
* file descriptor returned from open()
D 10I 0 VALUE
* data received
D * VALUE
* number of bytes to read
D 10U 0 VALUE
*********************************************************************
*********************************************************************
*
* (from member UNISTD, file H, library QSYSINC)
*
* QBFC_EXTERN ssize_t write(int, const void *, size_t);
*
* Definition of type ssize_t
* (from member TYPES, file SYS, library QSYSINC)
*
* typedef int ssize_t;
*
* Definition of type size_t
* (from member TYPES, file SYS, library QSYSINC)
*
* typedef unsigned int size_t;
*
*********************************************************************
* value returned = number of bytes actually written, or -1
D write PR 10I 0 EXTPROC('write')
* file descriptor returned from open()
D 10I 0 VALUE
* data to be written
D * VALUE
* number of bytes to write
D 10U 0 VALUE
*********************************************************************
*********************************************************************
*
* (from member UNISTD, file H, library QSYSINC)
*
* QBFC_EXTERN int close(int);
*
*********************************************************************
* value returned = 0 (OK), or -1
D close PR 10I 0 EXTPROC('close')
* file descriptor returned from open()
D 10I 0 VALUE
*********************************************************************
*********************************************************************
*********************************************************************
*********************************************************************
*
* END OF WHAT SHOULD BE IN A RPG INCLUDE FILE
*
*********************************************************************
*
*********************************************************************
* RC is used to store the Return Code of the various IFS APIs
*********************************************************************
D RC S 10I 0
*********************************************************************
* FileNam is the name of the file in the IFS namespace. You
* can change this to be whatever you want. Your life will be
* a lot easier if you make sure it starts with a slash '/'.
*********************************************************************
D FileNam S 50A INZ('/ifs-file')
D FileNamP S * INZ(%ADDR(FileNam))
*********************************************************************
* FileDescr is the File descriptor that gets assigned by the
* open API and gets used for all of the read, write and close APIS.
*********************************************************************
D FileDescr S 10I 0
*********************************************************************
* The following comments explain how the various numeric fields
* were assigned for the open API. The values mentioned here are
* from the FCNTL member of the H file in the QCLE library.
*********************************************************************
* The following are for the 'oflag' parameter:
*
* define O_CREAT 0x0000008 /* Create the file if not there
* define O_TRUNC 0x0000040 /* Clear file if it is there
* define O_WRONLY 0x0000002 /* Open for writing only
* define O_TEXTDATA 0x1000000 /* Translate ebcidic/ascii
* define O_CODEPAGE 0x0800000 /* Create file in ascii ccsid
*
*********************************************************************
D oflg1_ds DS
D oflg1_Hex 4A INZ(X'0180004A')
D oflg1 10I 0 OVERLAY(oflg1_Hex)
*
D oflg2_ds DS
D oflg2_Hex 4A INZ(X'01000002')
D oflg2 10I 0 OVERLAY(oflg2_Hex)
*
*********************************************************************
* The mode parameter for the open API is set to give access to
* all users. 0x01B6 = rw-w-w-data rights
*********************************************************************
*
D omode_ds DS
D omode_Hex 4A INZ(X'000001B6')
D omode 10U 0 OVERLAY(omode_Hex)
*
*********************************************************************
* cp is used to set the code page (CCSID) of the IFS file to be
* a common US English ASCII. Others code be substituted as
* desired.
*********************************************************************
* ASCII (ccsid 437 = 0x1B5)
D cp_ds DS
D cp_Hex 4A INZ(X'000001B5')
D cp 10U 0 OVERLAY(cp_Hex)
*
*********************************************************************
* The following fields are used to help fo the string
* formatting and writing...
*********************************************************************
*
D ZeroBin S 50A INZ(*ALLX'00')
D NLZero S 2A INZ(X'1500')
*
*********************************************************************
* SI_Fmt is used to hold the format that you want to put in your
* ascii file. This follows the format for the C function called
* printf. So if you are unfamiliar with it, check out a C book
* for further details. The quick tutorial is as follows:
* %d means put a SIGNED number here. (ex. -123 or 456)
* , the comma is used to delimit the fields
* %s means to put a string or name here.
*********************************************************************
*
D SI_Fmt S 50A INZ('%d, %s')
D SI_FmtP S * INZ(%ADDR(SI_Fmt))
*
*********************************************************************
* SI_Msg is used to hold the string or name data from the DB file.
* I have put the phrase "Hello World" it there just for fun.
*********************************************************************
*
D SI_Msg S 50A INZ('Hello World')
D SI_MsgP S * INZ(%ADDR(SI_Msg))
*
*********************************************************************
* num is where I will put some numeric data. Note that the EVAL
* statement below will take care of unpacking the data from the
* DB file. The SI_Fmt above takes care of putting the '-' sign
* in the right place automatically for us!!
*********************************************************************
*
D num_ds DS
D num_Hex 4A INZ(X'00000000')
D num 10I 0 OVERLAY(num_Hex)
*
*********************************************************************
* Buf is the place where we build our string that will go into the
* ascii file for us. It needs to be big enough to hold all of
* the data for one record of output (including formatting).
*********************************************************************
*
D Buf S 100A
D BufP S * INZ(%ADDR(Buf))
D BufLen S 10U 0 INZ(100)
*
*********************************************************************
* Here we start the logic.
*
* 1. Use the open API to create the file, specifying that the data
* to be stored in it will be in codepage (ccsid) 437 (or whatever
* you change it to above in the CP field).
*
*********************************************************************
*
C EVAL FileNam=%TRIM(FileNam) + ZeroBin
C EVAL FileDescr=open(FileNamP:oflg1:omode:cp)
C IF FileDescr=-1
C EVAL errnoP = errnoF
C 'Error open1' DSPLY errno
C ENDIF
*********************************************************************
*
* 2. Use the close API to close the file. This may seem strange,
* since we are going to turn right around and reopen the file,
* but that is so it will do the automatic translation for us from
* our current job CCSID (whatever it happens to be) into the
* ascii CP.
*********************************************************************
*
C EVAL RC=close(FileDescr)
*
*********************************************************************
*
* 3. Use the open API to reopen the file with NEW oflag values.
* These will handle the ebcidic to ascii translation for us.
*********************************************************************
C EVAL FileDescr=open(FileNamP:oflg2)
*
C IF FileDescr=-1
C EVAL errnoP = errnoF
C 'Error open2' DSPLY errno
* EXIT
C ENDIF
*********************************************************************
*
* 4. For each record of input in the DB file:
*
* 4a. Build the output record based on the format in SI_Fmt.
*
* 4b. Use the write API to put translate the data from ebcidic
* to ascii and store it in the IFS file.
*********************************************************************
*
C EVAL SI_Msg=%TRIM(SI_Msg) + NLZero
C EVAL SI_Fmt=%TRIM(SI_Fmt) + ZeroBin
*
C EVAL num= -123
C EVAL RC=sprintf(BufP: SI_FmtP: num: SI_MsgP)
C EVAL RC=write(FileDescr: BufP: BufLen)
C IF RC=-1
C EVAL errnoP = errnoF
C 'Error writ1' DSPLY errno
C ENDIF
*
C EVAL num= 456
C EVAL RC=sprintf(BufP: SI_FmtP: num: SI_MsgP)
C EVAL RC=write(FileDescr: BufP: BufLen)
*
C IF RC=-1
C EVAL errnoP = errnoF
C 'Error writ2' DSPLY errno
C ENDIF
*
*********************************************************************
*
* 5. Use the close API to close the IFS file.
*
*********************************************************************
*********************************************************************
C EVAL RC=close(FileDescr)
*
C SETON LR
Jon Paris - AS/400 AD Market Support - paris@ca.ibm.com
Phone: (416) 448-4019 - Fax: (416) 448-4414
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to "MIDRANGE-L@midrange.com".
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
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.
