|
midrange.com
Here's an old RPG program I found that will talk to an icf file via biscync.
It uses CPI-C. However, you can also write this same program using straight
internal RPG.
DDS for the ICF file follows the RPG sample. You'll definitely need to clean
this up for your own purposes, but it'll get you started. Plus, there are CL
commands you'll need to review and use for ICF such as ADDICFDEVE.
This is a start. Hope it helps.
************************************************************
*
*
* PRGM: REVCPIC DATE: 03/01/97
*
*
*
* DESC: RECEIVE DATA FROM HOST - THIS IS THE REMOTE *
* PROCESSING PROGRAM STARTED BY A REMOTE JOB. *
* IT WILL RECEIVE DATA FROM THE HOST.
*
* THIS IS A CPI-C PROGRAM.
*
*
*
*
*
*
*
************************************************************
* MODIFICATIONS:
*
*
*
************************************************************
FDTAFILE O E DISK A
* Data File Will Receive Data From Host
*
IBUFFER DS 11500
I 1 8 BFTRDT
I 9 16 BFTRTM
I 17 18 BFTRTP
I 19 25 BFFPCD
I 26 33 BFTMID
I 34 41 BFWKID
I 42 49 BFPSWD
I 50 256 BFDTA1
I 257 512 BFDTA2
I 513 768 BFDTA3
I 7691024 BFDTA4
I 10251280 BFDTA5
I 12811500 BFDTA6
*
* Get system supplied CPI-Communications pseudonyms
I/COPY QRPG/QIRGINC,CMRPG
*
ICMPARM DS
I 1 8 CNVID
I B 9 120CNVSTE
I B 13 160CNVTYP
I B 17 200DATRCV
I B 21 240DLCTYP
I B 25 280ERRDIR
I B 29 320FIL
I 33 40 MODNM
I B 41 440MODNML
I 45 61 PLUNM
I B 62 650PLUNML
I B 66 690PRPTRT
I B 70 730RCVLEN
I B 74 770RCVTYP
I B 78 810REQLEN
I B 82 850REQTSR
I B 86 890RTNCDE
I B 90 930RTNCTL
I B 94 970SNDLEN
I B 98 1010SNDTYP
I B 102 1050STSRCV
I 106 113 SYMDST
I B 114 1170SYNLVL
I 118 181 TPNM
I B 182 1850TPNML
*
I 'WRITE DATAREC ERROR' C LIT1
I 'SEND PROGRAM ABEND!' C LIT2
I ' RETURN CODE ' C LIT3
*----------------------------------------------------------------
** ACCEPT CONVERSATION
C CALL 'CMACCP'
C PARM CNVID 8
C PARM 0 RTNCDE
*
C EXSR CHKRTN
*
* LOOP UNTIL DEALLOCATE IS TRUE OR ERROR CONDITION EXISTS
C *IN50 DOUEQ*ON
*
C CALL 'CMRCV'
C PARM CNVID
C PARM BUFFER
C PARM 1500 REQLEN
C PARM DATRCV
C PARM RCVLEN
C PARM STSRCV
C PARM REQTSR
C PARM 0 RTNCDE
C MOVEL'CMRCV' PROC 6
C EXSR CHKRTN
C ERROR IFEQ *OFF
* Data Received
C DATRCV IFEQ 1
C MOVE BFTRDT DFTRDT
C MOVE BFTRTM DFTRTM
C MOVE BFTRTP DFTRTP
C MOVE BFFPCD DFFPCD
C MOVE BFTMID DFTMID
C MOVE BFWKID DFWKID
C MOVE BFPSWD DFPSWD
C MOVE BFDTA1 DFDTA1
C MOVE BFDTA2 DFDTA2
C MOVE BFDTA3 DFDTA3
C MOVE BFDTA4 DFDTA4
C MOVE BFDTA5 DFDTA5
C MOVE BFDTA6 DFDTA6
C WRITEDTAREC 80
C *IN80 IFEQ *ON
C LIT1 DSPLY'*EXT'
C ENDIF
C ELSE
* Confirm Recieve
C DATRCV IFEQ 2
C EXSR CNFMRC
C MOVEL'CMCFMD' PROC 6
C EXSR CHKRTN
C ELSE
* Confirm Deallocate Receive
C DATRCV IFEQ 4
C MOVE *ON *IN50
C EXSR CNFMRC
C MOVEL'CMCFMD' PROC 6
C EXSR CHKRTN
C ELSE
* Deallocate Normal
C DATRCV IFEQ 18
C MOVE *ON *IN50
C ELSE
C EXSR SNDPER
C ENDIF
C ENDIF
C ENDIF
C ENDIF
C ENDIF
*
C ENDDO
*
C MOVE *ON *INLR
*----------------------------------------------------------------------
* CHKRTN - CHECK STATUS OF RETURN CODE
*----------------------------------------------------------------------
C CHKRTN BEGSR
*
C RTNCDE IFEQ CMOK
C MOVE *OFF *IN50
C MOVE *ON ERROR 1
C ELSE
C MOVE *OFF ERROR 1
C EXSR ERRSBR
C ENDIF
*
C ENDSR
*----------------------------------------------------------------------
* CNFMRC - CONFIRM RECEIVE
*----------------------------------------------------------------------
C CNFMRC BEGSR
*
C CALL 'CMCFMD'
C PARM CNVID
C PARM RTNCDE
*
C ENDSR
*----------------------------------------------------------------------
* SNDPER - SEND PROGRAM ERROR
*----------------------------------------------------------------------
C SNDPER BEGSR
*
C LIT2 DSPLY'*EXT'
C MOVE *ON *INLR
C RETRN
*
C ENDSR
*----------------------------------------------------------------------
* ERRSBR - ERROR SUBROUTINE
*----------------------------------------------------------------------
C ERRSBR BEGSR
*
* Send error message to sending program
C PROC CAT LIT3:1 C19 19
C MOVE RTNCDE C4 4
C C19 CAT C4 C22 22
C CALL 'CMSERR'
C PARM CNVID
C PARM REQTSR
C PARM 0 RTNCDE
*
* Flush the buffer to send the error asap
C CALL 'CMFLUS'
C PARM CNVID
C PARM 0 RTNCDE
* Set Deallocate to Abend
C CALL 'CMFLUS'
C PARM CNVID
C PARM DLCTYP
C PARM RTNCDE
* Deallocate Conversation
C CALL 'CMDEAL'
C PARM CNVID
C PARM RTNCDE
*
C MOVE *ON *INLR
C RETRN
*
C ENDSR
*********************************************************
A*
A INDARA
A RCVDETACH(35 'DETACHED')
A RCVCONFIRM(36 'CONFIRMED')
A RCVFAIL(37 'FAILED')
A*
A R SEND
A*
A ALWWRT
A CONFIRM
A* 36 RSPCONFIRM
A* SEND REQUEST DATA, USED BY SEND TO HOST
A SDATA1 1419A
A*
A R RECEIVE
A* READ FROM INVITED DEVICE, USED BY SEND TO HOST
A RCVDT1 2000A
A*
A R SENDREC
A* SEND REQUEST DATA, USED BY RECEIVE FROM HOST
A SDATA2 19A
A*
A R RECVREC
A* READ FROM INVITED DEVICE, USED BY RECEIVE FROM HOST
A RCVDT2 1500A
A*
A R INVITE INVITE
A*
A R CONFIRM
A RSPCONFIRM
A*
A R TIMER TIMER(&TIMER)
A TIMER 6S 0P
A*
A R PGMSTR
A* START PROGRAM
A EVOKE(&PGMID)
A SECURITY(2 &PASS 3 &USER)
A SYNLVL(*CONFIRM)
A PGMID 10A P
A PASS 10A P
A USER 10A P
A*
A R PGMEND
A* END PROGRAM
A DETACH
A*
A R EOSREC
A* END SESSION
A EOS
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.
