|
midrange.com
Kurt,
>QusMaterialContext is too slow for just retrieving the count.
Actually, that is what you need to use. But you need to not give it
enough space to actually materialize the entries. This makes it
return a close approximation of the entry count. See the MI
Functional Reference manual for the details.
I wrote an example program to do this not too long ago. The RPG code
is pasted below. AFAIK, it should run at security level 50.
H Option( *SrcStmt: *NoDebugIO )
H DftActGrp( *No )
H ActGrp( *Caller )
* Program to demonstrate how to get the approximate
* number of objects in a specified library.
D RtvObjCnt PR 10I 0
D LibName 10A Const
D Input S 10A
D Library S 10A
D Count S 10I 0
D BegTime S Z
D EndTime S Z
D Duration S 15P 0
D Seconds S 12P 3
D Msg S 52A
D Lower C 'abcdefghijklm+
D nopqrstuvwxyz'
D Upper C 'ABCDEFGHIJKLM+
D NOPQRSTUVWXYZ'
* Get library name; quit when no name is keyed
C Eval Input = *Blanks
C 'Library?' Dsply Input
C If Input = *Blanks
C Eval *InLR = *On
C Return
C Endif
* Display object count and time required to retrieve it
C Lower:Upper Xlate Input Library
C Time BegTime
C Eval Count = RtvObjCnt( Library )
C Time EndTime
C EndTime Subdur BegTime Duration:*MS
C Eval Seconds = Duration / 1000000
C Eval Msg = %trim( %editc( Count: 'N' ) )
+
C ' Objects; ' +
C %trim( %editc( Seconds: 'N' )
) +
C ' Seconds'
C Msg Dsply
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
P RtvObjCnt B
D RtvObjCnt PI 10I 0
D LibName 10A Const
D DS
D LibSysPtrA 1 16A
D LibSysPtr 1 16* ProcPtr Inz( *Null )
D ObjCnt S 10I 0
D MbrCnt S 10I 0
D RslvSp2 PR Extproc( '_RSLVSP2' )
D Object * ProcPtr
D ObjID_Auth 34A Const
D MatCtx PR Extproc(
'QusMaterializeContext' )
D RcvVar Like( RcvVar ) Options(
*VarSize )
D CtxSysPtr 16A Value
D Options Like( MatCtxOpt ) Const
D MatCtxOpt DS
D MatInfo 1A Inz( x'03' )
D MatSelect 1A Inz( x'00' )
D MatNamLen 5I 0 Inz( 0 )
D MatType 1A Inz( x'00' )
D MatSubType 1A Inz( x'00' )
D MatName 30A
D MatDTS 8A Inz( x'0000000000000000' )
D RcvVar DS
D CtxBytPrv 10I 0 Inz( %size( RcvVar ) )
D CtxBytAvl 10I 0 Inz( 0 )
D CtxID 32A
D CtxType 1A Overlay( CtxID : 1 )
D CtxSubType 1A Overlay( CtxID : 2 )
D CtxName 30A Overlay( CtxID : 3 )
D CtxOptions 4A
D CtxOpt1 1A Overlay( CtxOptions: 1 )
D CtxOpt2 1A Overlay( CtxOptions: 2 )
D CtxOpt3 1A Overlay( CtxOptions: 3 )
D CtxOpt4 1A Overlay( CtxOptions: 4 )
D CtxRecover 4A
D CtxRecover1 1A Overlay( CtxRecover: 1 )
D CtxSize 10I 0
D CtxInitVal 1A
D CtxClass 4A
D CtxClass1 1A Overlay( CtxClass: 1 )
D 7A
D 16A
D CtxAccGrp * ProcPtr
D* (Array of entries would start here if RcvVar was bigger)
* First resolve library name to system pointer; if the library
* is not found *PSSR will get control and return an object
* count of -1
C Callp RslvSp2( LibSysPtr:
C x'0401' +
C LibName +
C ' ' +
C x'0000' )
* Materialize Context with no selection criteria or room for any
* context entries to be returned. The bytes available in the
* receiver variable will give us an estimate of the total number
* of objects in the library if we subtract the size of the
header
* then divide by the entry length for one object. This object
* count is a low-overhead approximation and includes one entry
for
* each member in each database file.
C Eval MatSelect = x'00'
C Callp MatCtx( RcvVar:
C LibSysPtrA:
C MatCtxOpt )
* If nothing got returned (not even the header data), then a
* problem occured and we'll return -1 as the count rather than
* zero which is an otherwise valid object count.
C If CtxBytAvl <= *Zero
C Return -1
C Endif
* Convert the bytes available into an object count
C Eval ObjCnt = (CtxBytAvl - 96 ) / 48
* Repeat the operation but select only database file members
C Eval MatSelect = x'02'
C Eval MatType = x'0D'
C Eval MatSubtype = x'50'
C Callp MatCtx( RcvVar:
C LibSysPtrA:
C MatCtxOpt )
* Convert the bytes available into a member count and adjust
* our previous object count to exclude database members
C Eval MbrCnt = (CtxBytAvl - 96 ) / 48
C Eval ObjCnt = ObjCnt - MbrCnt
C Return ObjCnt
C *PSSR Begsr
C Return -1
C Endsr
P RtvObjCnt E
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
+---
| This is the MI Programmers Mailing List!
| To submit a new message, send your mail to MI400@midrange.com.
| To subscribe to this list send email to MI400-SUB@midrange.com.
| To unsubscribe from this list send email to MI400-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: dr2@cssas400.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.
