Here's one:
     HBndDir('QC2LE')
     HActGrp('QILE')
     HDftActGrp(*No)
     HDatFmt(*USA)
     HCopyRight('(C) Computer Resource Systems, Inc.')
     H*
     DListDomSvrs      PR ExtProc('QnninListDominoServers')
     DRcvVar                               Like(LDS)
     DRcvVarLen                      10I 0 Const
     DFormatName                      8A   Const
     DERRCOD                          1A
     D*
     DRtvDomSvr        PR ExtProc('QnninRtvDominoServerI')
     DInfVar                               Like(LDS)
     DInfVarL                        10I 0 Const
     DSrvNam                         10A   CONST
     DSrvNamL                        10I 0 CONST
     DERRCOD                          1A
     D*
     DLDS              DS
     DBytRet                         10I 0
     DBytAvl                         10I 0
     DSvrOff                         10I 0
     DNbrSvr                         10I 0
     DLenSvr                         10I 0
     D*
     DLDSLEN           S              4B 0 INZ(9999)
     DRCVVAR           S           9999A
     DINFVAR           S             67A
     DERRCOD           S              1A
     DSRVNAM           S             10A
     DSTSBIN           S              1B 0
     DSTS              S              1A
     DNAMLEN           S             10I 0 INZ(35)
     DNUMATR           S             10I 0 INZ(1)
     DATRNAM           S             10A   DIM(1)
     DMSGLEN           S              9B 0
     DUSRQTY           S              9B 0
     D*
     C************************************************************
     C*                  M a i n l i n e
     C************************************************************
     C*
     C* Retrieve the System Name
     C                   CALL      'QWCRNETA'
     C                   PARM                    NAMVAR           35
     C                   PARM                    NAMLEN
     C                   PARM                    NUMATR
     C                   PARM      'SYSNAME'     ATRNAM
     C                   PARM                    ERRCOD
     C*
     C                   SUBST     NAMVAR:25     SYSNAM            8
     C*
     C                   CALLP     ListDomSvrs(RCVVAR:LDSLEN:
     C                                         'DSRV0100':ERRCOD)
     C                   MOVEl     RCVVAR        LDS
     C*
     C                   MOVEl     *BLANKS       PAGMSG          500
     C                   Z-Add     1             START             4 0
     C                   Add       SVROFF        START
     C*
     C                   Do        NbrSvr        X                 3 0
     C                   EVAL      SRVNAM=%SUBST(RCVVAR:START:10)
     C                   ADD       LENSVR        START
     C*
     C                   CALLP     RtvDomSvr(INFVAR:67:
     C                                       SrvNam:10:ERRCOD)
     C                   EVAL      STS=%SUBST(INFVAR:67:1)
     C                   MOVE      STS           STSBIN
     C                   MOVE      STSBIN        SRVSTS            2
     D* Status
     D* 1 = Server Ended
     D* 2 = Server Started
     D* 3 = Server Starting
     D* 4 = Server Ending
     D* 5 = Server in Standby Mode
     D* 99= Unknown Status
     C*
     C     SRVSTS        IFne      ' 2'
     C     SRVNAM        ANDne     '*HTTPSETUP'
     C                   EVAL      PAGMSG='** Alert ** Server ' +
     C                             %TRIMR(SRVNAM) + ' on system ' +
     C                             %trimr(SYSNAM) + ' is in status ' +
     C                             %trim(SRVSTS) + '.             ' +
     C                             '     1= Ended, 2= Started, 3= 
Starting, ' +
     C                             '4=Ending, 5= Standby, 99= Unknown.'
     C*
     C                   CALL      'SNDPAGMSGR'
     C                   PARM                    PAGMSG
     C*
     C* Tell the operator
     C                   CALL      'QEZSNDMG'
     C                   PARM      '*INFO'       MSGTYP           10
     C                   PARM      '*NORMAL'     MSGMOD           10
     C                   PARM      PAGMSG        MSGTXT          256
     C                   PARM      256           MSGLEN
     C                   PARM      '*SYSOPR'     MSGLST           10
     C                   PARM      1             USRQTY
     C                   PARM                    MSGSTS            1
     C                   PARM                    MSGFNC            4
     C                   PARM                    ERRCOD
     C                   PARM      'N'           MSGSHW            1
     C                   PARM                    MSGQUE           20
     C                   PARM      '*USR'        MSGTP2            4
     C                   ENDif
     C*
     C                   ENDdo
     C*
     C                   MOVE      *ON           *INLR

The last two sections are for sending messages to the operator and our 
pagers.  You can easily chop that part off & return with your list of 
servers in an array.

Scott




rob@xxxxxxxxx
Sent by: domino400-bounces+scott.jordan=crsys.com@xxxxxxxxxxxx
01/29/2004 07:31 AM
Please respond to Lotus Domino on the iSeries / AS400

 
        To:     Lotus Domino on the iSeries / AS400 <domino400@xxxxxxxxxxxx>
        cc: 
        Subject:        Re: How to get a list of Domino Servers


Does anyone have a sample RPGLE program that they use to read the 
/QIBM/UserData/LOTUS/LOTUS_SERVERS file?

Rob Berendt
-- 
Group Dekko Services, LLC
Dept 01.073
PO Box 2000
Dock 108
6928N 400E
Kendallville, IN 46755
http://www.dekko.com

_______________________________________________
This is the Lotus Domino on the iSeries / AS400 (Domino400) mailing list
To post a message email: Domino400@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/domino400
or email: Domino400-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/domino400.




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.