-
Das ist das Programm, welches über das API QUSLJOB die Jobs ermittelt, die den Selektionskriterien in der *ENTRY PLIST entsprechen. Das Programm habe ich vor über 10 Jahren in RPG III programmiert und dann später nur nach RPG IV umgesetzt. So sieht das Teil auch aus, aber es tut seinen Dienst. Ich habe es seinerzeit MOD014R genannt.
PHP-Code:
*-------------------------------------------------------------------------------------------*
* *
* Jobs im System ermitteln *
* *
*-------------------------------------------------------------------------------------------*
*
* Allgemeine Felddeklarationen API
D USRSPC S 20A INZ('MOD014U QTEMP ')
D CURENT S 10S 0
* Binäre Felddefinitionen
D DS
D USSIZE 1 4B 0
D GENLEN 5 8B 0
D RTVLEN 9 12B 0
D STRPOS 13 16B 0
D NUMFLD 17 20B 0
D KEYFLD 21 24B 0
* Jobname
D JOJOB DS
D JOJONA 1 10
D JOJOBE 11 20
D JOJONR 21 26
* Headerdaten Userspace
D GENHDR DS
D OFFSET 1 4B 0
D NUMENT 9 12B 0
D LSTSIZ 13 16B 0
* Satzaufbau Format JOBL0200
D RTVVAR DS
D JAJONA 1 10
D JAJOBE 11 20
D JAJONR 21 26
D JAINJI 27 42
D JAJOST 43 52
D JAJOTY 53 53
D JAJOUT 54 54
D JARESV 55 56
D JAAJS 81 84
* Fehlermeldungen API
D ERRCOD DS
D BYTPRO 1 4B 0
D BYTAVA 5 8B 0
D EXCID 9 15
D RSRVD 16 16
D EXCDTA 17 116
*
*-------------------------------------------------------------------------------------------*
*
* ÜBERGABEPARAMTER FÜR DIESES PROGRAMM
*
C *ENTRY PLIST
C PARM P0_PRCSTS 10 <--> VERARBEITUNGSSTATUS
C PARM P0_JONA 10 <--> JOBNAME
C PARM P0_JOBE 10 <--> JOBBENUTZERNAME
C PARM P0_JONR 6 <--> JOBNUMMER
C PARM P0_JOST 10 <--> JOBSTATUS
C PARM P0_JOTY 1 <--> JOBTYP
C PARM P0_JOUT 1 <--- JOBUNTERTYP
C PARM P0_AJS 4 <--- AKTIVER JOBSTATUS
*
*-------------------------------------------------------------------------------------------*
*
* INFORMATIONEN ZU DEN JOBS IN DEN USERSPACE STELLEN
C IF P0_PRCSTS = '*OPEN'
C EXSR SR005
C ENDIF
* INFORMATIONEN ZU DEN JOBS AUS DEM USERSPACE ABRUFEN
C IF P0_PRCSTS = '*QUERY'
C EXSR SR010
C ENDIF
* PROGRAMMENDE
C IF P0_PRCSTS = '*CLOSE'
C SETON LR
C ELSE
C RETURN
C ENDIF
*
*-------------------------------------------------------------------------------------------*
* INFORMATIONEN ZU DEN JOBS IN DEN USERSPACE STELLEN *
*-------------------------------------------------------------------------------------------*
*
C SR005 BEGSR
* VERARBEITUNGSSTATUS SETZEN
C MOVEL(P) '*CLOSE' P0_PRCSTS
* ERSTELLUNG EINES USERSPACES
C MOVE *BLANKS ERRCOD
C Z-ADD *ZERO BYTPRO
C CALL 'QUSCRTUS'
C PARM USRSPC
C PARM *BLANKS USEXAT 10
C PARM 1024 USSIZE
C PARM ' ' USINIT 1
C PARM '*CHANGE ' USAUTH 10
C PARM *BLANKS USTEXT 50
C PARM '*YES ' USREPL 10
C PARM ERRCOD
C IF EXCID = *BLANKS
* EINSTELLEN DER JOBS IN DEN USERSPACE
C MOVE P0_JONA JOJONA
C MOVE P0_JOBE JOJOBE
C MOVE P0_JONR JOJONR
C Z-ADD 1 NUMFLD
C Z-ADD 0101 KEYFLD
C MOVE *BLANKS ERRCOD
C Z-ADD *ZERO BYTPRO
C CALL 'QUSLJOB'
C PARM USRSPC
C PARM 'JOBL0200' JOFONA 8
C PARM JOJOB
C PARM P0_JOST
C PARM ERRCOD
C PARM P0_JOTY
C PARM NUMFLD
C PARM KEYFLD
C IF EXCID = *BLANKS
* ABRUF DER HEADERINFORMATIONEN DES USERSPACE
C Z-ADD 125 STRPOS
C Z-ADD 16 GENLEN
C MOVE *BLANKS ERRCOD
C Z-ADD *ZERO BYTPRO
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM GENLEN
C PARM GENHDR
C PARM ERRCOD
C IF EXCID = *BLANKS
C Z-ADD *ZERO CURENT
C MOVEL(P) '*QUERY' P0_PRCSTS
C ENDIF
C ENDIF
C ENDIF
C ENDSR
*
*-------------------------------------------------------------------------------------------*
* INFORMATIONEN ZU DEN JOBS AUS DEM USERSPACE ABRUFEN *
*-------------------------------------------------------------------------------------------*
*
C SR010 BEGSR
* FEHLERKENNZEICHEN SETZEN
C MOVEL(P) '*CLOSE' P0_PRCSTS
* NÄCHSTE LISTENPOSITION
C ADD 1 CURENT
* KEINE EINTRÄGE MEHR IN DER LISTE VORHANDEN
C IF CURENT > NUMENT
* USERSPACE LÖSCHEN
C MOVE *BLANKS ERRCOD
C Z-ADD *ZERO BYTPRO
C CALL 'QUSDLTUS'
C PARM USRSPC
C PARM ERRCOD
* ÜBERGABEPARAMETER LÖSCHEN
C EXSR SR015
C ELSE
* ABRUF DER EINTRÄGE IM USERSPACE
C EVAL STRPOS = OFFSET + ((CURENT - 1) * LSTSIZ) + 1
C Z-ADD LSTSIZ RTVLEN
C MOVE *BLANKS ERRCOD
C Z-ADD *ZERO BYTPRO
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM RTVLEN
C PARM RTVVAR
C PARM ERRCOD
C IF EXCID = *BLANKS
C MOVE JAJONA P0_JONA
C MOVE JAJOBE P0_JOBE
C MOVE JAJONR P0_JONR
C MOVE JAJOST P0_JOST
C MOVE JAJOTY P0_JOTY
C MOVE JAJOUT P0_JOUT
C MOVE JAAJS P0_AJS
C MOVEL(P) '*QUERY' P0_PRCSTS
C ENDIF
C ENDIF
C ENDSR
*
*-------------------------------------------------------------------------------------------*
* ÜBERGABEPARAMETER LÖSCHEN *
*-------------------------------------------------------------------------------------------*
*
C SR015 BEGSR
C MOVE *BLANKS P0_JONA
C MOVE *BLANKS P0_JOBE
C MOVE *BLANKS P0_JONR
C MOVE *BLANKS P0_JOST
C MOVE *BLANK P0_JOTY
C MOVE *BLANK P0_JOUT
C MOVE *BLANKS P0_AJS
C ENDSR
Das ist ein Programm, welches das obige Programm aufruft, um festzustellen, ob die TCP/IP Server aktiv sind, die ja auch nur Jobs im System sind.
PHP-Code:
/*-------------------------------------------------------------------------------------------*/
/* */
/* PRÜFEN TCP/IP SERVER STATUS */
/* */
/*-------------------------------------------------------------------------------------------*/
/* PROGRAMMBEGINN */
PGM PARM(&SERVER &MSGMODE)
/* VARRIABLE DEKLARIEREN */
DCL VAR(&SERVER) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGMODE) TYPE(*CHAR) LEN(10)
DCL VAR(&SVRNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PRCSTS) TYPE(*CHAR) LEN(10) /* <--> VERARBEITUNGSSTATUS */
DCL VAR(&JONA) TYPE(*CHAR) LEN(10) /* <--> JOBNAME */
DCL VAR(&JOBE) TYPE(*CHAR) LEN(10) /* <--> JOBBENUTZER */
DCL VAR(&JONR) TYPE(*CHAR) LEN(6) /* <--> JOBNUMMER */
DCL VAR(&JOST) TYPE(*CHAR) LEN(10) /* <--> JOBSTATUS */
DCL VAR(&JOTY) TYPE(*CHAR) LEN(1) /* <--> JOBTYP */
DCL VAR(&JOUT) TYPE(*CHAR) LEN(1) /* <--- JOBUNTERTYP */
DCL VAR(&AJS) TYPE(*CHAR) LEN(4) /* <--- AKTIVER JOB STATUS */
/* ES SOLL KEIN SERVER GEPRÜFT WERDEN */
IF COND(&SERVER *EQ '*NONE') THEN(GOTO +
CMDLBL(STEP999))
/* SERVER SNMP */
IF COND(&SERVER *EQ '*SNMP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTMSNMP')
CHGVAR VAR(&SVRNAME) VALUE('SNMP')
ENDDO
/* SERVER ROUTED */
IF COND(&SERVER *EQ '*ROUTED') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTRTD*')
CHGVAR VAR(&SVRNAME) VALUE('ROUTED')
ENDDO
/* SERVER BOOTP */
IF COND(&SERVER *EQ '*BOOTP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTBOOTP')
CHGVAR VAR(&SVRNAME) VALUE('BOOTP')
ENDDO
/* SERVER TFTP */
IF COND(&SERVER *EQ '*TFTP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTTFT*')
CHGVAR VAR(&SVRNAME) VALUE('TFTP')
ENDDO
/* SERVER DNS */
IF COND(&SERVER *EQ '*DNS') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTOBDNS')
CHGVAR VAR(&SVRNAME) VALUE('DNS')
ENDDO
/* SERVER DHCP */
IF COND(&SERVER *EQ '*DHCP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTODDHCPS')
CHGVAR VAR(&SVRNAME) VALUE('DHCP')
ENDDO
/* SERVER DDM */
IF COND(&SERVER *EQ '*DDM') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QRWTLSTN')
CHGVAR VAR(&SVRNAME) VALUE('DDM')
ENDDO
/* SERVER TELNET */
IF COND(&SERVER *EQ '*TELNET') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTGTELNETS')
CHGVAR VAR(&SVRNAME) VALUE('TELNET')
ENDDO
/* SERVER FTP */
IF COND(&SERVER *EQ '*FTP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTFTP*')
CHGVAR VAR(&SVRNAME) VALUE('FTP')
ENDDO
/* SERVER SMTP */
IF COND(&SERVER *EQ '*SMTP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTSMTPSRVR')
CHGVAR VAR(&SVRNAME) VALUE('SMTP')
ENDDO
/* SERVER LPD */
IF COND(&SERVER *EQ '*LPD') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTLPD*')
CHGVAR VAR(&SVRNAME) VALUE('LPD')
ENDDO
/* SERVER HTTP */
IF COND(&SERVER *EQ '*HTTP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTMHHTTP')
CHGVAR VAR(&SVRNAME) VALUE('HTTP')
ENDDO
/* SERVER WSG */
IF COND(&SERVER *EQ '*WSG') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTWSG*')
CHGVAR VAR(&SVRNAME) VALUE('WSG')
ENDDO
/* SERVER POP */
IF COND(&SERVER *EQ '*POP') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTPST*')
CHGVAR VAR(&SVRNAME) VALUE('POP')
ENDDO
/* SERVER REXEC */
IF COND(&SERVER *EQ '*REXEC') THEN(DO)
CHGVAR VAR(&JONA) VALUE('QTRXC*')
CHGVAR VAR(&SVRNAME) VALUE('REXEC')
ENDDO
/* SELEKTIONSKRITERIEN FÜR DIE ABZURUFENDEN JOBS FÜLLEN */
CHGVAR VAR(&JOBE) VALUE('*ALL')
CHGVAR VAR(&JONR) VALUE('*ALL')
CHGVAR VAR(&JOST) VALUE('*ACTIVE')
CHGVAR VAR(&JOTY) VALUE('B')
/* VERARBEITUNGSSTATUS SETZEN */
CHGVAR VAR(&PRCSTS) VALUE('*OPEN')
/* JOBS ABRUFEN */
CALL PGM(MOD014R) PARM(&PRCSTS &JONA &JOBE &JONR +
&JOST &JOTY &JOUT &AJS)
/* DER SERVER IST NICHT AKTIV */
IF COND(&PRCSTS *EQ '*CLOSE') THEN(DO)
SNDPGMMSG MSGID(MOD0001) MSGF(MOD001M) +
MSGDTA(&SVRNAME) MSGTYPE(&MSGMODE)
ENDDO
/* DER SERVER IST AKTIV */
IF COND(&PRCSTS *EQ '*QUERY') THEN(DO)
CHGVAR VAR(&PRCSTS) VALUE('*CLOSE')
CALL PGM(MOD014R) PARM(&PRCSTS &JONA &JOBE &JONR +
&JOST &JOTY &JOUT &AJS)
SNDPGMMSG MSGID(MOD0002) MSGF(MOD001M) +
MSGDTA(&SVRNAME) MSGTYPE(*COMP)
ENDDO
/* PROGRAMMENDE */
STEP999: ENDPGM
Ich denke, dass Du damit etwas anfangen kannst.
Frank Hildebrandt
Similar Threads
-
By bode in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 15-12-06, 09:43
-
By jogisarge in forum NEWSboard Programmierung
Antworten: 4
Letzter Beitrag: 22-11-06, 16:02
-
By ratinger in forum NEWSboard Server Software
Antworten: 11
Letzter Beitrag: 09-11-06, 16:02
-
By ratinger in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 23-05-06, 10:55
-
By mwithake in forum NEWSboard Programmierung
Antworten: 1
Letzter Beitrag: 22-08-05, 14:13
Berechtigungen
- Neue Themen erstellen: Nein
- Themen beantworten: Nein
- You may not post attachments
- You may not edit your posts
-
Foren-Regeln
|
Erweiterte Foren Suche
Google Foren Suche
Forum & Artikel
Update eMail
AS/400 / IBM i
Server Expert Gruppen
Unternehmens IT
|
Kategorien online Artikel
- Big Data, Analytics, BI, MIS
- Cloud, Social Media, Devices
- DMS, Archivierung, Druck
- ERP + Add-ons, Business Software
- Hochverfügbarkeit
- Human Resources, Personal
- IBM Announcements
- IT-Karikaturen
- Leitartikel
- Load`n`go
- Messen, Veranstaltungen
- NEWSolutions Dossiers
- Programmierung
- Security
- Software Development + Change Mgmt.
- Solutions & Provider
- Speicher – Storage
- Strategische Berichte
- Systemmanagement
- Tools, Hot-Tips
Auf dem Laufenden bleiben
|
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Mit Zitat antworten
Bookmarks