|
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.
midrange.com
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 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.
