× 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: RE: List of objects in the IFS
  • From: Peter Connell <peterc@xxxxxxxxxxxxx>
  • Date: Fri, 16 Jun 2000 16:19:09 +1200

Walter,
Several people have requested a solution that I developed. Perhaps it may
help. I've attached the soucrce.
Cheers, Peter



-----Original Message-----
From: Walter Hesius [mailto:Walter.Hesius@Village.uunet.be]
Sent: Friday, June 16, 2000 7:53 AM
To: RPG400-L@midrange.com
Subject: Re: List of objects in the IFS


I've used this example, and it works fine on one machine.
Now i've used it on another machine, and i get an huge length back,
something like 3245001546. This happens with every object in the IFS.
The objects in the IFS of this machine do not use DOS rules for naming.
Any ideas?

----- Original Message -----
From: Scott Klement <klemscot@klements.com>
To: 'RPG400 list' <RPG400-L@midrange.com>
Sent: Sunday, May 28, 2000 10:00 AM
Subject: Re: List of objects in the IFS


> Hi Bob,
>
> On Sat, 27 May 2000, Marion, Bob wrote:
>
> > I'm trying to programmatically generate a list of objects in an IFS
> > directory. I'm trying to use opendir() and readdir(), but since I am not
a
> > C programmer I was not able to understand how to define these API's
> > parameters in RPG. Could anyone give me sample PR definitions for these
> > procedures? A little guidance on how to use them will be greatly
> > appreciated also.
> >
> > TIA
> >
> > Bob Marion
> >
>
> Sure,  here's an example that just uses the DSPLY op-code
> to list each object in a directory in the IFS...
>
> Have Fun!
>
> ------------------------------cut here-----------------------------------
>
> ** This is a simple test program, to demonstrate reading a directory
> **  using the IFS API with RPG IV.
>
>  ** <<CHANGE THIS!!>>
> D PATHTOLIST      C                   CONST('/QDLS/MLHELP/')
>
> D**********************************************************************
> D*
> D* Directory Entry Structure (dirent)
> D*
> D* struct dirent {
> D*   char           d_reserved1[16];  /* Reserved                       */
> D*   unsigned int   d_reserved2;      /* Reserved                       */
> D*   ino_t          d_fileno;         /* The file number of the file    */
> D*   unsigned int   d_reclen;         /* Length of this directory entry
> D*                                     * in bytes                       */
> D*   int            d_reserved3;      /* Reserved                       */
> D*   char           d_reserved4[8];   /* Reserved                       */
> D*   qlg_nls_t      d_nlsinfo;        /* National Language Information
> D*                                     * about d_name                   */
> D*   unsigned int   d_namelen;        /* Length of the name, in bytes
> D*                                     * excluding NULL terminator      */
> D*   char           d_name[_QP0L_DIR_NAME]; /* Name...null terminated   */
> D*
> D* };
> D*
> D p_dirent        s               *
> D dirent          ds                  based(p_dirent)
> D   d_reserv1                   16A
> D   d_reserv2                   10U 0
> D   d_fileno                    10U 0
> D   d_reclen                    10U 0
> D   d_reserv3                   10I 0
> D   d_reserv4                    8A
> D   d_nlsinfo                   12A
> D     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)
> D     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)
> D     nls_lang                   3A   OVERLAY(d_nlsinfo:7)
> D     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)
> D   d_namelen                   10U 0
> D   d_name                     640A
>
> D*--------------------------------------------------------------------
> D* Open a Directory
> D*
> D* DIR *opendir(const char *dirname)
> D*
> D* NOTE: We are at V3R2, so we can't use OPTIONS(*STRING) yet :(
> D*--------------------------------------------------------------------
> D opendir         PR              *   EXTPROC('opendir')
> D  dirname                        *   VALUE
>
> D*--------------------------------------------------------------------
> D* Read Directory Entry
> D*
> D* struct dirent *readdir(DIR *dirp)
> D*
> D* NOTE: We are at V3R2, so we can't use OPTIONS(*STRING) yet :(
> D*--------------------------------------------------------------------
> D readdir         PR              *   EXTPROC('readdir')
> D  dirp                           *   VALUE
>
>
> D* a few local variables...
> D dh              S               *
> D PathName        S            256A
> D Name            S            256A
>
>
> C* Step1: Open up the directory.
> c                   eval      PathName= PATHTOLIST + x'00'
> C                   eval      dh = opendir(%addr(PathName))
> C                   if        dh = *NULL
> c                   eval      Msg = 'Cant open directory'
> c                   dsply                   Msg              50
> c                   eval      *INLR = *ON
> c                   Return
> c                   endif
>
> C* Step2: Read each entry from the directory (in a loop)
> c                   eval      p_dirent = readdir(dh)
> c                   dow       p_dirent <> *NULL
>
> C* FIXME: This code can only handle file/dir names under 256 bytes long
> C*         because thats the size of "Name"
> c                   if        d_namelen < 256
> c                   eval      Name = %subst(d_name:1:d_namelen)
> c                   movel     Name          dsply_me         52
> c     dsply_me      dsply
> c                   endif
>
> c                   eval      p_dirent = readdir(dh)
> c                   enddo
>
> C* Step3: End Program
> c                   dsply                   Pause             1
> c                   eval      *inlr = *On
>
> ------------------------------cut here-----------------------------------
>
>
> +---
> | This is the RPG/400 Mailing List!
> | To submit a new message, send your mail to RPG400-L@midrange.com.
> | To subscribe to this list send email to RPG400-L-SUB@midrange.com.
> | To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
> | Questions should be directed to the list owner/operator:
david@midrange.com
> +---
>

