QUSCRTUQ & QLICVTTP & QUILNGTX

QUSCRTUQ: Create user queue QLICVTTP : Convert object type QUILNGTX : Display long text ** Program . . : CBX1150 ** Description : Test user queues - client function ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : February 19, 2004 ** ** ** Program summary ** --------------- ** ** This program offers some simple templates for a number of the ** MI builtins and C library function used to address user queues ** - here's a list of all available functions: ** ** C library functions: ** 'enq' Enqueue ** 'deq' Dequeue ** 'deqi' Dequeue with indicator ** 'matqmsg' Materialize queue messages ** 'matqat' Materialize queue attributes ** ** MI builtins: ** '_ENQ' Enqueue ** '_DEQ' Dequeue ** '_DEQWAIT' Dequeue with wait ** '_MATQMSG' Materialize queue messages ** '_MATQAT' Materialize queue attributes ** ** ** Programmer's notes: ** Functionally user queues are very much the same as data queues: They ** provide asynchronous communication between programs, and the stored ** messages can be retrieved by arrival sequence or key. ** ** The major advantage of user queues over data queues is speed; they are ** faster than data queues. On the other hand user queues are a bit more ** complicated to put into action; you need to resolve a system pointer ** to the user queue to be able to call the various user queue functions ** and for example get acqainted with such constructs as bit-fields that ** enables you to reference single bits at field level. ** ** This program offers a number of examples of some - but not all - of ** the user queue functions, for you to use as a starting point in the ** event that you should want to include user queues in your tool box. ** You can find more information in the MI Functional Reference and the ** ILE C/C++ for iSeries Run-Time Library Functions manuals. ** ** To run this sample program compile it as described below, start a ** debug session, call it, and then step throug the program in the ** debugger: ** ** StrDbg Pgm( CBX1150 ) - Press F10 ** ** Call Pgm( CBX1150 ) - Press F10 repeatedly ** ** ** Compile options: ** First, create the CBX115S service program. (Instructions can be ** found in the CBX115S source member.) ** ** CrtRpgMod Module( CBX1150 ) DbgView( *LIST ) ** ** CrtPgm Pgm( CBX1150 ) ** Module( CBX1150 ) ** ActGrp( QILE ) ** BndSrvPgm( CBX115S ) ** ** **-- Header specifications: --------------------------------------------** H Option( *SrcStmt ) BndDir( 'QC2LE' ) **-- API Error Data Structure: -----------------------------------------** D ApiError Ds D AeBytPro 10i 0 Inz( %Size( ApiError )) D AeBytAvl 10i 0 Inz D 1a D AeExcpId 7a D AeExcpDta 256a **-- Global variables: -------------------------------------------------** D UsrQuePtrF s * ProcPtr D UsrQuePtrK s * ProcPtr D MsgDeq s 10i 0 ** D EnqMsg s 1024a D DeqMsg s 1024a **-- Global constants: -------------------------------------------------** D DeqGt c x'02' D DeqLt c x'04' D DeqNe c x'06' D DeqEq c x'08' D DeqGe c x'0A' D DeqLe c x'0C' ** D TimeDeqGt c x'02' D TimeDeqLt c x'04' D TimeDeqNe c x'06' D TimeDeqEq c x'08' D TimeDeqGe c x'0A' D TimeDeqLe c x'0C' ** D WaitDeq c x'10' D WaitDeqGt c x'12' D WaitDeqLt c x'14' D WaitDeqNe c x'16' D WaitDeqEq c x'18' D WaitDeqGe c x'1A' D WaitDeqLe c x'1C' **-- Enqueue message prefix: -------------------------------------------** D EnqMsgPfx Ds D EpMsgLen 10i 0 D EpEnqKey 3a **-- Dequeue message prefix: -------------------------------------------** D DeqMsgPfx Ds D DpTimStp 8a D DqWaitTim 8a D DqMsgLen 10i 0 Inz D DqOption 1a ** DqAccSt1: 1; Bit weight 8 ** DqAccSt2: 1; - - 4 ** DqMPL : 1; - - 2 ** DqWait4e: 1; - - 1 ** DqKeyRel: 4; - - 8-1 D DqKey 3a D DqKeyRtn Like( DqKey ) **-- Queue attributes: -------------------------------------------------** D QueAtr Ds 1 D QaBytPrv 10i 0 Inz( %Size( QueAtr )) D QaBytAvl 10i 0 9 D QaObjId 32a D QaObjTyp 1a Overlay( QaObjId: 1 ) D QaObjSub 1a Overlay( QaObjId: *Next ) D QaObjNam 30a Overlay( QaObjId: *Next ) 41 D QaCrtOptBf 4a 45 D 4a 49 D QaSpcSiz 10i 0 53 D QaSpcInzVal 1a 54 D QaPfrClsBf 4a 58 D 7a 65 D QaCtx * ProcPtr 81 D QaAccGrp * ProcPtr 97 D QaQueAtrBf 1a 98 D QaCurMaxMsg 10i 0 102 D QaCurMsgEnq 10i 0 106 D QaExtVal 10i 0 110 D QaKeyLen 5i 0 112 D QaMaxSizMsg 10i 0 116 D 1a 117 D QaMaxNbrExt 10i 0 121 D QaCurNbrExt 10i 0 125 D QaInzNbrMsg 10i 0 **-- Enqueue message: --------------------------------------------------** D enqMI Pr ExtProc( '_ENQ' ) D QuePtr * ProcPtr D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) **-- Dequeue message with wait: ----------------------------------------** D deqwait Pr ExtProc( '_DEQWAIT' ) D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) D QuePtr * ProcPtr 129 **-- Enqueue message: --------------------------------------------------** D enq Pr ExtProc( 'enq' ) D QuePtr * ProcPtr Value D MsgPfx 256a Const Options( *VarSize ) D MsgTxt 32767a Const Options( *VarSize ) **-- Dequeue message: --------------------------------------------------** D deq Pr ExtProc( 'deq' ) D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) D QuePtr * ProcPtr Value **-- Dequeue message with indicator: -----------------------------------** D deqi Pr 10i 0 ExtProc( 'deqi' ) D MsgPfx 296a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) D QuePtr * ProcPtr Value **-- Materialize queue attributes: -------------------------------------** D matqat Pr ExtProc( 'matqat' ) D RcvAtr 128a D QuePtr * ProcPtr Value **-- Wait seconds: -----------------------------------------------------** D sleep Pr 10i 0 ExtProc( 'sleep' ) D seconds 10u 0 Value **-- Wait microseconds: ------------------------------------------------** D usleep Pr 10i 0 ExtProc( 'usleep' ) D useconds 10u 0 Value **-- Create user queue: ------------------------------------------------** D CrtUsrQ Pr ExtPgm( 'QUSCRTUQ' ) D CuUsrQqual 20a Const D CuExtAtr 10a Const D CuQueTyp 1a Const D CuKeyLen 10i 0 Const D CuMaxMsgSiz 10i 0 Const D CuInzNbrMsg 10i 0 Const D CuAddNbrMsg 10i 0 Const D CuPubAut 10a Const D CuTxtDsc 50a Const ** D CuRplQue 10a Const Options( *NoPass ) D CuError 32767a Options( *NoPass: *VarSize ) ** D CuQueDmn 10a Const Options( *NoPass ) D CuAlwPtr 10a Const Options( *NoPass ) ** D CuNbqExt 10i 0 Const Options( *NoPass ) D CuRclStg 1a Const Options( *NoPass ) **-- Get current number of queue entries: ------------------------------** D GetCurNbrE Pr 10i 0 D PxQuePtr * ProcPtr **-- Get system pointer: -----------------------------------------------** D GetSysPtr Pr * ProcPtr D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Get MI time value: ------------------------------------------------** D GetTimVal Pr 8a D PxSeconds 10u 0 Const ** **-- Mainline: ---------------------------------------------------------** ** C CallP CrtUsrQ( 'USRQ QTEMP' C : 'TESTUSRQ' C : 'F' C : *Zero C : 1024 C : 256 C : 128 C : '*ALL' C : 'Test user queue' C : '*YES' C : ApiError C : '*USER' C : '*NO' C ) ** C CallP CrtUsrQ( 'USRQKEY QTEMP' C : 'TESTUSRQ' C : 'K' C : 3 C : 1024 C : 256 C : 128 C : '*ALL' C : 'Test user queue - key' C : '*YES' C : ApiError C : '*USER' C : '*NO' C ) ** C Eval UsrQuePtrF = GetSysPtr( 'USRQ' C : 'QTEMP' C : '*USRQ' C ) ** C If UsrQuePtrF <> *Null ** C Eval UsrQuePtrK = GetSysPtr( 'USRQKEY' C : 'QTEMP' C : '*USRQ' C ) ** C If UsrQuePtrK <> *Null ** C ExSr TstEnqNoKey C ExSr TstDeqNoKey ** C ExSr TstEnqKey C ExSr TstDeqKey ** C ExSr TstEnqMiKey C ExSr TstDeqKey ** C ExSr TstEnqMiKey C ExSr TstDeqiKey ** C ExSr TstEnqKey C ExSr TstDeqwKey ** C EndIf C EndIf ** C Eval *InLr = *On C Return ** **-- Test enq no key: --------------------------------------------------** C TstEnqNoKey BegSr ** C Eval EnqMsg = 'Test FIFO message 1' C Eval EpMsgLen = %Len( %TrimR( EnqMsg )) ** C CallP enq( UsrQuePtrF: EnqMsgPfx: EnqMsg ) ** C EndSr **-- Test enq key: -----------------------------------------------------** C TstEnqKey BegSr ** C Eval EnqMsg = 'Test key message 1' C Eval EpEnqKey = 'KEY' C Eval EpMsgLen = %Len( %TrimR( EnqMsg )) ** C CallP enq( UsrQuePtrK: EnqMsgPfx: EnqMsg ) ** C EndSr **-- Test enqMI key: ---------------------------------------------------** C TstEnqMiKey BegSr ** C Eval EnqMsg = 'Test key message 2' C Eval EpEnqKey = 'KEY' C Eval EpMsgLen = %Len( %TrimR( EnqMsg )) ** C CallP enqMI( UsrQuePtrK: EnqMsgPfx: EnqMsg ) ** C EndSr **-- Test deq no key: --------------------------------------------------** C TstDeqNoKey BegSr ** C Eval DqKey = *Blanks C Eval DqOption = WaitDeq ** C DoW GetCurNbrE( UsrQuePtrF ) > *Zero ** C CallP(e) deq( DeqMsgPfx: DeqMsg: UsrQuePtrF ) ** C If Not %Error C ExSr PrcUsrQe C EndIf ** C EndDo ** C EndSr **-- Test deq key: -----------------------------------------------------** C TstDeqKey BegSr ** C Eval DqKey = 'KEY' C Eval DqOption = TimeDeqEq C Eval DqWaitTim = GetTimVal( 5 ) ** C Do 3 ** C CallP(e) deq( DeqMsgPfx: DeqMsg: UsrQuePtrK ) ** C If Not %Error C ExSr PrcUsrQe ** C Else C CallP usleep( 500000 ) C EndIf ** C EndDo ** C EndSr **-- Test deqi key: ----------------------------------------------------** C TstDeqiKey BegSr ** C Eval DqOption = TimeDeqEq C Eval DqKey = 'KEY' ** C DoW GetCurNbrE( UsrQuePtrK ) > *Zero ** C Eval MsgDeq = deqi( DeqMsgPfx C : DeqMsg C : UsrQuePtrK C ) ** C If MsgDeq = 1 C ExSr PrcUsrQe C EndIf ** C CallP sleep( 1 ) C EndDo ** C EndSr **-- Test deqwait key: -------------------------------------------------** C TstDeqwKey BegSr ** C Eval DqKey = 'KEY' C Eval DqOption = TimeDeqEq C Eval DqWaitTim = GetTimVal( 7 ) ** C DoW GetCurNbrE( UsrQuePtrK ) > *Zero ** C CallP(e) deqwait( DeqMsgPfx: DeqMsg: UsrQuePtrK ) ** C If Not %Error C ExSr PrcUsrQe C EndIf ** C EndDo ** C EndSr **-- Process user queue entry: -----------------------------------------** C PrcUsrQe BegSr ** C Eval DeqMsg = %Subst( DeqMsg: 1: DqMsgLen ) ** C EndSr **-- Get current number of queue entries: ------------------------------** P GetCurNbrE B D Pi 10i 0 D PxQuePtr * ProcPtr ** C If PxQuePtr = *Null C Return -1 C Else ** C CallP(e) matqat( QueAtr: PxQuePtr ) ** C If %Error C Return -1 ** C Else C Return QaCurMsgEnq C EndIf C EndIf ** P GetCurNbrE E ** Program . . : CBX1151 ** Description : Test user queues - server function ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : February 19, 2004 ** ** ** Program summary ** --------------- ** ** MI builtins: ** _ENQ Enqueue message Puts a message to the user queue ** specified. An optional key used ** at message retrieval time can be ** specified. ** ** The actual user queue is defined ** by a system pointer. ** ** _DEQWAIT Dequeue message Gets a message from the specified ** with wait user queue. The retrieval order ** is defined at queue creation time ** and includes first-in-first-out, ** last-in-first-out and by-key. ** ** The wait time is specified in the ** dequeue message prefix parameter. ** If a time-out occurs the builtin ** returns an exception to the ** calling program. ** ** The actual user queue is defined ** by a system pointer. ** ** C library function: ** cvthc Convert hex to Converts a character string to ** character its hexadecimal representation ** in the form of 4-bit sequences ** also known as nibbles. ** ** ** Sequence of events: ** 1. The put and get user queue names as well as the library they are ** located in are received as input paramters and a system pointer ** to each is resolved. ** ** 2. Being a server function the program then waits indefinetely for ** client requests to be received from the get user queue. To ensure ** that the right client receives the reply, a unique key is included ** in the request message structure. Also included is a request type ** defining the type of action to be performed by the server. ** ** 3. Once a request is received it is processed based on the request ** type. Two request types are supported. ** ** *CVTHEX will convert the received message string to its ** hexadecimal representation and put the converted string ** to the reply user queue and the retreived key from the ** request message structure is supplied as retrieval key. ** ** *STOP will end the server job immediately. ** ** 4. When a reply has been returned, the server will continue waiting ** indefinetely for the next request to arrive. ** ** 5. If the server job has been requested to stop processing, the ** wait loop is exited and the job is ended normally. ** ** ** Compile options: ** First, create the CBX115S service program. (Instructions can be ** found in the CBX115S source member.) ** ** CrtRpgMod Module( CBX1151 ) DbgView( *LIST ) ** ** CrtPgm Pgm( CBX1151 ) ** Module( CBX1151 ) ** ActGrp( QILE ) ** BndSrvPgm( CBX115S ) ** ** **-- Header specifications: --------------------------------------------** H Option( *SrcStmt ) BndDir( 'QC2LE' ) **-- Global variables: -------------------------------------------------** D RqsQuePtr s * ProcPtr D RpyQuePtr s * ProcPtr D RqsHdrSiz s 10i 0 ** D EnqMsg s 1024a ** D DeqMsg Ds D DmRpyKey 16a D DmRqsTyp 8a D DmRqsMsg 1000a **-- Global constants: -------------------------------------------------** D WaitDeq c x'10' **-- Enqueue message prefix: -------------------------------------------** D EnqMsgPfx Ds D EqMsgLen 10i 0 D EqEnqKey 16a **-- Dequeue message prefix: -------------------------------------------** D DeqMsgPfx Ds D DqTimStp 8a D DqWaitTim 8a D DqMsgLen 10i 0 Inz D DqOption 1a ** DqAccSt1: 1; Bit weight 8 ** DqAccSt2: 1; - - 4 ** DqMPL : 1; - - 2 ** DqWait4e: 1; - - 1 ** DqKeyRel: 4; - - 8-1 D DqKey 16a **-- Enqueue message: --------------------------------------------------** D enq Pr ExtProc( '_ENQ' ) D QuePtr * ProcPtr D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) **-- Dequeue message with wait: ----------------------------------------** D deqwait Pr ExtProc( '_DEQWAIT' ) D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) D QuePtr * ProcPtr **-- Convert hex to character: -----------------------------------------** D cvthc Pr * ExtProc( 'cvthc' ) D * Value D * Value D 10I 0 Value **-- Get system pointer: -----------------------------------------------** D GetSysPtr Pr * ProcPtr D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Parameters: -------------------------------------------------------** D PxRqsQueNam s 10a D PxRpyQueNam s 10a D PxQueLib s 10a ** C *Entry Plist C Parm PxRqsQueNam C Parm PxRpyQueNam C Parm PxQueLib ** **-- Mainline: ---------------------------------------------------------** ** C Eval RqsQuePtr = GetSysPtr( PxRqsQueNam C : PxQueLib C : '*USRQ' C ) ** C If RqsQuePtr <> *Null ** C Eval RpyQuePtr = GetSysPtr( PxRpyQueNam C : PxQueLib C : '*USRQ' C ) ** C If RpyQuePtr <> *Null ** C DoU *InLr = *On ** C ExSr DeqRqsMsg ** C If *InLr = *Off C ExSr PrcRqsMsg C ExSr EnqRpyMsg C EndIf ** C EndDo ** C EndIf C EndIf ** C Return ** **-- Dequeue request message: ------------------------------------------** C DeqRqsMsg BegSr ** C Eval DqKey = *Blanks C Eval DqOption = WaitDeq ** C CallP(e) deqwait( DeqMsgPfx: DeqMsg: RqsQuePtr ) ** C If Not %Error C Eval DeqMsg = %Subst( DeqMsg: 1: DqMsgLen ) C Eval EnqMsg = *Blanks ** C If DmRqsTyp = '*STOP ' C Eval *InLr = *On C EndIf C EndIf ** C EndSr **-- Enqueue reply message: --------------------------------------------** C EnqRpyMsg BegSr ** C Eval EqEnqKey = DmRpyKey C Eval EqMsgLen = %Len( %TrimR( EnqMsg )) ** C CallP enq( RpyQuePtr: EnqMsgPfx: EnqMsg ) ** C EndSr **-- Process request message: ------------------------------------------** C PrcRqsMsg BegSr ** C If DmRqsTyp = '*CVTHEX' ** C CallP cvthc( %Addr( EnqMsg ) C : %Addr( DmRqsMsg ) C : 2 * ( DqMsgLen - RqsHdrSiz ) C ) ** C EndIf ** C EndSr **-- Initial processing: -----------------------------------------------** C *InzSr BegSr ** C Eval RqsHdrSiz = %Size( DmRpyKey ) + C %Size( DmRqsTyp ) ** C EndSr ** Program . . : CBX1152 ** Description : Test user queues - client function ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : February 19, 2004 ** ** ** Program summary ** --------------- ** ** MI builtins: ** _ENQ Enqueue message Puts a message to the user queue ** specified. An optional key used ** at message retrieval time can be ** specified. ** ** The actual user queue is defined ** by a system pointer. ** ** _DEQWAIT Dequeue message Gets a message from the specified ** with wait user queue. The retrieval order ** is defined at queue creation time ** and includes first-in-first-out, ** last-in-first-out and by-key. ** ** The wait time is specified in the ** dequeue message prefix parameter. ** If a time-out occurs the builtin ** returns an exception to the ** calling program. ** ** The actual user queue is defined ** by a system pointer. ** ** _GENUUID Generate universal Returns a 16 byte token that is ** unique identifier guaranteed to be unique across ** all time and space - or as its ** name says, universally unique. ** ** User interface manager APIs: ** QUILNGTX Display long text Displays the text string passed ** to the API in a pop-up window. ** Optionally a panel title can be ** retrieved from a message file. ** ** Maximum string length is 15360k. ** ** Message handling API: ** QMHSNDPM Send program message Sends a message to a program stack ** entry (current, previous, etc.) or ** an external message queue. ** ** Both messages defined in a message ** file and immediate messages can be ** used. For specific message types ** only one or the other is allowed. ** ** QMHRCVPM Receive program Returns information describing ** message the selected message in a call ** message queue or, as in this ** case, an external message queue. ** ** ** Sequence of events: ** 1. The put and get user queue names as well as the library they are ** located in are received as input paramters and a system pointer ** to each is resolved. ** ** 2. An inquiry message is sent to the external message queue, waiting ** for an input string to process. Upon receiving an actual reply, ** a unique key is generated to be included with the request message ** to ensure correct retrieval of the corresponding reply, and the ** request message is put to the request user queue. ** ** 3. Next the dequeue parameters are set, a time-out value of 5 seconds ** and the retrieval key that the reply was associated with in step 2. ** If a time-out occurs an informational message is displayed in a ** window, otherwise the result of the hexadecimal conversion of the ** input string is displayed. ** ** 4. If an empty reply is received in step 2 a 'terminate processing' ** message is sent to the server job and this program returns control ** to its caller, to delete the user queues involved and end the test ** application. ** ** ** Programmer's notes: ** User reports have surfaced, indicating that the GENUUID function ** - under certain circumstances - might have a problem generating a ** truly unique identifier on multi-processor iSeries machines. ** ** But apparently this has not yet lead to the opening of an APAR so ** there is currently no conclusive information available on this ** matter. ** ** The message dialogue developed for the purpose of this user queue ** test application is by no means adequate for a genuine production ** environment. ** ** In real life it is crucial to invest the time necessary to develop ** a robust and flexible data protocol up front, covering some of the ** following aspects: ** ** - Request and reply message indentification ** - Message version identification ** - Error code and message reporting ** - Message definition design (proprietary or standard) ** - Expanding list support (to avoid message length constraints) ** - National language support ** - Normalization level of message record formats ** ** And when dealing with some of the above questions it is in many ** cases worth considering to what extent XML would offer a useful ** solution. ** ** ** Compile options: ** First, create the CBX115S service program. (Instructions can be ** found in the CBX115S source member.) ** ** CrtRpgMod Module( CBX1152 ) DbgView( *LIST ) ** ** CrtPgm Pgm( CBX1152 ) ** Module( CBX1152 ) ** ActGrp( QILE ) ** BndSrvPgm( CBX115S ) ** ** **-- Header specifications: --------------------------------------------** H Option( *SrcStmt ) BndDir( 'QC2LE' ) **-- 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 **-- Global variables: -------------------------------------------------** D RqsQuePtr s * ProcPtr D RpyQuePtr s * ProcPtr D MsgKey s 4a D MsgDta s 1024a Varying ** D DeqMsg s 1024a ** D EnqMsg Ds D EmRpyKey 16a D EmRqsTyp 8a D EmRqsMsg 1000a **-- Global constants: -------------------------------------------------** D TimeDeqEq c x'08' **-- Enqueue message prefix: -------------------------------------------** D EnqMsgPfx Ds D EqMsgLen 10i 0 D EqEnqKey 16a **-- Dequeue message prefix: -------------------------------------------** D DeqMsgPfx Ds D DqTimStp 8a D DqWaitTim 8a D DqMsgLen 10i 0 Inz D DqOption 1a ** DqAccSt1: 1; Bit weight 8 ** DqAccSt2: 1; - - 4 ** DqMPL : 1; - - 2 ** DqWait4e: 1; - - 1 ** DqKeyRel: 4; - - 8-1 D DqKey 16a **-- UUID template: ----------------------------------------------------** D UUID_template Ds D UtBytPrv 10u 0 Inz( %Size( UUID_template )) D UtBytAvl 10u 0 D 8a Inz( *Allx'00' ) D UUID 16a **-- Message information structure: ------------------------------------** D RCVM0100 Ds D R1BytPrv 10i 0 D R1BytAvl 10i 0 D R1MsgSev 10i 0 D R1MsgId 7a D R1MsgTyp 2a D R1MsgKey 4a D 7a D R1CcsIdCnvSts 10i 0 D R1CcsIdDta 10i 0 D R1MsgLen 10i 0 D R1MsgLenAvl 10i 0 D R1MsgRpy 1024a **-- Enqueue: ----------------------------------------------------------** D enq Pr ExtProc( '_ENQ' ) D QuePtr * ProcPtr D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) **-- Dequeue with wait: ------------------------------------------------** D deqwait Pr ExtProc( '_DEQWAIT' ) D MsgPfx 256a Options( *VarSize ) D MsgTxt 32767a Options( *VarSize ) D QuePtr * ProcPtr **-- Generate universal unique identifier: -------------------------- --** D GenUuid Pr ExtProc( '_GENUUID' ) D UUID_template * Value **-- Send program message: ---------------------------------------------** D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' ) D SpMsgId 7a Const D SpMsgFq 20a Const D SpMsgDta 512a Const Options( *VarSize ) D SpMsgDtaLen 10i 0 Const D SpMsgTyp 10a Const D SpCalStkE 10a Const Options( *VarSize ) D SpCalStkCtr 10i 0 Const D SpMsgKey 4a D SpError 512a Options( *VarSize ) ** D SpCalStkElen 10i 0 Const Options( *NoPass ) D SpCalStkEq 20a Const Options( *NoPass ) D SpDspWait 10i 0 Const Options( *NoPass ) ** D SpCalStkEtyp 20a Const Options( *NoPass ) D SpCcsId 10i 0 Const Options( *NoPass ) **-- Receive program message: ------------------------------------------** D RcvPgmMsg Pr ExtPgm( 'QMHRCVPM' ) D RpRcvVar 32767a Options( *VarSize ) D RpRcvVarLen 10i 0 Const D RpFmtNam 10a Const D RpCalStkE 256a Const Options( *VarSize ) D RpCalStkCtr 10i 0 Const D RpMsgTyp 10a Const D RpMsgKey 4a Const D RpWait 10i 0 Const D RpMsgAct 10a Const D RpError 32767a Options( *VarSize ) ** D RpCalStkElen 10i 0 Const Options( *NoPass ) D RpCalStkEq 20a Const Options( *NoPass ) ** D RpCalStkEtyp 20a Const Options( *NoPass ) D RpCcsId 10i 0 Const Options( *NoPass ) **-- Display long text: ------------------------------------------------** D DspLngTxt Pr ExtPgm( 'QUILNGTX' ) D DtLngTxt 1024a Const Options( *VarSize ) D DtLngTxtLen 10i 0 Const D DtMsgId 7a Const D DtMsgF 20a Const D DtError 10i 0 Const **-- Get system pointer: -----------------------------------------------** D GetSysPtr Pr * ProcPtr D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Get MI time value: ------------------------------------------------** D GetTimVal Pr 8a D PxSec 10u 0 Const **-- Parameters: -------------------------------------------------------** D PxRqsQueNam s 10a D PxRpyQueNam s 10a D PxQueLib s 10a ** C *Entry Plist C Parm PxRqsQueNam C Parm PxRpyQueNam C Parm PxQueLib ** **-- Mainline: ---------------------------------------------------------** ** C Eval RqsQuePtr = GetSysPtr( PxRqsQueNam C : PxQueLib C : '*USRQ' C ) ** C If RqsQuePtr <> *Null ** C Eval RpyQuePtr = GetSysPtr( PxRpyQueNam C : PxQueLib C : '*USRQ' C ) ** C If RpyQuePtr <> *Null ** C DoU *InLr = *On ** C ExSr GetRqsMsg C ExSr EnqRqsMsg ** C If *InLr = *Off C ExSr DeqRpyMsg C EndIf ** C EndDo ** C EndIf C EndIf ** C Return ** **-- Enqueue request message: ------------------------------------------** C EnqRqsMsg BegSr ** C Callp GenUuid( %Addr( UUID_template )) ** C Eval EqEnqKey = *Blanks C Eval EmRpyKey = UUID C Eval EqMsgLen = %Len( %TrimR( EnqMsg )) ** C CallP enq( RqsQuePtr: EnqMsgPfx: EnqMsg ) ** C EndSr **-- Dequeue reply message: --------------------------------------------** C DeqRpyMsg BegSr ** C Eval DqKey = UUID C Eval DqOption = TimeDeqEq C Eval DqWaitTim = GetTimVal( 5 ) ** C CallP(e) deqwait( DeqMsgPfx: DeqMsg: RpyQuePtr ) ** C If %Error C Exsr HdlRpyTmo ** C Else C Exsr DspRpyMsg C EndIf ** C EndSr **-- Handle reply timeout: ---------------------------------------------** C HdlRpyTmo BegSr ** C Eval MsgKey = *Blanks ** C CallP RcvPgmMsg( RCVM0100 C : %Size( RCVM0100 ) C : 'RCVM0100' C : '*' C : *Zero C : '*LAST' C : MsgKey C : -1 C : '*REMOVE' C : ApiError C ) ** C Eval MsgDta = 'The get user queue ' + C 'message timed out. ' + C 'Please check that the ' + C 'server job is active.' ** C CallP(e) DspLngTxt( MsgDta C : %Len( MsgDta ) C : *Blanks C : *Blanks C : *Zero C ) ** C EndSr **-- Display reply message: --------------------------------------------** C DspRpyMsg BegSr ** C Eval MsgDta = %TrimR( EmRqsMsg ) + ' -> ' + C %SubSt( DeqMsg: 1: DqMsgLen ) ** C CallP(e) DspLngTxt( MsgDta C : %Len( MsgDta ) C : *Blanks C : *Blanks C : *Zero C ) ** C EndSr **-- Get request message: ----------------------------------------------** C GetRqsMsg BegSr ** C Eval MsgDta = 'Please enter string ' + C 'to be converted to ' + C 'hex. To stop test just ' + C 'press enter.' ** C CallP SndPgmMsg( *Blanks C : *Blanks C : MsgDta C : %Len( MsgDta ) C : '*INQ' C : '*EXT' C : *Zero C : MsgKey C : ApiError C ) ** C CallP RcvPgmMsg( RCVM0100 C : %Size( RCVM0100 ) C : 'RCVM0100' C : '*' C : *Zero C : '*RPY' C : MsgKey C : -1 C : '*OLD' C : ApiError C ) ** C Eval R1MsgRpy = %Subst( R1MsgRpy: 1: R1MsgLen ) ** C If R1MsgRpy = '*N' C Eval EmRqsTyp = '*STOP' C Eval *InLr = *On ** C Else C Eval EmRqsTyp = '*CVTHEX' C Eval EmRqsMsg = R1MsgRpy C EndIf ** C EndSr ** Program . . : CBX115S ** Description : Test user queues - service functions ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : February 19, 2004 ** ** ** Program summary ** --------------- ** ** Object-related API: ** QLICVTTP Convert object type Convert an iSeries object type to ** or from hexadecimal format. ** ** C library function: ** rslvsp Resolve system Creates a system pointer to the ** pointer object specified by the input ** parameters. Only a system state ** program is allowed to generate ** an authorized system pointer. ** ** mitime Create an _MI_Time Creates an _MI_Time value from ** value the individual time durations ** specified. ** ** Service program procedures: ** GetSysPtr Get system pointer Based on object name, library and ** object type a system pointer to ** the object is generated and ** returned to the caller. ** ** GetTimVal Get MI time value Generates an MI time value from ** the specified number of seconds. ** ** Programmer's notes: ** RPG/IV has no explicit support of system pointers - but defining an ** uninitialized procedure pointer will make the RPG compiler create ** an open pointer, capable of storing any type of iSeries pointer. ** ** Though not very likely - due to the many production programs already ** exploiting this feature - it is possible that a future introduction ** of true system pointer support to RPG/IV might disable this "hidden" ** system pointer support. ** ** If used in production programs, you should therefore document the ** use of this feature very carefully to ensure that you can take the ** appropriate evasive actions if necessary. ** ** ** Compile options required: ** CrtRpgMod CBX115S ** ** CrtSrvPgm CBX115S + ** Module( CBX115S ) + ** Export( *ALL ) + ** ActGrp( *CALLER ) ** ** **-- Header specifications: --------------------------------------------** H NoMain BndDir( 'QC2LE' ) **-- API Error Data Structure: -----------------------------------------** D ApiError Ds D AeBytPro 10i 0 Inz( %Size( ApiError )) D AeBytAvl 10i 0 Inz D 1a D AeExcpId 7a D AeExcpDta 256a **-- Convert object type to hex: ---------------------------------------** D CvtObjTyp Pr ExtPgm( 'QLICVTTP' ) D CtCnvOpt 10a Const D CtObjSym 10a Const D CtObjHex 2a D CtError 32767a Options( *VarSize ) **-- Get system pointer: -----------------------------------------------** D GetSysPtr Pr * ProcPtr D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Get MI time value: ------------------------------------------------** D GetTimVal Pr 8a D PxSec 10u 0 Const **-- Check object existence: -------------------------------------------** D ObjExist Pr n D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Resolve system pointer: -------------------------------------------** D rslvsp Pr * ProcPtr ExtProc( 'rslvsp' ) D PxObjTyp 2a Value D PxObjNam * Value Options( *String ) D PxObjLib * Value Options( *String ) D PxAutReq 2a Value **-- mitime - create an _MI_Time value from components: ----------------** D mitime Pr ExtProc( 'mitime' ) D PxDelay 8a D PxHours 10u 0 Value D PxMin 10u 0 Value D PxSec 10u 0 Value D PxMs 10u 0 Value **-- Get system pointer: -----------------------------------------------** P GetSysPtr B Export D Pi * ProcPtr D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Local variables: D SysPtr s * ProcPtr D ObjTypHex s 2a ** C If ObjExist( PxObjNam: PxObjLib: PxObjTyp ) ** C Callp CvtObjTyp( '*SYMTOHEX' C : PxObjTyp C : ObjTypHex C : ApiError C ) ** C If AeBytAvl = *Zero ** C Eval SysPtr = rslvsp( ObjTypHex C : PxObjNam C : PxObjLib C : x'0000' C ) ** C EndIf C EndIf ** C Return SysPtr ** P GetSysPtr E **-- Get MI time value: ------------------------------------------------** P GetTimVal B Export D Pi 8a D PxSec 10u 0 Const **-- time parameter: D PxDelay s 8a ** C CallP mitime( PxDelay C : 0 C : 0 C : PxSec C : 0 C ) ** C Return PxDelay ** P GetTimVal E **-- Check object existence: -------------------------------------------** P ObjExist B Export D Pi n D PxObjNam 10a Const D PxObjLib 10a Const D PxObjTyp 10a Const **-- Retrieve object description: D RoData Ds D RoBytRtn 10i 0 D RoBytAvl 10i 0 D RoDtaLgt s 10i 0 Inz( %Size( RoData )) D RoFmtNam s 8a Inz( 'OBJD0100' ) D RoObjQ s 20a D RoObjTyp s 10a ** C Eval RoObjQ = PxObjNam + PxObjLib ** C Call 'QUSROBJD' C Parm RoData C Parm RoDtaLgt C Parm RoFmtNam C Parm RoObjQ C Parm PxObjTyp RoObjTyp C Parm ApiError ** C Return ( AeBytAvl = *Zero ) ** P ObjExist E /* Program . . : CBX115 */ /* Description : User queue example */ /* Author . . : Carsten Flensburg */ /* Published . : Club Tech iSeries Programming Tips Newsletter */ /* Date . . . : February 19, 2004 */ /* */ /* Program function: Initialize, run and clean up user queue */ /* example. */ /* */ /* Programmer's notes: */ /* Submit of the server job should occur through a job queue */ /* ensuring immediate activation of the server job, otherwise */ /* the user queue driven dialogue between the server and client */ /* jobs will not be possible. */ /* */ /* To run the user queue test application simply compile the */ /* involved objects as described in each source header and */ /* eventually call this program. */ /* */ /* Compile options: */ /* First, create the CRTUSRQ command from the January 29, 2004 */ /* issue of Club Tech iSeries Programming Tips Newsletter. */ /* CrtClPgm Pgm( CBX115 ) */ /* SrcFile( QCLSRC ) */ /* SrcMbr( *PGM ) */ /* */ Pgm /*-- Global variables: ---------------------------------------------*/ Dcl &JobNbr *Char 10 Dcl &UsrQueNamF *Char 10 'USQF' Dcl &UsrQueNamK *Char 10 'USQK' Dcl &UsrQueLib *Char 10 /*-- Global error monitoring: --------------------------------------*/ MonMsg CPF0000 *N GoTo Error /*-- Mainline -------------------------------------------------------*/ RtvJobA Nbr( &JobNbr ) CurLib( &UsrQueLib ) ChgVar &UsrQueNamF ( &UsrQueNamF *Tcat &JobNbr ) ChgVar &UsrQueNamK ( &UsrQueNamK *Tcat &JobNbr ) If ( &UsrQueLib = '*NONE' ) ChgVar &UsrQueLib 'QGPL' DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamF ) MonMsg CPF2105 *N RcvMsg MsgType( *EXCP ) Rmv( *YES ) DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamK ) MonMsg CPF2105 *N RcvMsg MsgType( *EXCP ) Rmv( *YES ) CrtUsrQ UsrQ( &UsrQueLib/&UsrQueNamF ) + ExtAtr( USRQFIFO ) + MaxLen( 1024 ) + Size( 256 ) + IncrSize( 128 ) + Text( 'User queue FIFO test' ) CrtUsrQ UsrQ( &UsrQueLib/&UsrQueNamK ) + ExtAtr( USRQKEYED ) + Seq( *KEYED ) + KeyLen( 16 ) + MaxLen( 1024 ) + Size( 256 ) + IncrSize( 128 ) + Text( 'User queue keyed test' ) /*-- Submit server function: --*/ SbmJob Cmd( Call Pgm( CBX1151 ) + Parm( &UsrQueNamF + &UsrQueNamK + &UsrQueLib + )) + Job( USRQSVR ) + JobD( *USRPRF ) + JobQ( *JOBD ) /*-- Run client function: --*/ Call CBX1152 Parm( &UsrQueNamF + &UsrQueNamK + &UsrQueLib + ) SndPgmMsg MsgId( CPF9897 ) + MsgF( QCPFMSG ) + MsgDta( 'Terminating server job.' ) + ToPgmQ( *EXT ) + MsgType( *STATUS ) DlyJob 1 DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamF ) DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamK ) SndPgmMsg Msg( 'User queue test completed normally.' ) + MsgType( *COMP ) Return: Return /*-- Error processor ------------------------------------------------*/ Error: Call QMHMOVPM ( ' ' + '*DIAG' + x'00000001' + '*PGMBDY ' + x'00000001' + x'0000000800000000' + ) Call QMHRSNEM ( ' ' + x'0000000800000000' + ) EndPgm: EndPgm Thanks to Carsten Flensburg and Club Tech iSeries Programming Tips Newsletter