ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

list members in iseries table

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • list members in iseries table

    This program will list all members in a multi member physical file.
    A "bunch" of other information is available for the members.

    PHP Code:
    ~
          *=====================================================
          * 
    PROGRAM XXXXXX
          
    PURPOSE - List members in a file
          
    *
          * 
    PROGRAM DESCRIPTION
          
    *   This program will list all members in a file
          
    *
          *
          *
          * 
    INPUT PARAMETERS
          
    *   Description        Type  Size    How Used
          
    *   -----------        ----  ----    --------
          *   
    ApiLibrary         Char  10      input
          
    *   ApiFile            Char  10      input
          
    *
          * 
    INDICATOR USAGE
          
    *   n/a
          
    *
          *=====================================================
          *
          * 
    Program Info
          
    *
         
    d PgmInfo        SDS
         d  
    @PgmName               1     10
         d  
    @Parms                37     39  0
         d  
    @MsgID                40     46
         d  
    @JobName             244    253
         d  
    @UserId              254    263
         d  
    @JobNumber           264    269  0
          
    *
          * 
    constants
          
    *
         
    d Q               c                   const('''')
         
    d Up              c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
         
    d Low             c                   const('abcdefghijklmnopqrstuvwxyz')
          *
          *  
    Field Definitions.
          *
         
    d AllMembers      s             10a   inz('*ALL')
         
    d ApiFile         s             10
         d ApiLibrary      s             10
         d ApiMember       s             10
         d bOvr            s              1a   inz
    ('0')
         
    d cmdstring       s            256
         d cmdlength       s             15  5
         d FileLib         s             20a
         d Format          s              8a
         d MemberName      s             10
         d nBufLen         s             10i 0
         d ObjectLib       s             10
         d OutData         s             30
         d ReceiverLen     s              9b 0 inz
    (100)
         
    d SpaceVal        s              1    inz(*BLANKS)
         
    d SpaceAuth       s             10    inz('*CHANGE')
         
    d SpaceText       s             50    inz(*BLANKS)
         
    d SpaceRepl       s             10    inz('*YES')
         
    d SpaceAttr       s             10    inz(*BLANKS)
         
    d UseScreen       s               n
         d UserSpaceOut    s             20
          
    *
          * 
    QUSRMBRD API return Struture
          
    * ============================
         
    d Mbrd0100        ds                  inz
         d  nBytesRtn                    10i 0
         d  nBytesAval                   10i 0
         d  DBXLIB                       10a
         d  DBXFIL                       10a
         d  MbrName                      10a
         d  FileAttr                     10a
         d  SrcType                      10a
         d  dtCrtDate                    13a
         d  dtLstChg                     13a
         d  MbrText                      50a
         d  bIsSource                     1a
         d  RmtFile                       1a
         d  LglPhyFile                    1a
         d  ODPSharing                    1a
         d  filler2                       2a
         d  RecCount                     10i 0
         d  DltRecCnt                    10i 0
         d  DataSpaceSz                  10i 0
         d  AccpthSz                     10i 0
         d  NbrBasedOnMbr                10i 0
          
    *
          * 
    Create userspace datastructure
          
    *
         
    d                 DS
         d  StartPosit             1      4B 0
         d  StartLen               5      8B 0
         d  SpaceLen               9     12B 0
         d  ReceiveLen            13     16B 0
         d  MessageKey            17     20B 0
         d  MsgDtaLen             21     24B 0
         d  MsgQueNbr             25     28B 0
          
    *
          * 
    Date structure for retriving userspace info
          
    *
         
    d InputDs         DS
         d  UserSpace              1     20
         d  SpaceName              1     10
         d  SpaceLib              11     20
         d  InpFileLib            29     48
         d  InpFFilNam            29     38
         d  InpFFilLib            39     48
         d  InpRcdFmt             49     58
          
    *
          *  
    Data structure for the retrieve user space command
          
    *
         
    d GENDS           DS
         d  OffsetHdr            117    120B 0
         d  SizeHeader           121    124B 0
         d  OffsetList           125    128B 0
         d  NbrInList            133    136B 0
         d  SizeEntry            137    140B 0
          
    *
          * 
    Datastructure for retrieving elements from userspace
          
    *
         
    d HeaderDs        DS
         d  OutFileNam             1     10
         d  OutLibName            11     20
         d  OutType               21     25
         d  OutFormat             31     40
         d  RecordLen             41     44B 0
          
    *
          * List 
    the members
          
    *
         
    d ListDs          DS
         d  LmMember                     10
         d  LmType                       10
         d  LmCreationDt                  7
         d  LmCreationTm                  6
         d  LmLastChgDt                   7
         d  LmLastChgTm                   6
         d  LmDescription                50
          
    *
          * 
    Retrive object description
          
    *
         
    d RtvObjInfo      DS
         d  RoBytRtn                     10i 0
         d  RoBytAvl                     10i 0
         d  RoObjNam                     10a
         d  RoObjLib                     10a
         d  RoObjTypRt                   10a
         d  RoObjLibRt                   10a
         d  RoObjASP                     10i 0
         d  RoObjOwn                     10a
         d  RoObjDmn                      2a
         d  RoObjCrtDts                  07a
         d  RoObjCrtTim                  06a
         d  RoObjChgDts                  07a
         d  RoObjChgTim                  06a
         d  RoExtAtr                     10a
         d  RoTxtDsc                     50a
         d  RoSrcF                       10a
         d  RoSrcLib                     10a
         d  RoSrcMbr                     10a
          
    *
          * 
    API Error Data Structure
          
    *
         
    d ErrorDs         DS                  INZ
         d  BytesPrv               1      4B 0
         d  BytesAvl               5      8B 0
         d  MessageId              9     15
         d  ERR
    ###                16     16
         
    d  MessageDta            17    116
          
    *
          *=====================================================
          * 
    MAIN LINE
          
    *=====================================================
          *
          * 
    Now List the members of this source file to a userspace
          
    *
         
    c                   exsr      $QUSCRTUS
          
    *
         
    c                   eval      MemberName '*ALL'
         
    c                   eval      Format  'MBRL0200'
         
    c                   exsr      $QUSLMBR
          
    *
          *  
    Read back the members
          
    *
         
    c                   eval      StartPosit 1
         c                   
    eval      StartLen 140
          
    *
          * 
    First call to get data offsets(start)
          *
         
    c                   call(e)   'QUSRTVUS'
         
    c                   parm                    UserSpaceOut
         c                   parm                    StartPosit
         c                   parm                    StartLen
         c                   parm                    GENDS
         c                   parm                    ErrorDs
          
    *
          * 
    Then call to get number of entries
          
    *
         
    c                   eval      StartPosit OffsetHdr 1
         c                   
    eval      StartLen SizeHeader
          
    *
         
    c                   call(e)   'QUSRTVUS'
         
    c                   parm                    UserSpaceOut
         c                   parm                    StartPosit
         c                   parm                    StartLen
         c                   parm                    HeaderDs
         c                   parm                    ErrorDs
          
    *
         
    c                   eval      StartPosit OffsetList 1
         c                   
    eval      StartLen SizeEntry
          
    *
          *  Do for 
    number of members
          
    *
         
    c                   do        NbrInList
         c                   call
    (e)   'QUSRTVUS'
         
    c                   parm                    UserSpaceOut
         c                   parm                    StartPosit
         c                   parm                    StartLen
         c                   parm                    ListDs
         c                   parm                    ErrorDs
          
    *
         
    c                   eval      ApiMember LmMember
         c                   exsr      $QUSRMBRD
         c                   
    eval      OutData = %trim(LmMember) + '-' +
         
    c                             %char(RecCount)
         
    c     OutData       dsply                   reply             1
          
    *
         
    c                   eval      StartPosit StartPosit SizeEntry
         c                   enddo
          
    *
         
    c                   eval      *inlr = *on
          
    *=====================================================
          * 
    $QUSRMBRD API Retreive Member Description
          
    *=====================================================
         
    c     $QUSRMBRD     begsr
          
    *
         
    c                   eval      nBufLen = %size(MbrD0100)
         
    c                   eval      Format  'MBRD0200'
          
    *
         
    c                   call(e)   'QUSRMBRD'
         
    c                   parm                    MbrD0100
         c                   parm                    nBufLen
         c                   parm                    Format
         c                   parm                    FileLib
         c                   parm                    ApiMember
         c                   parm                    bOvr
          
    *
         
    c                   endsr
          
    *========================================================================
          * 
    $QUSCRTUS API to create user space
          
    *========================================================================
         
    c     $QUSCRTUS     begsr
          
    *
          * 
    Create a user space named ListMember in QTEMP.
          *
         
    c                   Eval      BytesPrv 116
         c                   movel
    (p)  'MEMBERS'     SpaceName
         c                   movel
    (p)  'QTEMP'       SpaceLib
          
    *
          * 
    Create the user space
          
    *
         
    c                   call(e)   'QUSCRTUS'
         
    c                   parm      UserSpace     UserSpaceOut
         c                   parm                    SpaceAttr
         c                   parm      4096          SpaceLen
         c                   parm                    SpaceVal
         c                   parm                    SpaceAuth
         c                   parm                    SpaceText
         c                   parm                    SpaceRepl
         c                   parm                    ErrorDs
          
    *
         
    c                   endsr
          
    *========================================================================
          * 
    $QUSLMBR  API List all members in a file
          
    *========================================================================
         
    c     $QUSLMBR      begsr
          
    *
         
    c                   eval      nBufLen = %size(MbrD0100)
          *
         
    c                   call(e)   'QUSLMBR'
         
    c                   parm                    UserSpaceOut
         c                   parm                    Format
         c                   parm                    FileLib
         c                   parm                    AllMembers
         c                   parm                    bOvr
         c                   parm                    ErrorDs
          
    *
         
    c                   endsr
          
    *=====================================================
          * 
    Initialization
          
    *=====================================================
         
    c     *inzsr        begsr
          
    *
         
    c     *entry        plist
         c                   parm                    ApiLibrary
         c                   parm                    ApiFile
          
    *
         
    c                   eval      FileLib     ApiFile  ApiLibrary
          
    *
         
    c                   endsr

    Attached Files
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com
Working...
X