|
midrange.com
I don't know what is wrong with your program but I use a different approach.
I try to allocate the subsystem description exclusively using ALCOBJ. When
the subsystem is active you can't get a lock on it.
Albert York
-----Original Message-----
From: Robin Coles [SMTP:robin@ringbase.com]
Sent: Monday, June 17, 2002 10:27 AM
To: rpg400-l@midrange.com
Subject: Problem with QWDRSBSD retrieve subsystem information
API - long message
Hi,
I'm having a problem with QWDRSBSD, and I've tried everything I can
think of, to no avail.
I want a program that will wake up every so often and check to see
if a
couple of subsystems are started and specific job queues released.
The
"every so often" is very short at the moment for testing.
The job queues bit works fine, sends an enquiry message to QSYSOPR
and
everything is happy. As soon as I add the QWDRSBSD call it seems to
stamp all over the variable space, and ends up trying to call a
gibberish string rather than the quoted literal string 'QMHSNDM'.
The
gibberish string rather suspiciously has *BASE imbedded in it.
TFM says the receiver variable must be at least 8 bytes and that
data
will be truncated. I've tried 76, 1000, 9999, nothing seems to make
any
difference. I've also tried some completely different source
downloaded
from News/400 and that works the first time it's run, then fails
with
the same sort of error I'm getting.
I'm at V5R1, I've also tried it at V4R5 with the same result.
The program is included below. Any ideas? It must be something dim
I'm
doing, but I can't see it.
Thanks
Robin
* Purpose: Monitor QBATCH and QEOM and moan if they're
* held.
*
* API information from News/400 article Feb 95.
*
**********************************************************
** Times (in seconds) to pause
d Initial c 3
d Normal c 60
** Use Unix API to pause processing for a while
D sleep PR 10I 0 EXTPROC('sleep')
D seconds 10U 0 VALUE
** Procedure prototypes
D CheckSbs PR N
D Subsystem 10A CONST
D Library 10A CONST
D CheckJobQ PR N
D JobQueue 10A CONST
D Library 10A CONST
D SendMessage PR
D Name 10A CONST
D Type 10A CONST
* API error structure
D APIERR DS
D ERRPRV 1 4B 0 INZ(96)
D ERRLEN 5 8B 0
D EXCPID 9 15
D EXCPDT 17 96
D APILEN 4B 0 INZ(0)
D APIFMT 8
* API format JOBQ0100: Job queue information
D JOBQ01 DS
D JQINAM 9 18
D JQILIB 19 28
D JQIOPR 29 38
D JQIAUT 39 48
D JQINBR 49 52B 0
D JQISTS 53 62
D JQISBS 63 72
D JQITXT 73 122
* API format SBSI0100: Subsystem information
D SBSI01 DS
D SBINAM 9 18
D SBILIB 19 28
D SBISTS 29 38
D SBIMAX 69 72B 0
D SBIACT 73 76B 0
d Ok s 1n
** Sleep for 5 mins on startup to give the subsystems time to
wake
up
c CallP Sleep(Initial)
** Loop forever
c DoW 1 = 1
** Check QBATCH first (NB - is QBATCH in QGPL not QSYS)
c Eval Ok = CheckSBS('QBATCH':'QGPL')
c If Not Ok
c CallP SendMessage('QBatch':'Subsystem')
c Else
c Eval Ok = CheckJOBQ('QBATCH':'QGPL')
c If Not Ok
c CallP SendMessage('QBatch':'Job Queue')
c EndIf
c EndIf
** Check QEOM next
c Eval Ok = CheckSBS('QEOM':'QSYS')
c If Not Ok
c CallP SendMessage('QEOM':'Subsystem')
c Else
c Eval Ok = CheckJOBQ('QEOM':'QSYS')
c If Not Ok
c CallP SendMessage('QEOM':'Job Queue')
c EndIf
c EndIf
c CallP Sleep(Normal)
c EndDo
c Seton
Lr
** ----------------------------------------------------------
** CheckSbs - Check susbsystem is up
P CheckSbs B
D CheckSbs PI N
D Subsystem 10A CONST
D Library 10A CONST
c Eval SbsiNm = Subsystem + Library
C RESET APIERR
C CALL 'QWDRSBSD'
C PARM SBSI01
C PARM 76 APILEN
C PARM 'SBSI0100' APIFMT
C PARM SBSINM 20
C PARM APIERR
c If SbiSts = '*ACTIVE'
C RETURN *On
C Else
C Return *Off
C EndIf
P CheckSbs E
** ----------------------------------------------------------
** CheckJobQ - Check Job queue is released
P CheckJobQ B
D CheckJobQ PI N
D JobQueue 10A CONST
D Library 10A CONST
c Eval JobQNm = JobQueue + Library
C RESET APIERR
C CALL 'QSPRJOBQ'
C PARM JOBQ01
C PARM 122 APILEN
C PARM 'JOBQ0100' APIFMT
C PARM JOBQNM 20
C PARM APIERR
c If JqISts = 'RELEASED'
C RETURN *On
C Else
C Return *Off
C EndIf
P CheckJobQ E
** ----------------------------------------------------------
** SendMessage - Send message to QSysOpr
P SendMessage B
D SendMessage PI
D Name 10A CONST
D Type 10A CONST
D mh_msgid s 7 Inz('CPF9898')
D mh_msgfile s 20 inz('QCPFMSG QSYS')
D mh_msgdta s 256 inz(*blanks)
D mh_msgdtalen s 9b 0
D mh_msgtype s 10 Inz('*INQ')
D mh_msgq s 20 inz('*SYSOPR')
D mh_msgq# s 9b 0 inz(1)
D mh_replymsgq s 20 inz('UK1080 QGPL')
D mh_msgkey s 4
c If Type = 'Subsystem'
c Eval Mh_MsgDta = '!!Warning - ' +
c %TrimR(Type) + ' ' +
c %TrimR(Name) + ' is not
running'
c Else
c Eval Mh_MsgDta = '!!Warning - ' +
c %TrimR(Type) + ' ' +
c %TrimR(Name) + ' is HELD.'
c EndIf
C Eval mh_msgdtalen =
%Len(%TrimR(Mh_MsgDta))
C Call 'QMHSNDM'
C parm mh_msgid
C parm mh_msgfile
C parm mh_msgdta
C parm mh_msgdtalen
C parm mh_msgtype
C parm mh_msgq
C parm mh_msgq#
C parm mh_replymsgq
C parm mh_msgkey
C parm ApiErr
C RETURN
P SendMessage E
_______________________________________________
This is the RPG programming on the AS400 / iSeries (RPG400-L)
mailing list
To post a message email: RPG400-L@midrange.com
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/cgi-bin/listinfo/rpg400-l
or email: RPG400-L-request@midrange.com
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
