|
midrange.com
Dan,
This is the "API" section of the tool that I wrote for finding members in a
source of a given type. The enrty parameters are member name ( Generic* ),
file name ( Generic* DFTVAL(*ALL) ), library to search for ( standard
libraries, *LIBL, *USRLIBL, *CURLIB, *ALL) and member type. This program
writes into a file and then a standard subfile program is invoked to display
the file. I have commented that call out.
Regards
Narayanan R Pillai
Senior Technical Architect
American Medical & Life Insurance
<code>
F*
F* Extract File To Hold all Member Data
F*
FMbrdtl IF A E K Disk
D*
D* Qualify all Userspace used in the Program
D*
D SpaceName ds
D 10 Inz('LISTOBJSPC')
D 10 Inz('QTEMP')
D*
D SpaceName1 ds
D 10 Inz('LISTMBRSPC')
D 10 Inz('QTEMP')
D*
D* Parameters Used in QUSCRTUS API for creating SPACENAME
D*
D Attribute s 10 Inz('LSTOBJ')
D Initsize s 9B 0 Inz(9999999)
D Initvalue s 1 Inz(x'00')
D Authority s 10 Inz('*USE')
D Text s 50 Inz('List Objects from Lib')
D Replace s 10 Inz('*NO')
D*
D* Parameters Used in QUSCRTUS API for creating SPACENAME1
D*
D Attribute1 s 10 Inz('LSTMBR')
D Text1 s 50 Inz('List Members from File')
D*
D* Parameters Used in QUSLOBJ API
D*
D Lstobjfmt s 10 Inz('OBJL0200')
D Objectlib ds
D ObjectName 10
D LibraryName 10
D Objecttype s 10 Inz('*FILE')
D*
D* Error Code Data Structure for all API's
D*
D ErrCode ds
D ByteProvided 9B 0 Inz(116)
D ByteAvailable 9B 0
D Cpfid 7
D Reserved 1
D ErrData 100
D*
D* Pointers Used in the Program
D*
D Ptr s *
D Fileptr s *
D Ptr1 s *
D Mbrptr s *
D*
D* ListData Section for Userspace LISTSPACE
D*
D ListData ds Based(Ptr)
D ListVar 1024
D Arr 1 Overlay(ListVar) Dim(1024)
D Listoffset 9B 0 Overlay(ListVar:125)
D ListEntries 9B 0 Overlay(ListVar:133)
D*
D FileArrDta ds 108 Based(Fileptr)
D File_Lib 20
D FileType 10
D FileAttribute 10 Overlay(FileArrdta:32)
D*
D* ListData Section for Userspace LISTSPACE1
D*
D ListMbrDta ds Based(Ptr1)
D ListMbrVar 1024
D ListMbrArr 1 Overlay(ListMbrVar) Dim(1024)
D ListMbroffset 9B 0 Overlay(ListMbrVar:125)
D ListMbrEntry 9B 0 Overlay(ListMbrVar:133)
D*
D MbrArrDta ds 100 Based(Mbrptr)
D MbrArrNam 10
D MbrArrTyp 10
D MbrArrDesc 50 Overlay(MbrArrdta:47)
D*
D* Parameters Used in QUSLMBR API
D*
D Lstmbrfmt s 10 Inz('MBRL0200')
D Override s 1 Inz('1')
D*
D* General Work Variables
D*
D FileCount s 5 0
D MbrCount s 5 0
D*
C**********************************************************************
C* *
C* M A I N P R O C E S S I N G *
C* *
C**********************************************************************
C*
C* *entry parameter list
C*
C *entry plist
C parm inmbr 10
C parm infile 10
C parm inlib 10
C parm inmbrtyp 10
C*
C eval ObjectName = infile
C eval LibraryName = inlib
C*
C* Delete the User Spaces if they Exist
C*
C Call 'QUSDLTUS'
C Parm SpaceName
C Parm ErrCode
C*
C Call 'QUSDLTUS'
C Parm SpaceName1
C Parm ErrCode
C*
C* Create the User Space to List the File Info from Libraries
C*
C Call 'QUSCRTUS'
C Parm SpaceName
C Parm Attribute
C Parm Initsize
C Parm Initvalue
C Parm Authority
C Parm Text
C Parm Replace
C Parm ErrCode
C*
C* Create the User Space to List the Member Info from Files
C*
C Call 'QUSCRTUS'
C Parm SpaceName1
C Parm Attribute1
C Parm Initsize
C Parm Initvalue
C Parm Authority
C Parm Text1
C Parm Replace
C Parm ErrCode
C*
C* List Objects into Userspace
C*
C Call 'QUSLOBJ'
C Parm SpaceName
C Parm Lstobjfmt
C Parm Objectlib
C Parm Objecttype
C Parm Errcode
C*
C* Get a Pointer to the User Space SPACENAME
C*
C Call 'QUSPTRUS'
C Parm SpaceName
C Parm Ptr
C*
C* Set the File Pointer to the start of the list data section
C* Note : The pointer address should be adjusted to the next byte
C*
C Eval Fileptr = %Addr(Arr(Listoffset))
C Eval Fileptr = Fileptr + 1
C*
C* List Member Passed from all these File
C*
C Eval FileCount = 1
C*
C Dow FileCount <= ListEntries
C*
C* Check if the file has an attribute PF i.e. eliminate other type
C* (At this stage we can't decide if it is PF-SRC or PF-DTA so use
both)
C* even though we want to list members only from type PF-SRC)
C*
C If FileAttribute = 'PF'
C*
C Call 'QUSLMBR'
C Parm SpaceName1
C Parm Lstmbrfmt
C Parm File_Lib
C Parm Inmbr
C Parm Override
C Parm ErrCode
C*
C* Process each File to see whether any members have been listed
C*
C Exsr Prcfile
C*
C EndIf
C*
C* Move the file pointer by 108 bytes so as it points to the next
entry
C*
C Eval Fileptr = Fileptr + 108
C Eval FileCount = FileCount + 1
C*
C Enddo
C*
C* Call the Subfile Program to Display Results
C*
C************ Call 'WRKMBRLE'
C*
C Eval *inlr = *on
C*
C**********************************************************************
C* *
C* PrcFile - Process Each File to see whether it has listed any *
C* Members into the User Space SPACENAME1 *
C* *
C**********************************************************************
C PrcFile Begsr
C*
C*
C* Get a Pointer to the User Space SPACENAME1
C*
C Call 'QUSPTRUS'
C Parm SpaceName1
C Parm Ptr1
C*
C* Set the Mbr Pointer to the start of the list data section
C* Note : The pointer address should be adjusted to the next byte
C*
C Eval Mbrptr = %Addr(ListMbrArr(ListMbroffset))
C Eval Mbrptr = Mbrptr + 1
C*
C* Check if any members have been listed
C*
C If ListMbrEntry > 0
C*
C Eval MbrCount = 1
C*
C Dow MbrCount <= ListMbrEntry
C*
C* Check to see if MbrArrTyp is not blanks i.e. do not list members
C* from file of attribute PF-DTA
C*
C If (Inmbrtyp = '*ALL' and MbrArrTyp <> '
')or
C (Inmbrtyp <> '*ALL' and
C Inmbrtyp = MbrArrTyp)
C Clear rmbrdtl
C*
C Eval MbrNam = MbrArrNam
C Eval MbrTyp = MbrArrTyp
C Movel File_Lib MbrFil
C Move File_Lib MbrLib
C Eval MbrDesc = MbrArrDesc
C Write rmbrdtl
C EndIf
C*
C* Move the file pointer by 100 bytes so as it points to the next
entry
C*
C Eval Mbrptr = Mbrptr + 100
C Eval MbrCount = MbrCount + 1
C*
C Enddo
C*
C EndIf
C*
C Endsr
</code>
----- Original Message -----
From: "Dan" <dbcemid@yahoo.com>
To: <midrange-l@midrange.com>
Sent: Friday, November 08, 2002 8:55 AM
Subject: RE: Finding members
> An API to do what? Find file members across the system? Go ahead,
> make my day!
>
> TIA, Dan
>
> --- rob@dekko.com wrote:
> > I am pretty sure there is an API to do this. Fellow here was using
> > it. If
> > you're interested in pursuing that path I'll ask him.
> >
> > I like that QSHELL stuff. You can pipe that to an IFS file:
> > QSH CMD('/usr/bin/find /QSYS.LIB/BPCS405CDS.LIB/Q*.FILE -name
> > ''ORD500*.MBR''>/rob/list.txt')
> > dspf '/rob/list.txt'
> > ....+....1....+....2....+....3....+....4....+....5
> > ************Beginning of data**************
> > /QSYS.LIB/BPCS405CDS.LIB/QCLSRC.FILE/ORD500C.MBR
> > /QSYS.LIB/BPCS405CDS.LIB/QDDSSRC.FILE/ORD500FM.MBR
> > /QSYS.LIB/BPCS405CDS.LIB/QDDSSRC.FILE/ORD500O.MBR
> > /QSYS.LIB/BPCS405CDS.LIB/QPNLSRC.FILE/ORD500HT.MBR
> > /QSYS.LIB/BPCS405CDS.LIB/QRPGSRC.FILE/ORD500.MBR
> > ************End of Data********************
> >
> > There might even be a cool way to get the WDSc tool to do this for
> > you.
> >
> > Rob Berendt
>
> __________________________________________________
> Do you Yahoo!?
> U2 on LAUNCH - Exclusive greatest hits videos
> http://launch.yahoo.com/u2
> _______________________________________________
> This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
> To post a message email: MIDRANGE-L@midrange.com
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/cgi-bin/listinfo/midrange-l
> or email: MIDRANGE-L-request@midrange.com
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/midrange-l.
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.
