|
midrange.com
Benjamin,
I have attached two sample RPG programs. One (the larger) uses both
the Virtual Terminal (VT) APIs and USRDFN datastreams. The second
(VTATTN) works with the first in order to support the Attention key.
Using these programs you basically operate your terminal in one job
while your application is running in another. The samples do not
manipulate the 5250 data stream, but rather just pass it through after
timestamping the transaction. If you want to manipulate the datastream
you will need to become extremely familiar with the 5250 datastream.
Bruce Vining
PS - I last used this code back in 1994 to test an idea so there may
be a few "features" that I cannot recall at this late date.
>
>Hi!
>
>Is it possible to write 5250 data stream directly to a twinax attached
>terminal? I think the DDS keyword USRDFN can be used for that purpose, but
>I don't know how does it work. I want to manipulate the data flowing
>between the application and the end user with VT APIs, but my client side
>should be a real terminal. For that purpose I need to read/write directly
>to the terminal.
>Did anybody something similar?
>
>Regards,
>
> Benjamin Budai
>
H
F*
F* This is a sample program to demonstrate how to use Virtual
F* Terminal API support. When called, this program brings the
F* interactive caller into a virtual session, and then echoes
F* all screen IO from the virtual session to the physical
F* interactive session. When in the program, F23 can be used
F* to exit the virtual session. This program has not been
F* formally tested; and is provided on an as-is basis only.
F*
F* This program prereqs a *DSPF named RPGDSPF, with attributes
F* similar to the following, to exist in *LIBL
F*
F* R FILLER
F* DATA 4005 H
F* R USRPUT USRDFN
F* R USRREC INVITE
F* PRINT
F* USRDFN
F*
FRPGDSPF CF F 4005 WORKSTN UC
F KPASS *NOIND
F*
F* Likewise, a *PF VTOUTFIL with these attributes is needed
F* in *LIBL
F*
F* R VTOUTREC
F* CODE 1
F* STAMP 63
F*
F* The VTOUTPUT file is used to log timestamps of the interactive
F* session and also to record unexpected Virtual Terminal
F* sequences. There are 3 CODE values:
F* 'A' = Timestamp prior to read from physical device
F* 'B' = Timestamp after read from physical device
F* 'E' = Error; an unexpected/unsupported sequence
F* where 'A' - 'B' approximates response time
F* and 'B' - 'A' approximates key/think time by the user
F*
FVTOUTFILO E DISK A
F*
F* And a *DTAQ must exist with these attributes:
F*
F* 1. Minimum length of 80 bytes
F* 2. Not keyed
F* 3. Has same name as interactive user
F* 4. Resides in *LIBL
F*
F* If the *DTAQ is not found, this program will create it
F* in QGPL
F*
E ARR 4000 1
IRPGDSPF NS
I 14000 DS5250
IVTOP DS
I 1 10 VTDATA
I 1 1 READOP
IINTS DS
I I 0 B 1 40CCSID
I I 0 B 5 80CODEPG
I I 1 B 9 120WSTYPE
I I 0 B 13 160QKEYLN
I B 17 200READIN
I B 21 240GOTIN
I I 48 B 25 280OBJVSZ
IERRCOD DS
I I 15 B 1 40BYTPRV
I B 5 80BYTAVL
I 9 15 CPFID
IDTAQ DS
I 1 10 QNAME
I I '*LIBL' 11 20 QLIB
IROBJD DS
I 39 48 OBJLIB
I DS
I I 'SETATNPGM VTATTN' 1 16 CLSET
ICLCRT DS
I I 'CRTDTAQ QGPL/' 1 13 CRT1
I 14 23 CRT2
I I ' MAXLEN(80)' 24 34 CRT3
ICLOVR DS
I I 'OVRDSPF RPGDSPF - 1 21 OVR1
I 'DTAQ('
I 22 31 OVR2
I I ')' 32 32 OVR3
IUSRDTA DS
I B 1 20PUT
I I 4000 B 3 40GET
I 5 5 FUNCT
IDS5250 DS
I 3 3 AIDKEY
I 1 80 ARRDTA
I 14000 ARR
IQDATA DS
I 1 10 VTQTYP
I 11 12 VTQID
I 13 28 VTQHAN
I 29 80 VTFILL
I X'00' C NULL
I X'71' C PUTSCR
I X'73' C PUTGET
I X'BB' C GETOUT
I X'0402' C SAVCMD
I X'0462' C RSICMD
I X'0472' C RMCMD
I X'04520000' C RIMCMD
I SDS
I 254 263 USERID
C/EJECT
C EXSR INIT INIT VARS
C*
C* Just loop until F23 is pressed on any screen; and then exit
C*
C AIDKEY DOWNEGETOUT CF23 KEY?
C LOOP TAG
C*
C* Wait on *DTAQ to determine next course of action
C*
C CALL 'QRCVDTAQ'
C PARM QNAME *DTAQ name
C PARM QLIB *DTAQ libr
C PARM QLEN 50 Size of data
C PARM QDATA Rcv variable
C PARM -1 QWAIT 50 Wait forever
C*
C* If VT then get the 5250 data stream from the user application
C*
C VTQTYP IFEQ '*VRTTRM' VT entry?
C VTQID ANDNE' 1' If not close
C CALL 'QTVRDVT'
C PARM HANDLE VT handle
C PARM VTDATA VT ops
C PARM DS5250 5250 orders
C PARM 4000 READIN Rcv var size
C PARM GOTIN Size back
C PARM ERRCOD Error struct
C BYTAVL IFNE 0 If error
C DSPLY CPFID show msg
C EXSR EOJ get out
C END
C*
C* See what we got:
C*
C READOP IFEQ 'B' if message
C READOP OREQ 'C' light then
C GOTO LOOP NOOP
C END
C*
C Z-ADDGOTIN PUT Set size
C READOP IFEQ '2' Put?
C MOVE PUTSCR FUNCT
C ELSE Or
C READOP IFEQ '3' Put/get?
C MOVE PUTGET FUNCT
C ELSE Or
C READOP IFEQ '4' Save
C MOVE PUTGET FUNCT Screen?
C MOVELSAVCMD DS5250
C Z-ADD2 PUT
C ELSE Or
C READOP IFEQ '5' Restore
C MOVE PUTGET FUNCT Screen?
C ELSE Or
C READOP IFEQ '6' Read
C MOVE PUTGET FUNCT Immediate?
C MOVELRMCMD DS5250
C Z-ADD2 PUT
C ELSE Or
C READOP IFEQ '8' Read Screen
C MOVE PUTGET FUNCT Immediate?
C MOVELRSICMD DS5250
C Z-ADD2 PUT
C ELSE Or
C READOP IFEQ '1' Invite?
C MOVE PUTGET FUNCT
C MOVELRIMCMD DS5250
C Z-ADD4 PUT
C ELSE Or
C READOP IFEQ 'A' Cancel
C MOVE 'C' FUNCT Invite?
C MOVEL'0A' WRTOP
C Z-ADD0 READIN
C EXSR VTWRT
C ELSE
C*
C* If not any of the above, then log what was received and get
C* out of here
C*
C DSPLY VTDATA
C MOVE 'E' CODE
C MOVELARRDTA STAMP
C WRITEVTOUTREC
C EXSR EOJ
C END
C END
C END
C END
C END
C END
C END
C END
C FUNCT IFEQ PUTSCR No invite
C EXCPTDSPP
C ELSE
C FUNCT IFEQ PUTGET With invite
C EXCPTDSPF
C END
C END
C FUNCT CABEQPUTSCR LOOP More to wrt?
C*
C* Now take timestamp 'A'
C*
C TIME STAMPN 120
C*
C* and record it
C*
C MOVE 'A' CODE
C MOVELSTAMPN STAMP
C WRITEVTOUTREC
C*
C ELSE
C*
C* Is this an AID key from the physical workstation
C*
C VTQTYP IFEQ '*DSPF' DSPF Entry?
C READ RPGDSPF 01Read DSPF
C*
C* Now take timestamp 'B'
C*
C TIME STAMPN
C*
C* and record it
C*
C MOVE 'B' CODE
C MOVELSTAMPN STAMP
C WRITEVTOUTREC
C*
C AIDKEY IFNE GETOUT CF23 ?
C*
C* Trim any trailing blanks from the received data stream
C*
C ' ' CHEKRDS5250 READIN
C*
C* and write response back to user application
C*
C MOVEL'0' WRTOP 2
C MOVE READOP WRTOP
C EXSR VTWRT
C END
C ELSE
C*
C* Is this the Attention key
C*
C VTQTYP IFEQ 'ATTN' ATTN entry?
C*
C* Now take timestamp 'B'
C*
C TIME STAMPN
C*
C* record it
C*
C MOVE 'B' CODE
C MOVELSTAMPN STAMP
C WRITEVTOUTREC
C*
C* and write the Attention key to the application session
C*
C MOVEL'2 ' WRTOP
C Z-ADD0 READIN
C EXSR VTWRT
C*
C ELSE
C*
C* To get here, the program has received an unknown *DTAQ
C* message OR the virtual terminal session is closing for some
C* unknown reason. In either case, log the available data and
C* get out.
C*
C MOVE 'E' CODE
C MOVELQDATA STAMP
C WRITEVTOUTREC Write log
C EXSR EOJ End Session
C END
C END
C END
C END End F23 Loop
C EXSR EOJ
C*
C* End of Mainline
C*
C/EJECT
C INIT BEGSR
C*
C* Set the attention handler program
C*
C CALL 'QCMDEXC'
C PARM CLSET Setatnpgm cl
C PARM 16 CLSIZE 155 Size of cl
C*
C* Save the user name as the name of the *DTAQ
C*
C MOVE USERID QNAME
C*
C* For performance, since the *DTAQ APIs will cache resolved
C* pointers if the *DTAQ name is library qualified, we will
C* now determine the correct library from *LIBL
C*
C CALL 'QUSROBJD'
C PARM ROBJD Rcv. var
C PARM OBJVSZ Size of rcvr
C PARM 'OBJD0100'OBJFMT 8 Format
C PARM DTAQ Data queue
C PARM '*DTAQ' OBJTYP 10 Object type
C PARM ERRCOD Error struct
C BYTAVL IFNE 0 If error
C CPFID IFEQ 'CPF9801'
C MOVELUSERID CRT2
C CALL 'QCMDEXC'
C PARM CLCRT
C PARM 34 CLSIZE 155 Size of cl
C MOVEL'QGPL' OBJLIB
C ELSE
C DSPLY CPFID show msg
C EXSR EOJ get out
C END
C END
C*
C* and save it back to the *DTAQ structure
C*
C MOVE OBJLIB QLIB
C*
C* The program will now clear the *DTAQ in anticipation of a new
C* virtual terminal session
C*
C CALL 'QCLRDTAQ' Clear *DTAQ
C PARM QNAME 10 Queue name
C PARM QLIB 10 Queue libr
C*
C* Attach the *DTAQ to the *DSPF for I/O notification
C*
C MOVELUSERID OVR2
C CALL 'QCMDEXC'
C PARM CLOVR Ovrdspf cl
C PARM 32 CLSIZE 155 Size of cl
C*
C* open the *DSPF
C*
C OPEN RPGDSPF
C*
C* and allocate the new virtual terminal session
C*
C CALL 'QTVOPNVT' Open VT
C PARM HANDLE 16 VT Handle
C PARM KBDTYP 3 Keyboard typE
C PARM CCSID Char set
C PARM CODEPG Code page
C PARM WSTYPE WS Type
C PARM DTAQ Qual Q name
C PARM QKEY 1 NOT USED
C PARM QKEYLN NOT USED
C PARM ERRCOD Error struct
C BYTAVL IFNE 0 If error
C DSPLY CPFID show msg
C EXSR EOJ get out
C END
C*
C* and return to the mainline
C*
C ENDSR
C*
C VTWRT BEGSR
C*
C* Write screen input to application session
C*
C CALL 'QTVWRTVT'
C PARM HANDLE VT Handle
C PARM WRTOP WRTBUF 10 Op code
C PARM DS5250 5250 orders
C PARM READIN size of DS
C PARM ERRCOD Error struct
C BYTAVL IFNE 0 If error
C DSPLY CPFID show msg
C MOVE 'E' CODE record 5250
C MOVELDS5250 STAMP data
C WRITEVTOUTREC stream
C*
C* In this case, we end the job without closing the VT session
C* as we do not know the state of the session
C*
C MOVE '1' *INLR
C RETRN
C END
C ENDSR
C*
C EOJ BEGSR
C*
C* Close down the virtual terminal session and exit application
C*
C CALL 'QTVCLOVT'
C PARM HANDLE VT Handle
C PARM ERRCOD Error struct
C MOVE '1' *INLR Get out no
C RETRN matter what
C ENDSR
ORPGDSPF E DSPP
O* Format for write with no invite
O K6 'USRPUT'
O USRDTA 5
O DS5250 4005
ORPGDSPF E DSPF
O* Format for write with invite
O K6 'USRREC'
O USRDTA 5
O DS5250 4005
H
F*
F* This is a sample program which, when called, places an entry
F* on a Data Queue. The Data Queue entry is 80 bytes long, with
F* the first 4 bytes = ATTN. This program is used in conjunction
F* with VTRPG2 in that the data queue entry is a signal to VTRPG2
F* to simulate the attention key to the virtual terminal session.
F* This program has not been formally tested; and is provided on
F* an as-is basis only.
F*
F* A *DTAQ must have been previously created with these
F* attributes:
F*
F* 1. Minimum length of 80 bytes
F* 2. Not keyed
F* 3. Has same name as interactive user
F* 4. Resides in *LIBL
F*
I SDS
I 254 263 QNAME
C*
C* Send to *DTAQ message which indicates ATTN key used
C*
C MOVEL'ATTN' QDATA
C CALL 'QSNDDTAQ'
C PARM QNAME 10
C PARM '*LIBL' QLIB 10
C PARM 80 QLEN 50
C PARM QDATA 80
C MOVE '1' *INLR
C RETRN
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
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.
