× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: Accessing the IFS through RPG (BIG posting)
  • From: Jon Paris <paris@xxxxxxxxxx>
  • Date: Mon, 22 Dec 1997 11:03:57 -0500

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 thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.