+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator:
david@midrange.com
+---
 

**********************************************************************************************************
Privileged / Confidential Information may be contained in this message. If you 
are not the addressee indicated in this message (or responsible for delivery of 
the message to such person), you may not copy or deliver this message to 
anyone. In such case, you should destroy this message, and please notify us 
immediately. 

Please advise immediately if you or your employer does not consent to Internet 
e-mail for messages of this kind. Opinions and other information expressed in 
this message are not given or endorsed by my firm or employer unless otherwise 
indicated by an authorised representative independent of this message.
             CMD        PROMPT('List IFS Directory')

             PARM       KWD(DIR) TYPE(*PNAME) LEN(256) MIN(1) +
                          PROMPT('Directory Name')
             PARM       KWD(OUTPUT) TYPE(*CHAR) LEN(1) RSTD(*YES) +
                          DFT(*) SPCVAL((*) (*PRINT P) (*OUTFILE +
                          F)) PROMPT('Output')
             PARM       KWD(OUTFILE) TYPE(Q1) PMTCTL(OUTFILE) +
                          PROMPT('File to receive output')

 Q1:         QUAL       TYPE(*NAME) LEN(10) MIN(1)
             QUAL       TYPE(*NAME) LEN(10) MIN(1)

             OUTFILE: PMTCTL CTL(OUTPUT) COND((*EQ F)) NBRTRUE(*EQ 1)


     H DATEDIT(*DMY)
     H DftActGrp(*No)
     H BndDir( 'QC2LE' )

      *---------------------------------------------------------------------
      * Module Name   : DIR
      *
      * Description   : Display IFS directory. Output to display, printer
      *                 or file.
      *                 Example DIR('home/peter')
      *
      * Created by    : Peter Connell
      *
      * Date          : 26/11/1999
      *
      *----------------------------------------------------------------*
      * CPP for DIR command
      *----------------------------------------------------------------*

     FQSYSPRT   O    F  132        PRINTER OFLIND(*INOF) USROPN

      *---------------------------------------------------------------------
      * Prototype for API procedures
      *----------------------------------------------------------------*
     Dlstat            PR            10I 0 EXTPROC('lstat')
     D                                 *   VALUE
     D                                 *   VALUE

     Dopendir          PR              *   EXTPROC('opendir')
     D                                 *   VALUE

     Dreaddir          PR              *   EXTPROC('readdir')
     D                                 *   VALUE

     Dclosedir         PR            10I 0 EXTPROC('closedir')
     D                                 *   VALUE

     D SndPgmMsg       PR              N
     D Qmsgid                         7    CONST
     D Qmsgf                         20    CONST
     D Qmsg                         128    CONST
     D Qmsgtp                        10    CONST OPTIONS(*NOPASS)

      *---------------------------------------------------------------------
      * Prototypes for retrieving error generated by procedure call
      *---------------------------------------------------------------------
     D StrErr          PR              *   ExtProc( 'strerror' )
     D  Err                          10I 0 Value

     D ErrTxt          PR            79
     D                                1    Options( *Omit )

     D GetErr          PR              *   ExtProc( '__errno' )
     D                                1    Options( *Omit )

      *----------------------------------------------------------------*
     D*** stat data structure returned by procedure lstat()
     D StatDS          DS           128
     D  st_mode                      10U 0
     D  st_ino                       10U 0
     D  st_nlink                      5U 0
     D  reserved1                     2A
     D  st_uid                       10U 0
     D  st_gid                       10U 0
     D  st_size                      10U 0
     D  st_atime                     10U 0
     D  st_mtime                     10U 0
     D  st_ctime                     10U 0
     D  st_dev                       10U 0
     D  st_blksize                   10I 0
     D  st_allocsize                 10I 0
     D  st_objtype                   10A
     D  reserved2                     2A
     D  st_codepage                   5U 0
     D  st_reserved1                 62A
     D  st_ino_gen_id                10U 0

     D*** direntry data structure returned by procedure readdir()
     D DirEntry        DS
     D d_reserved1                   16A
     D d_fileno_genid                10U 0
     D d_fileno                      10U 0
     D d_reclen                      10U 0
     D d_reserved3                   10I 0
     D d_reserved4                    6A
     D d_reserved5                    2A
     D d_ccsid                       10I 0
     D d_country_id                   2A
     D d_language_id                  3A
     D d_nls_reserved                 3A
     D d_namelen                     10U 0
     D d_name                       640A

     D Null            S              1A   Inz(X'00')
     D ReturnInt       S             10I 0
     D ReturnDir       S               *
     D PtrToEntry      S               *
     D RtnEntry        S                   BASED(PtrToEntry) Like(DirEntry)
     D EntryName       S            120A
     D EntryPath       S            256A
     D CmdLine         S            512
     D CmdLen          S             15  5
     D HHMMSS          S              6  0
     D DirError        C                   'Error occurred when attempting to -
     D                                     open directory'

      * Input Parameters
     D DirName         S            100A
     D FullName        S            256A
     D Option          S              1A

      * Work variables
     D OutFile         DS
     D  OutFilNam                    10
     D  OutFilLib                    10

     D ObjVar          S             90
     D ObjVarLen       S             10I 0 Inz(%size(ObjVar))
     D ObjVarFmt       S              8
     D ObjTyp          S             10

     D APIERR          DS
     D  ERRSIZ                 1      4B 0 INZ(256)
     D  ERRLEN                 5      8B 0 INZ(0)
     D  ERRMIC                 9     15
     D  ERRNBR                16     16
     D  ERRDTA                17    272

     D PSDS           SDS           512
      *----------------------------------------------------------------*


     C                   Eval      FullName = %trimr(DirName) + Null
      * Open directory
     C                   Eval      ReturnDir = opendir(%addr(FullName))

      * Terminate if error occurred when opening directory
     C                   If        ReturnDir = *Null
     C                   Callp     SndPgmMsg('CPF9898':'QCPFMSG'
     C                                       :ErrTxt(*Omit))
     C                   Eval      *inlr = *on
     C                   Return
     C                   Endif
     C
      * Open file for output
     C                   Open      QSYSPRT

     C                   If        Option <> 'F'
     C                   Eval      *inOF = *on
     C                   Endif

     C                   Dou       PtrToEntry = *Null
      * Read next directory entry
     C                   Eval      PtrToEntry  = readdir(ReturnDir)

      * Directory entry name is in field d_name
     C                   If        PtrToEntry <> *Null
     C                   Eval      DirEntry = RtnEntry
     C
      * Get directory entry name
     C                   Eval      EntryName = %str(%addr(d_name))

      * Determine object type of entry
     C                   Eval      EntryPath = %trim(DirName) + '/'
     C                             + %trimr(EntryName) + Null
     C                   Eval      ReturnInt = lstat(%addr(EntryPath)
     C                                         : %addr(StatDS))
      * Print entry
     C                   Except    DirLine
     C                   Endif

     C                   Enddo

      * Close directory and printer file
     C                   Eval      ReturnInt = closedir(ReturnDir)
     C                   Close     QSYSPRT

      * Display spool file if requested
     C                   If        Option = '*'
     C                   Eval      CmdLine = 'DSPSPLF QSYSPRT * *LAST'
     C                   Eval      CmdLen = %len(%trim(CmdLine))
     C                   Call      'QCMDEXC'     Qcmdexc
      * Delete spool file
     C                   Eval      CmdLine = 'DLTSPLF QSYSPRT * *LAST'
     C                   Eval      CmdLen = %len(%trim(CmdLine))
     C                   Call      'QCMDEXC'     Qcmdexc

     C                   Endif

     C                   Eval      *inlr = *on

      *----------------------------------------------------------------*
     C     *Inzsr        Begsr

     C     *Entry        Plist
     C                   Parm                    DirName
     C                   Parm                    Option
     C                   Parm                    OutFile

     C     Qcmdexc       Plist
     C                   Parm                    CmdLine
     C                   Parm                    CmdLen

     C                   TIME                    HHMMSS

      * OUTPUT(*OUTFILE)
     C                   If        Option = 'F'

      * Check if outfile exists
     C                   Call      'QUSROBJD'
     C                   Parm                    ObjVar
     C                   Parm                    ObjVarLen
     C                   Parm      'OBJD0100'    ObjVarFmt
     C                   Parm                    OutFile
     C                   Parm      '*FILE'       ObjTyp
     C                   Parm                    APIERR

      * Error if library does not exist
     C                   If        ERRMIC = 'CPF9810'
     C                   Callp     SndPgmMsg('CPF9810':'QCPFMSG'
     C                                       :OutFilLib:'*ESCAPE')
     C                   Endif

      * Create outfile if necessary
     C                   If        ERRMIC = 'CPF9812'
     C                   Eval      CmdLine = 'CRTPF FILE('
     C                             + %trimr(OutFilLib) + '/'
     C                             + %trimr(OutFilNam) + ')'
     C                             + ' RCDLEN(132)'
     C                   Eval      CmdLen = %len(%trim(CmdLine))
     C                   Call      'QCMDEXC'     Qcmdexc
     C                   Else
      * Clear outfile
     C                   Eval      CmdLine = 'CLRPFM FILE('
     C                             + %trimr(OutFilLib) + '/'
     C                             + %trimr(OutFilNam) + ')'
     C                   Eval      CmdLen = %len(%trim(CmdLine))
     C                   Call      'QCMDEXC'     Qcmdexc
     C                   Endif

     C                   Eval      CmdLine = 'OVRPRTF QSYSPRT TOFILE('
     C                             + %trimr(OutFilLib) + '/'
     C                             + %trimr(OutFilNam) + ')'
     C                             + ' CTLCHAR(*NONE)'

     C                   Eval      CmdLen = %len(%trim(CmdLine))
     C                   Call      'QCMDEXC'     Qcmdexc

     C                   Endif


     C                   Endsr
      *----------------------------------------------------------------*

     OQSYSPRT   H    OF                     1 03
     O                       *Date         Y     59
     O                       HHMMSS              68 '  :  :  '
     O                                           73 'Page'
     O                       Page          Z     78
     O          H    OF                     2 03
     O                                           19 'Directory List for'
     O                       DirName            120

     OQSYSPRT   EF           DirLine
     O                       st_objtype          10
     O                       EntryName          132

      *----------------------------------------------------------------*
      * Send pgm message
      *----------------------------------------------------------------*
     P SndPgmMsg       B
     D                 PI              N
     D Msgid                          7    CONST
     D Msgf                          20    CONST
     D Msgdta                       128    CONST
     D Msgtp                         10    CONST OPTIONS(*NOPASS)

      * Work variables
     D Qmsgid          S              7
     D Qmsgf           S             20
     D Qmsgdta         S            128
     D Qmsgln          S             10I 0
     D Qmsgtp          S             10
     D Qmsgq           S             10
     D Qmsgqn          S             10I 0      INZ(3)
     D Qmsgky          S              4
     D Qmsger          S             15


      * Insert default for library if msg file library is blank
     C                   Eval      Qmsgid = Msgid
     C                   Eval      Qmsgf = Msgf
     C                   Eval      Qmsgdta = Msgdta
     C                   If        %subst(Qmsgf:11:10) = *blank
     C                   Eval      %subst(Qmsgf:11:10) = '*LIBL'
     C                   Endif
     C                   Eval      Qmsgln = %len(%trim(Qmsgdta))
     C                   Eval      Qmsgq = '*'
     C                   Eval      Qmsgtp = '*DIAG'
     C                   If        %parms > 3
     C                   Eval      Qmsgtp = Msgtp
     C                   Endif
     C                   If        Qmsgtp = '*STATUS'
     C                   Eval      Qmsgq = '*EXT'
     C                   Endif

     C                   Call      'QMHSNDPM'                           99
     C                   Parm                    Qmsgid                     Msg 
ID
     C                   Parm                    Qmsgf                      Msg 
file
     C                   Parm                    Qmsgdta                    Msg 
text
     C                   Parm                    Qmsgln                     Msg 
length
     C                   Parm                    Qmsgtp                     Msg 
type
     C                   Parm                    Qmsgq                      Pgm 
queue
     C                   Parm                    Qmsgqn                     Pgm 
lvl
     C                   Parm                    Qmsgky                     Msg 
key
     C                   Parm      *LOVAL        Qmsger                     
Error field

     C                   Return    *on
     P                 E

      *----------------------------------------------------------------*
      * Return the previous API function's error in text format
     P ErrTxt          B                   Export

     D ErrTxt          PI            79
     D  DummyParm                     1    Options( *Omit )

      * Local variable(s)
     D ErrNo           S             10I 0 Based( ErrNoPtr )
     D RetChr          S             79
     D Chr300          S            300    Based( Chr300Ptr )

     C                   Eval      ErrNoPtr  = GetErr( *Omit )
     C                   Eval      Chr300Ptr = StrErr( ErrNo )
     C                   Eval      RetChr    = %Str( Chr300Ptr )
     C                   Return    RetChr

     P ErrTxt          E


As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

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.