PHP-Code:
* ************************************************************************
* Programm erstellen mit:
* CRTRPGMOD MODULE(DIPOBJ/LISTMSGW) SRCFILE(DIPSRVPGM/QRPGLESRC) dbgview(*all)
* CRTPGM PGM(DIPOBJ/LISTMSGW) BNDSRVPGM(DIPSRVPGM/#USRSPAPI)
* ************************************************************************
h bnddir('QC2LE')
fgrobjdp uf a e disk
D* UserSpace für JobListe
D UserOK S 1A
D UserSpace S 20A INZ('QUSLJOB QTEMP ')
D UsrSpcExtA S 10A INZ('PROD')
D UsrSpcText S 50A INZ('JobListe ')
D LstFormat S 8A INZ('JOBL0200')
D I_O_Err s *
D LstFormat1 S 8A INZ('JOBI0200')
D NbrEntries s 10U 0
D Count s 10U 0
d
D JOBL0200 ds
D $JobName 1 10
D $UserName 11 20
D $Jobnummer 21 26
D $JobIdent 27 42
D $Status 43 52
D $JobTyp 53 53
D $JobTyp1 54 54
D $Reserved 55 56
D $JobInfoStat 57 57
D $Reserved1 58 60
d
D JOBI0200 ds
d $Job_Type 61 61
d $Funktion 98 107
D $Act_Job_St 108 111
d $jobi0200 1 256
d
d $jobi0200Len s 4B 0 Inz(256)
d
d
d Job_Name2 s 26 Inz('*INT ')
d Job_Name1 s 26 Inz('*INT ')
d Job_Name s 26 Inz('*ALL *ALL *ALL ')
d Job_Status s 10 Inz('*ACTIVE ')
d
D sk c ''''
d Fehler_msg s 100
d Empfaenger s 30
d Befehl s 800
d MSG_Text s 256
d
d von c x'00'
d nach c x'40'
* Prototype Lists
D/COPY dipsrvpgm/QRPGLESRC,FUSPCP
D System pr 10i 0 extproc('system')
D * value options(*string)
D
c Eval UserOK = CrtUsrSpc(UserSpace :
c UsrSpcExtA :
c UsrSpcText )
c
c Call 'QUSLJOB'
c Parm UserSpace
c Parm LstFormat
c Parm Job_Name
c Parm Job_Status
c Parm I_O_Err
c
c
c Eval NbrEntries = GetNumEnt(UserSpace)
c
c For Count = 1 to NbrEntries
c Eval JOBL0200 = GetSpcEnt(UserSpace : Count)
c ExSr Work
c EndFor
c
c Eval UserOK = DltUsrSpc(UserSpace)
c
c Eval *InLr = *On
c Work BegSr
c*
c Call (e) 'QUSRJOBI'
c Parm JOBI0200
c Parm $jobi0200Len
c Parm LstFormat1
c Parm Job_Name1
c Parm $JobIdent
c
c If $Act_Job_St = 'MSGW' and
c $Job_Type <> 'W'
c ExSr SR_Fehler
c EndIf
c*
c EndSr
c SR_Fehler BegSr
c*
c Eval Job_Name2 = $Jobname + $UserName +
c $JobNummer
c Call 'MSGINFO'
c Parm Job_Name2
c Parm MSG_Text
c
c Eval Fehler_msg ='MSGW - Job: ' +
c $Jobname + $UserName +
c $JobNummer + ' ' + $Funktion
c
c Eval MSG_Text = %XLate( von:nach:msg_text )
c If pm_Empf1 <> *Blanks
c Eval Empfaenger = pm_Empf1
c ExSr SR_Email
c EndIf
c If pm_Empf2 <> *Blanks
c Eval Empfaenger = pm_Empf2
c ExSr SR_Email
c EndIf
c If pm_Empf3 <> *Blanks
c Eval Empfaenger = pm_Empf3
c ExSr SR_Email
c EndIf
c If pm_Empf4 <> *Blanks
c Eval Empfaenger = pm_Empf4
c ExSr SR_Email
c EndIf
c If pm_Empf5 <> *Blanks
c Eval Empfaenger = pm_Empf5
c ExSr SR_Email
c EndIf
c*
c EndSr
c SR_Email BegSr
c*
c Eval Befehl = 'cl_sndm ' +
c sk + 'AS400@GTC10.de' + sk + ' ' +
c sk + %Trim(Empfaenger) + sk + ' ' +
c sk + %Trim( MSG_Text ) + sk + ' ' +
c sk + %Trim(Fehler_msg) + sk
c CallP System( befehl )
c*
c EndSr
c *InzSr BegSr
c*
c *Entry PList
c Parm PM_Empf1 30
c Parm PM_Empf2 30
c Parm PM_Empf3 30
c Parm PM_Empf4 30
c Parm PM_Empf5 30
c*
c EndSr
PHP-Code:
* ************************************************************************
* Service - PGM erstellen mit:
* CRTRPGMOD MODULE(DIPSRVPGM/#USRSPAPI) SRCFILE(DIPSRVPGM/QRPGLESRC)
* CRTSRVPGM SRVPGM(DIPSRVPGM/#USRSPAPI) EXPORT(*ALL)
* ************************************************************************
*
**************************************************************************
*
* Program Name: FunctUsp
* Program Title: User Space Function Procedures
* Author:
* Origin Date: 1/23/1998
* Revisions:
*
**************************************************************************
H NOMAIN
* Prototype Lists
D/COPY dipsrvpgm/QRPGLESRC,FUSPCp
* Generic Error Structure
D/COPY dipsrvpgm/QRPGLESRC,QUSEC
* User Space Generic Structure
D/COPY dipsrvpgm/QRPGLESRC,QUSGEN
D DS_Error DS
D Bytpv 1 4b 0 inz(100)
D Bytav 5 8b 0 inz(0)
D MSgid 9 15
D Resvd 16 16
D Exdta 17 256
D Exdta52 17 67
**************************************************************************
*
* Procedure Name: CrtUsrSpc
*
**************************************************************************
P CrtUsrSpc B EXPORT
D CrtUsrSpc PI 1A
D UsrSpcName 20A VALUE
D UsrSpcExtA 10A VALUE
D UsrSpcText 50A VALUE
* Local Variables
* User Space API Fields
D SpaceName S 20A
D SpaceSize S 9B 0 INZ(8388608)
D SpaceInit S 1A INZ(x'00')
D SpaceExtA S 10A
D SpaceAut S 10A INZ('*ALL')
D SpaceText S 50A
D SpaceRepl S 10A INZ('*YES')
D SpaceDom S 10A INZ('*USER')
* Set error code structure to use basic feedback
C***** EVAL QUSBPRV = 16
* Set up imported variables
C EVAL SpaceName = UsrSpcName
C EVAL SpaceExtA = UsrSpcExtA
C EVAL SpaceText = UsrSpcText
C CALL 'QUSCRTUS'
C PARM SpaceName
C PARM SpaceExtA
C PARM SpaceSize
C PARM SpaceInit
C PARM SpaceAut
C PARM SpaceText
C PARM SpaceRepl
C PARM DS_Error
C PARM SpaceDom
C SELECT
C WHEN Bytav = 0
C RETURN 'Y'
C WHEN Bytav <> 0
C Bytav DSPLY 'OS400'
C MSgid DSPLY 'OS400'
C Exdta52 DSPLY 'OS400'
C RETURN 'N'
C ENDSL
P CrtUsrSpc E
**************************************************************************
*
* Procedure Name: GetUsrSpcP
*
**************************************************************************
P GetUsrSpcP B EXPORT
D GetUsrSpcP PI *
D UsrSpcName 20A VALUE
D SpaceName S 20A
D SpacePoint S *
* Set error code structure to use basic feedback
C EVAL QUSBPRV = 16
* Set up imported variables
C EVAL SpaceName = UsrSpcName
* Get the pointer for the user space
C CALL 'QUSPTRUS'
C PARM SpaceName
C PARM SpacePoint
C PARM QUSEC
C RETURN SpacePoint
P GetUsrSpcP E
**************************************************************************
*
* Procedure Name: GetNumEnt
*
**************************************************************************
P GetNumEnt B EXPORT
D GetNumEnt PI 9B 0
D UsrSpcName 20A VALUE
* Local Variables
D UsrSpcPntr S *
D BigField S 32767A BASED(UsrSpcPntr)
* Get the pointer for the user space
C EVAL UsrSpcPntr = GetUsrSpcP(UsrSpcName)
* Move the based on pointer to
C MOVEL BigField QUSH0100
* Return number of list entries
C RETURN QUSNBRLE
P GetNumEnt E
**************************************************************************
*
* Procedure Name: GetSpcEnt
*
**************************************************************************
P GetSpcEnt B EXPORT
D GetSpcEnt PI 32767A
D UsrSpcName 20A VALUE
D EntNumber 9B 0 VALUE
* Local Variables
D UsrSpcPntr S *
D ListPointr S *
D BigField S 32767A BASED(ListPointr)
D BigFldOut S 32767A
* Get the pointer for the user space
C EVAL UsrSpcPntr = GetUsrSpcP(UsrSpcName)
* Move the based on pointer to get header information
C EVAL ListPointr = UsrSpcPntr
C MOVEL BigField QUSH0100
* Check to see if entry requested is <= user space number entries
* If not, return a blank field
C IF EntNumber > QUSNBRLE
C EVAL BigFldOut = *BLANKS
C RETURN BigFldOut
C ENDIF
* Return specific list entry
C EVAL EntNumber = EntNumber - 1
C EVAL ListPointr = ListPointr + QUSOLD +
C (QUSSEE * EntNumber)
C EVAL BigFldOut = %SUBST(BigField:1:QUSSEE)
C RETURN BigFldOut
P GetSpcEnt E
**************************************************************************
*
* Procedure Name: DltUsrSpc
*
**************************************************************************
P DltUsrSpc B EXPORT
D DltUsrSpc PI 1A
D UsrSpcName 20A VALUE
* Local Variables
* User Space API Fields
D SpaceName S 20A
* Set error code structure to use basic feedback
C EVAL QUSBPRV = 16
* Set up imported variables
C EVAL SpaceName = UsrSpcName
C CALL 'QUSDLTUS'
C PARM SpaceName
C PARM QUSEC
C SELECT
C WHEN QUSBAVL = 0
C RETURN 'Y'
C WHEN QUSBAVL <> 0
C RETURN 'N'
C ENDSL
P DltUsrSpc E
PHP-Code:
/IF NOT DEFINED(FUSPCP)
**************************************************************************
*
* Program Name: FunctUSPcp
* Program Title: Copy Member for User Space Prototypes
* Origin Date: 10/30/97
* Author:
* Revisions:
*
**************************************************************************
* Prototype for CrtUsrSpc procedure (Create User Space)
D CrtUsrSpc PR 1A
D UsrSpcName 20A VALUE
D UsrSpcExtA 10A VALUE
D UsrSpcText 50A VALUE
* Prototype for GetUsrSpcP procedure (Get User Space Pointer)
D GetUsrSpcP PR *
D UsrSpcName 20A VALUE
* Prototype for GetNumEnt procedure (Get Number of Entries in the User Space)
D GetNumEnt PR 9B 0
D UsrSpcName 20A VALUE
* Prototype for GetSpcEnt procedure (Get Specific Entry in the User Space)
D GetSpcEnt PR 32767A
D UsrSpcName 20A VALUE
D EntNumber 9B 0 VALUE
* Prototype for DltUsrSpc procedure (Delete User Space)
D DltUsrSpc PR 1A
D UsrSpcName 20A VALUE
/DEFINE FUSPCP
/ENDIF
PHP-Code:
* ==================================================================
* = Program....... CBX007T =
* = Description... Sample code using procedure GetLogMsg =
* = =
* = CrtRPGMod Module( MSGINFO ) srcfile(dipsrvpgm/qrpglesrc) dbgview(*all)
* = CrtPgm Pgm( MSGINFO ) Module( MSGINFO ) BndSrvPgm( CBX007 )=
* ==================================================================
H Option( *SrcStmt )
*-- API error data structure
D ApiError Ds
D AeBytPrv 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0
D AeExcpId 7a
D 1a
D AeExcpDta 128a
*-- Get joblog message prototype
D GetLogMsg Pr 512a Varying
D PxJobId 26a Const
D PxMsgOpt 6a Const
D PxMsgKey 4a Options( *NoPass )
*-- Data definitions
D JobId s 26a
D Msg s 256a
D MsgKey s 4a
C *Entry PList
c Parm JobId
c Parm Msg
C Eval Msg = GetLogMsg( JobId
C : '*LAST'
c
C )
C Eval *InLr = *On
Das CL dazu
PHP-Code:
pgm
dcl &Empaenger1 *char 30
dcl &Empaenger2 *char 30
dcl &Empaenger3 *char 30
dcl &Empaenger4 *char 30
dcl &Empaenger5 *char 30
chgvar &Empaenger1 'Name@irgendwas.de'
/*chgvar &Empaenger2 'Name2@irgendwas.de */
START:
call listmsgw (&Empaenger1 +
&Empaenger2 +
&Empaenger3 +
&Empaenger4 +
&Empaenger5 )
dlyjob dly(300)
goto START
endpgm
Bei Frage kurze PN an mich
Gruß
Ronald
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Mit Zitat antworten
Bookmarks