本文发表在 rolia.net 枫下论坛BROWSE - RACF COMMAND OUTPUT------------------------ LINE 00000000 COL 001 080
COMMAND ===> SCROLL ===> PAGE
********************************* Top of Data **********************************
USER=SAPER NAME=SAPER OWNER=SYSPRG1 CREATED=05.034
DEFAULT-GROUP=SYSPROG PASSDATE=00.000 PASS-INTERVAL= 60
ATTRIBUTES=ADSP SPECIAL OPERATIONS GRPACC
ATTRIBUTES=AUDITOR
REVOKE DATE=NONE RESUME DATE=NONE
LAST-ACCESS=UNKNOWN
CLASS AUTHORIZATIONS=NONE
NO-INSTALLATION-DATA
MODEL-NAME=SAPER
LOGON ALLOWED (DAYS) (TIME)
---------------------------------------------
ANYDAY ANYTIME
GROUP=SYSPROG AUTH=USE CONNECT-OWNER=SYSPRG1 CONNECT-DATE=05.034
CONNECTS= 00 UACC=NONE LAST-CONNECT=UNKNOWN
CONNECT ATTRIBUTES=NONE
REVOKE DATE=NONE RESUME DATE=NONE
SECURITY-LEVEL=NONE SPECIFIED
CATEGORY-AUTHORIZATION
NONE SPECIFIED
SECURITY-LABEL=NONE SPECIFIED
NO TSO INFORMATION
******************************** Bottom of Data ********************************更多精彩文章及讨论，请光临枫下论坛 rolia.net

本文发表在 rolia.net 枫下论坛以前在AIX上做过的CICS+COBOL程序，是写oracle库的，不存在这个问题。
在AS400上的COBOL程序实际上是写入DB2数据库的，也不存在这个问题。
目前在某UNIX上作的程序，写的是indexed file，除了生成文件外，还会生成一个.idx文件，其作用应该相当于DB2/ORACLE的索引文件。

综合来看，算是UNIX上的cobol程序和390上的最接近，直接搬过来改些关键字就可以了，连文件定义都不需要改。。。。

不知道390上的这种indexed文件是如何的？是否也有相应的另外一个索引文件？
建了个JCL，生成了一个文件，但好像访问还是有问题。。。

000001 //JIACRTJ1 JOB (CRTJ1,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1),
000002 // CLASS=A,NOTIFY=&SYSUID
000003 //RUN EXEC PGM=IDCAMS
000004 //SYSPRINT DD SYSOUT=*
000005 //SYSIN DD *
000006 DEFINE CLUSTER (NAME(JIA.DATA.VKSD0080) -
000007 TRACKS(45 15) -
000008 RECORDSIZE(80 80) -
000009 FREESPACE(10 15) -
000010 KEYS(6 0) -
000011 INDEXED) -
000012 DATA (NAME(JIA.DATA.VKSD0080.DAT) -
000013 CISZ(8192)) -
000014 INDEX (NAME(JIA.DATA.VKSD0080.IDX))
000015 /*

JIA.DATA.VKSD0080
JIA.DATA.VKSD0080.DAT 39 ? 1 3390
JIA.DATA.VKSD0080.IDX 1 ? 1 3390更多精彩文章及讨论，请光临枫下论坛 rolia.net

*06.48.03 DEMOPKG STC03595 *ANR0110E An unexpected system date has been
* detected; the server is disabled.

中心思想： 使用FTP来提交作业:

1、你先设置好一个定义用户的JCL。将此JCL下载到你的PC上作为一个摸版, say: ADDUSERM.JCL。备用。

2、将现在OS/390里面的用户和组打出一个清单，下载到PC，备用。此文件将用于确认用户申请的TSO ID 是否已经存在。

3、接受用户申请。先做ID检查，例如是否有非法字符，是否已经被申请，是否有色情仇视等不雅字眼，是否坚持三讲和四项基本原则，Ooops，又扯远了。

4、将JCL 摸板的用户名改为此新的ID, 另存一JCL文件, say ADDUSER.userid.JCL。

5、将此文件传到OS/390上并执行。命令如下：

ftp fandezhi.homedns.org
admin TSO userid
admin password
site filetype=jes
put ADDUSER.userid.JCL
site filetype=jes
quit

此法不能确认用户是否成功定义。

若要有更强的功能，TCP/IP Socket 是个不错的方法。我设计的一个系统是在Mainframe 和AIX 之间说事，用了TCP/IP Socket来与AIX软件来交流。用户甚至可以用telnet 来登陆此socket port，执行TSO命令等. 你若有兴趣，我可以把它帮上去。


Hunter.

Started Task: FANCCS. Port: 6600, input case insensitive.

你可以使用UNIX telnet or OS/390 telnet command, 但不支持Windows Telnet command. 当然你也可以用程序调用TCP/IP Socket.

From OS/390, type =6 to go to TSO command. Use following commands:
telnet tstmvs01 6600
auth guest guest
help
help lsmb
lsmb sys1.parmlib(ieasys00)
quit

所有replied messages 将下面message 作为结束：
290 CCServer Finished Sending Message.
你可以设计你的程序通过TSO 命令方式执行。

ISPF 菜单们都在**.ISPPLIB。此系统修改过的菜单在CENTER.ISPPLIB里。建议没有碰过的朋友十分小心，搞不好大家都死光光。

权限这是一个大问题。
1、首先所有用户都应该有自己的ALIAS，要不然所有文件都堆到Master Catalog。着需要一些MIGRATE工作。
2、每个用户的文件定义一个dataset profile.都可以设置成下面模式：
userid.**
3、给该用户以ALTER权限，其他用户READ权限。
4、剥夺一般用户的SPECIAL和OPERATIONAL权限。

本文发表在 rolia.net 枫下论坛*--------------------------------------------------------------*
* 说明文档 *
* 数据字典管理主控程序 *
*--------------------------------------------------------------*
*程序名 * CVOPRIM *
*作者 * WHY *
*编写日期 * 2001.10.30 *
*修改者 * *
*修改日期 * *
*--------------------------------------------------------------*
*定义的交易名 * *
* * *
*--------------------------------------------------------------*
*输入选项定义 * 从1到9的功能 *
* * 1----------保留 *
* * 2----------编辑 *
* * 3----------复制 *
* * 4----------删除 *
* * 5----------查看 *
* * 6----------保留 *
* * 7----------保留 *
* * 8----------保留 *
* * 9----------保留 *
*--------------------------------------------------------------*
*功能键定义 * 从F1到F12的功能 *
* * F1--------帮助 *
* * F2--------保留 *
* * F3--------返回前一级菜单 *
* * F4--------保留 *
* * F5--------刷新画面 *
* * F6--------保留 *
* * F7--------保留 *
* * F8--------保留 *
* * F9--------保留 *
* * F10-------保留 *
* * F11-------保留 *
* * F12-------取消操作 *
*--------------------------------------------------------------*
*输入 * 1、签到画面传入参数--数据编号等 *
* * *
* * *
*----------------*---------------------------------------------*
*输出 * 1.终端屏幕输出 *
*----------------*---------------------------------------------*
*使用的MAPSET.MAP* 1.CVMPRIM.CVMPRIM *
*----------------*---------------------------------------------*
*SFS FILE * *
*----------------*---------------------------------------------*
*TSQ * *
*----------------*---------------------------------------------*
*TDQ * *
*----------------*---------------------------------------------*
*ORACLE TABLE * CVTIOPR *
*----------------*---------------------------------------------*
*程序流向 * *
* * CVOPRIM *
* * | *
* * | *
* * CVOPRID *
* * *
* * *
* * *
* * *
*--------------------------------------------------------------*
* *
*--------------------------------------------------------------*
IDENTIFICATION DIVISION.
PROGRAM-ID. CVOPRIM.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*--------------------------------------------------------------*
* WORKING-STORAGE DEFINITION *
*--------------------------------------------------------------*
77 I PIC S9(4) COMP VALUE 1.
77 H PIC S9(4) COMP VALUE 1.
77 J PIC S9(4) COMP VALUE 1.
77 K PIC S9(4) COMP VALUE 1.
77 Y PIC S9(4) COMP VALUE 1.
77 SQLCODE-L PIC X(20).
77 UTIME PIC S9(15) COMP-3.
77 COMM-AREA-LENGTH PIC S9(4) COMP VALUE +2448.
77 GET-MSG-AREA-LENGTH PIC S9(4) COMP VALUE +75.
77 GET-SYSENV-LENGTH PIC S9(4) COMP VALUE +170.
01 CONCAT-TBNO-SEQNO OCCURS 10 TIMES.
05 CONCAT-TBNO PIC X(10).
05 CONCAT-SEQNO PIC X(3).
01 GET-MSG-AREA.
03 COMM-SYTMSGF.
05 COMM-SYMSG-MSGCOD PIC X(7).
05 COMM-SYMSG-MSGLVL PIC X(2).
05 COMM-SYMSG-MSGTXT PIC X(60).
03 COMM-TRAN-NAME PIC X(4).
03 COMM-RETURN-CODE PIC X(2).

*定义取公共信息(系统标题等)
01 GET-SYSENV-AREA.
03 COMM-REGION-NAME PIC X(8).
03 COMM-SYSTEM-NAME PIC X(40).
03 COMM-APPLICATION-NAME PIC X(40).
03 COMM-COPYRIGHT PIC X(60).
03 COMM-PROGRAM-NAME PIC X(20).
03 COMM-SYSENV-RTCODE PIC X(2).

*定义通讯区用于连接帮助中心(HELP CENTER)
01 COMM-HELP.
03 COMM-HELP-PROGRAM PIC X(20).

*此COMM-AREA长度必须为2448!
01 COMM-AREA.
03 COMM-DEVICE-AREA.
05 COMM-SYS-ID PIC X(8).
05 COMM-TERM PIC X(4).
05 COMM-NET-ID PIC X(8).
05 COMM-SYSTEM-DATE PIC X(8).
05 FILLER PIC X(22).
03 COMM-ORGANIZATION-AREA.
05 COMM-CITY-CODE PIC X(4).
05 COMM-ORG-ID PIC X(7).
05 COMM-DEPT-NO PIC X(2).
05 FILLER PIC X(37).
03 COMM-USER-AREA.
05 COMM-TELLER-BANK PIC X(7).
05 COMM-TELLER-NO PIC X(4).
05 COMM-TRAN-TABLE-NO PIC X(10).
05 COMM-TELLER-PASSWD PIC X(10).
05 FILLER PIC X(19).
03 COMM-FUNC-AREA.
05 COMM-FUNC-NAME PIC X(8).
05 FILLER PIC X(42).
03 COMM-OPERATE-AREA.
05 COMM-CURR-OPERATE PIC X(4).
05 COMM-NEXT-OPERATE PIC X(4).
05 COMM-COMMAND PIC X(8).
05 COMM-COMMAND-PARM1 PIC X(8).
05 COMM-COMMAND-PARM2 PIC X(8).
05 COMM-COMMAND-PARM3 PIC X(8).
05 COMM-PAGE-SUM PIC S9(4) COMP.
05 COMM-PAGE-NUM PIC S9(4) COMP.
05 COMM-ITEM-SUM PIC S9(8) COMP.
05 COMM-ITEM-NUM PIC S9(8) COMP.
05 FILLER PIC X(48).
03 COMM-DATA-KEY-AREA.
05 COMM-SEND-MAP-TAG PIC X(1).
05 COMM-THIS-PROGRAM PIC X(20).
05 FILLER PIC X(79).
03 COMM-USR-OPT.

*定义数据记录区的位置参数
* 8=LENGTHOF(TABLE_NO) + LENGTHOF(SEQ_NO) = 10+3 = 13
05 COMM-CURR-FIRST.
07 COMM-CURR-FIRST-TABLE PIC X(10).
07 COMM-CURR-FIRST-SEQ PIC X(3).
05 COMM-CURR-LAST.
07 COMM-CURR-LAST-TABLE PIC X(10).
07 COMM-CURR-LAST-SEQ PIC X(3).

*定义对每个数据记录的操作选项，使其成为一个数组。
05 COMM-OPR-FNT.
07 COMM-OPR-FNT-TABLE OCCURS 10 TIMES PIC X(10).
07 COMM-OPR-FNT-SEQ OCCURS 10 TIMES PIC X(3).
05 COMM-OPR-OPTION OCCURS 10 TIMES PIC X(1).
05 COMM-FNT-COUNT PIC 9(2).
05 COMM-FNT-SEQNUM PIC 9(2).
05 COMM-INIT-TAG PIC X(1).
05 COMM-F6-TAG PIC X(1).
05 FILLER PIC X(16).
03 COMM-CURR-MAP.
05 COMM-MAP-DATA PIC X(783).
05 FILLER PIC X(100).
03 COMM-DATA-AREA PIC X(965).

*拷贝CICS提供的宏定义扩展
COPY DFHBMSCA.
COPY DFHAID.

*拷贝MAP定义.
COPY CVMPRIM.

*重新定义MAP的输入，既要显示的部分，使其成为一个数组.
01 MAP-ARRAY REDEFINES CVMPRIMI.
02 FILLER PIC X(151).
02 TRNM-MAP-DATA.
03 TRNM-MAP-ARRAY OCCURS 10 TIMES.
05 FILLER PIC X(3).
05 PRMOPT PIC X(1).
05 FILLER PIC X(2).
05 PRMTBNA PIC X(1).
05 PRMTBN PIC X(10).
05 FILLER PIC X(2).
05 PRMSEQA PIC X(1).
05 PRMSEQ PIC X(3).
05 FILLER PIC X(2).
05 PRMTGNA PIC X(1).
05 PRMTGN PIC X(8).
05 FILLER PIC X(2).
05 PRMDSCA PIC X(1).
05 PRMDSC PIC X(40).
02 FILLER PIC X(155).

*定义SQL通讯区
EXEC SQL INCLUDE SQLCA END-EXEC.

*定义ORACLE通讯区
EXEC SQL BEGIN DECLARE SECTION END-EXEC.

*定义宿主变量(HOST VAR)，结构和外部ORACLE表一致
01 DCL-CVTIOPR.
05 H-TABLE-NO PIC X(10).
05 H-SEQ-NO PIC X(3).
05 H-TARGET-CODE PIC X(8).
05 H-DESCRIPTION PIC X(40).
01 DCL-MGTTLER.
05 H-BANK-NO PIC X(7).
05 H-TELLER-NO PIC X(4).
05 H-TRAN-TABLE-NO PIC X(10).
05 H-TELLER-PASSWD PIC X(10).
01 H-CONCAT-TBNO-SEQNO PIC X(13).
01 RECORD-COUNT PIC S9(4) COMP.
01 RECORD-COUNT-PAGEDOWN PIC S9(4) COMP.
01 RECORD-COUNT-PSENDMAP PIC S9(4) COMP.
01 RECORD-COUNT-PRERECORD PIC S9(4) COMP.

*结束定义ORACLE SQL通讯区
EXEC SQL END DECLARE SECTION END-EXEC.

**********CICS AREA*****************************************
LINKAGE SECTION.
01 DFHCOMMAREA PIC X(2448).
PROCEDURE DIVISION.
EXEC CICS HANDLE ABEND LABEL(RETURN-CICS)
END-EXEC.

*开始程序的第一步---传递参数
MOVE DFHCOMMAREA TO COMM-AREA.
* PERFORM CHECK-TELLER.
EXEC CICS INQUIRE TRANSACTION(EIBTRNID)
PROGRAM(COMM-THIS-PROGRAM) END-EXEC.
IF(COMM-THIS-PROGRAM = 'SYOTRNM' OR 'SYOTRND')
MOVE '0' TO COMM-CURR-FIRST-TABLE
MOVE 0 TO COMM-CURR-FIRST-SEQ
END-IF.
*重新设置显示参数,使其某段显示区域受保护，可输入等等。
MOVE DFHBMASF TO CICSNAMA.
MOVE DFHBMASF TO PRIDATEA.
MOVE DFHBMASF TO PRITIMEA.
MOVE DFHBMASF TO LOCATTRA.
MOVE DFHBMASF TO MESSAGEA.
MOVE DFHBMASF TO TERMIDA.
MOVE DFHBMFSE TO PRITBNOA.

*交易名：EIBTRNID,终端号：EIBTRMID
MOVE EIBTRMID TO TERMIDO.
MOVE EIBTRNID TO COMM-TRAN-NAME.

*取得CICS REGION名
EXEC CICS ASSIGN APPLID(CICSNAMO) END-EXEC.

*则由CICS REGION名查找系统ID表SYTSYSM,取出系统环境名等。
PERFORM RETRIVE-SYSENV.

*统计数据记录的行数。
EXEC SQL SELECT COUNT(*) INTO
:RECORD-COUNT
FROM CVTIOPR
END-EXEC.
IF(COMM-SEND-MAP-TAG = 'N')
GO TO RECEIVE-MAP
END-IF.
*--------------------------------*
PRE-SEND-MAP.
*--------------------------------*
*从COMM-CURR-FIRST位置开始显示数据记录
MOVE COMM-CURR-FIRST-TABLE TO H-TABLE-NO.
MOVE COMM-CURR-FIRST-SEQ TO H-SEQ-NO.
EXEC SQL DECLARE CURSOR_PREPARE CURSOR FOR
SELECT TABLE_NO,
SEQ_NO,
TARGET_CODE,
DESCRIPTION
FROM CVTIOPR
WHERE (TABLE_NO = :H-TABLE-NO
AND SEQ_NO >= :H-SEQ-NO)
OR TABLE_NO > :H-TABLE-NO
ORDER BY TABLE_NO||(LPAD(TO_CHAR(SEQ_NO),3))
ASC
END-EXEC.

*在屏幕的右下方显示当前记录在数据库的位置状态。
EXEC SQL SELECT COUNT(*) INTO
:RECORD-COUNT-PSENDMAP
FROM CVTIOPR
WHERE (TABLE_NO = :H-TABLE-NO
AND SEQ_NO > :H-SEQ-NO)
OR TABLE_NO > :H-TABLE-NO
END-EXEC.
EXEC CICS ENTER TRACEID(10) FROM(RECORD-COUNT-PSENDMAP)
END-EXEC.
IF(RECORD-COUNT-PSENDMAP <= 10)
MOVE '...底部' TO LOCATTRO
ELSE
MOVE '更多...' TO LOCATTRO
END-IF.

EXEC SQL OPEN CURSOR_PREPARE END-EXEC.
MOVE '_____' TO PRITBNOI.
PERFORM VARYING I FROM 1 BY 1
UNTIL I > 10 OR SQLCODE = 1403
EXEC SQL FETCH CURSOR_PREPARE INTO
:H-TABLE-NO,
:H-SEQ-NO,
:H-TARGET-CODE,
:H-DESCRIPTION
END-EXEC
*对取到的数据记录逐项地显示在指定位置上。
MOVE SQLCODE TO SQLCODE-L
MOVE SQLCODE-L(5:5) TO SQLCODE-L
EXEC CICS ENTER TRACEID(23) FROM(SQLCODE-L) END-EXEC
EXEC CICS ENTER TRACEID(24) FROM(H-TABLE-NO) END-EXEC
EXEC CICS ENTER TRACEID(25) FROM(H-SEQ-NO) END-EXEC
EXEC CICS ENTER TRACEID(26) FROM(H-DESCRIPTION)
END-EXEC
EXEC CICS ENTER TRACEID(27) FROM(H-CONCAT-TBNO-SEQNO)
END-EXEC

IF(SQLCODE NOT = 1403)
MOVE '_' TO PRMOPT(I)
MOVE H-TABLE-NO TO PRMTBN(I)
MOVE DFHBMASF TO PRMTBNA(I)
MOVE H-SEQ-NO TO PRMSEQ(I)
MOVE DFHBMASF TO PRMSEQA(I)
MOVE H-TARGET-CODE TO PRMTGN(I)
MOVE DFHBMASF TO PRMTGNA(I)
MOVE H-DESCRIPTION TO PRMDSC(I)
MOVE DFHBMASF TO PRMDSCA(I)
ELSE
COMPUTE I = I - 1
END-IF
END-PERFORM.

*对于数据记录不满10行,未填写数据的记录区以空格代替。
PERFORM VARYING H FROM I BY 1
UNTIL H > 10
MOVE SPACES TO PRMOPT(H)
MOVE SPACES TO PRMTBN(H)
MOVE SPACES TO PRMSEQ(H)
MOVE SPACES TO PRMTGN(H)
MOVE SPACES TO PRMDSC(H)
END-PERFORM.

*记录下当前数据记录的起始和结束位。
MOVE PRMTBN(1) TO COMM-CURR-FIRST-TABLE.
MOVE PRMSEQ(1) TO COMM-CURR-FIRST-SEQ.
IF(RECORD-COUNT-PSENDMAP > 10)
MOVE H-TABLE-NO TO COMM-CURR-LAST-TABLE
MOVE H-SEQ-NO TO COMM-CURR-LAST-SEQ
END-IF.
*将第一行记录的数据编码显示在数据编码检索位置上。
MOVE PRMTBN(1) TO PRITBNOI.
EXEC SQL CLOSE CURSOR_PREPARE END-EXEC.

*--------------------------------*
SEND-MAP.
*--------------------------------*
*获取系统日期和时间。
EXEC CICS ASKTIME ABSTIME(UTIME)
END-EXEC.
EXEC CICS FORMATTIME ABSTIME(UTIME)
YYYYMMDD(PRIDATEO)
TIME(PRITIMEO) TIMESEP(':')
END-EXEC.
MOVE TRNM-MAP-DATA TO COMM-MAP-DATA.
*调用MAP文件,显示固定标题部分。
EXEC CICS SEND MAP('CVMPRIM') MAPSET('CVMPRIM')
FROM(CVMPRIMO)
ERASE
FREEKB
END-EXEC.
MOVE 'N' TO COMM-SEND-MAP-TAG.
EXEC CICS RETURN TRANSID('V600')
COMMAREA(COMM-AREA)
LENGTH(COMM-AREA-LENGTH)
END-EXEC.

*--------------------------------*
RECEIVE-MAP.
*--------------------------------*
EXEC CICS IGNORE CONDITION MAPFAIL
END-EXEC.
EXEC CICS RECEIVE MAP('CVMPRIM') MAPSET('CVMPRIM')
INTO(CVMPRIMO)
END-EXEC.
MOVE 'N' TO COMM-INIT-TAG.
*定义功能键。
IF EIBAID = DFHENTER THEN
PERFORM CALL-ENTER
END-IF.
IF EIBAID = DFHPF1 THEN
PERFORM CALL-HELP
END-IF.
IF EIBAID = DFHPF3 THEN
PERFORM RETURN-CICS
END-IF.
IF EIBAID = DFHPF6 THEN
PERFORM CREATE-RECORD
END-IF.
IF EIBAID = DFHPF7 THEN
PERFORM CALL-PAGE-UP
END-IF.
IF EIBAID = DFHPF8 THEN
PERFORM CALL-PAGE-DOWN
END-IF.
IF EIBAID = DFHPF5 THEN
GO TO PRE-SEND-MAP
END-IF.
MOVE 'SMG1001' TO COMM-SYMSG-MSGCOD.
EXEC CICS LINK PROGRAM('SYOMSGM')
COMMAREA(GET-MSG-AREA)
LENGTH(GET-MSG-AREA-LENGTH)
END-EXEC.
MOVE COMM-SYMSG-MSGTXT TO MESSAGEO.
MOVE COMM-MAP-DATA TO TRNM-MAP-DATA.
GO TO SEND-MAP.

*--------------------------------*
RETURN-CICS.
*--------------------------------*
*定义返回到CICS命令模式。
EXEC CICS SEND CONTROL ERASE FREEKB END-EXEC.
MOVE 'Y' TO COMM-SEND-MAP-TAG.
EXEC CICS XCTL PROGRAM('SYOTRNM') COMMAREA(COMM-AREA)
LENGTH(COMM-AREA-LENGTH)
END-EXEC.
*--------------------------------*
CALL-HELP.
*--------------------------------*
*连接外部帮助文件。
MOVE 'Y' TO COMM-SEND-MAP-TAG
EXEC CICS XCTL PROGRAM('MGOHELP') COMMAREA(COMM-AREA)
LENGTH(COMM-AREA-LENGTH) END-EXEC.
*--------------------------------*
CALL-PAGE-UP.
*--------------------------------*
*以现在的第一条记录为准,取出ORACLE前10条数据记录。
EXEC CICS ENTER TRACEID(56) FROM(COMM-CURR-FIRST-TABLE)
END-EXEC.
EXEC CICS ENTER TRACEID(57) FROM(COMM-CURR-FIRST-SEQ)
END-EXEC.
MOVE COMM-CURR-FIRST-TABLE TO H-TABLE-NO.
MOVE COMM-CURR-FIRST-SEQ TO H-SEQ-NO.
EXEC SQL DECLARE CURSOR_PAGEUP CURSOR FOR
SELECT TABLE_NO,
SEQ_NO,
TARGET_CODE,
DESCRIPTION
FROM CVTIOPR
WHERE (TABLE_NO = :H-TABLE-NO
AND SEQ_NO < :H-SEQ-NO)
OR TABLE_NO < :H-TABLE-NO
ORDER BY TABLE_NO||(LPAD(TO_CHAR(SEQ_NO),3))
DESC
END-EXEC.
EXEC SQL OPEN CURSOR_PAGEUP END-EXEC.

*将前10条记录显示出来。
PERFORM VARYING I FROM 1 BY 1
UNTIL I > 10 OR SQLCODE = 1403
COMPUTE K = 11 - I
EXEC SQL FETCH CURSOR_PAGEUP INTO
:H-TABLE-NO,
:H-SEQ-NO,
:H-TARGET-CODE,
:H-DESCRIPTION
END-EXEC
EXEC CICS ENTER TRACEID(66) FROM(H-SEQ-NO)
END-EXEC
IF(SQLCODE NOT = 1403)
MOVE '_' TO PRMOPT(K)
MOVE H-TABLE-NO TO PRMTBN(K)
MOVE DFHBMASF TO PRMTBNA(K)
MOVE H-SEQ-NO TO PRMSEQ(K)
MOVE DFHBMASF TO PRMSEQA(K)
MOVE H-TARGET-CODE TO PRMTGN(K)
MOVE DFHBMASF TO PRMTGNA(K)
MOVE H-DESCRIPTION TO PRMDSC(K)
MOVE DFHBMASF TO PRMDSCA(K)
END-IF
END-PERFORM.

*将数据记录的起始和结束位置变量更新。
MOVE H-TABLE-NO TO COMM-CURR-FIRST-TABLE.
MOVE H-SEQ-NO TO COMM-CURR-FIRST-SEQ.
MOVE PRMTBN(10) TO COMM-CURR-LAST-TABLE.
MOVE PRMSEQ(10) TO COMM-CURR-LAST-SEQ.
* 如果向上翻屏时,在未取到10条纪录前已经到达第一条纪录,则显示第一屏.
IF(SQLCODE = 1403) THEN
MOVE '0' TO COMM-CURR-FIRST-TABLE
MOVE 0 TO COMM-CURR-FIRST-SEQ
GO TO PRE-SEND-MAP
END-IF.

EXEC SQL CLOSE CURSOR_PAGEUP END-EXEC.
MOVE '更多...' TO LOCATTRO.
MOVE COMM-CURR-FIRST-TABLE TO PRITBNOI.
GO TO SEND-MAP.

*--------------------------------*
CALL-PAGE-DOWN.
*--------------------------------*
*如果既是第一屏也是最后一屏，则转跳到第一次取到数据的部分。
IF(RECORD-COUNT <= 10)
MOVE '0' TO COMM-CURR-FIRST-TABLE
MOVE 0 TO COMM-CURR-FIRST-SEQ
GO TO PRE-SEND-MAP
END-IF.

*以现在的最尾数据记录为基准,从0RACLE数据库中向后取10条数据记录。

MOVE COMM-CURR-LAST-TABLE TO H-TABLE-NO.
MOVE COMM-CURR-LAST-SEQ TO H-SEQ-NO.
EXEC SQL DECLARE CURSOR_PAGEDOWN CURSOR FOR
SELECT TABLE_NO,
SEQ_NO,
TARGET_CODE,
DESCRIPTION
FROM CVTIOPR
WHERE (TABLE_NO = :H-TABLE-NO
AND SEQ_NO > :H-SEQ-NO)
OR TABLE_NO > :H-TABLE-NO
ORDER BY TABLE_NO||(LPAD(TO_CHAR(SEQ_NO),3))
ASC
END-EXEC.

*在屏幕的右下方显示当前记录在数据库的位置状态。
EXEC SQL SELECT COUNT(*) INTO
:RECORD-COUNT-PAGEDOWN
FROM CVTIOPR
WHERE (TABLE_NO = :H-TABLE-NO
AND SEQ_NO > :H-SEQ-NO)
OR TABLE_NO > :H-TABLE-NO
ORDER BY TABLE_NO||(LPAD(TO_CHAR(SEQ_NO),3))
END-EXEC.
IF(RECORD-COUNT-PAGEDOWN <= 10)
MOVE '...底部' TO LOCATTRO
ELSE
MOVE '更多...' TO LOCATTRO
END-IF.
EXEC SQL OPEN CURSOR_PAGEDOWN END-EXEC.

*将取得的数据记录逐项显示在指定区域。
PERFORM VARYING I FROM 1 BY 1
UNTIL I > 10 OR SQLCODE = 1403
EXEC SQL FETCH CURSOR_PAGEDOWN INTO
:H-TABLE-NO,
:H-SEQ-NO,
:H-TARGET-CODE,
:H-DESCRIPTION
END-EXEC
IF(SQLCODE NOT = 1403)
MOVE '_' TO PRMOPT(I)
MOVE H-TABLE-NO TO PRMTBN(I)
MOVE DFHBMASF TO PRMTBNA(I)
MOVE H-SEQ-NO TO PRMSEQ(I)
MOVE DFHBMASF TO PRMSEQA(I)
MOVE H-TARGET-CODE TO PRMTGN(I)
MOVE DFHBMASF TO PRMTGNA(I)
MOVE H-DESCRIPTION TO PRMDSC(I)
MOVE DFHBMASF TO PRMDSCA(I)
ELSE
COMPUTE I = I - 1
END-IF
END-PERFORM.
IF(RECORD-COUNT-PAGEDOWN > 10)
MOVE H-TABLE-NO TO COMM-CURR-LAST-TABLE
MOVE H-SEQ-NO TO COMM-CURR-LAST-SEQ
END-IF.
*如果不是总行数少于10,而是现在位置的后面记录少于10行。
IF(SQLCODE = 1403 )
PERFORM VARYING H FROM I BY 1
UNTIL H > 10
MOVE SPACES TO PRMOPT(H)
MOVE SPACES TO PRMTBN(H)
MOVE SPACES TO PRMSEQ(H)
MOVE SPACES TO PRMTGN(H)
MOVE SPACES TO PRMDSC(H)
END-PERFORM
END-IF.
EXEC SQL CLOSE CURSOR_PAGEDOWN END-EXEC.
MOVE PRMTBN(1) TO COMM-CURR-FIRST-TABLE.
MOVE PRMSEQ(1) TO COMM-CURR-FIRST-SEQ.

EXEC CICS ENTER TRACEID(56) FROM(COMM-CURR-FIRST)
END-EXEC.
MOVE COMM-CURR-FIRST-TABLE TO PRITBNOI.
GO TO SEND-MAP.

*--------------------------------*
CALL-ENTER.
*--------------------------------*
PERFORM PROCESS-OPTION THRU PROCESS-OPTION-END.
GO TO PRE-SEND-MAP.

*--------------------------------*
PROCESS-OPTION.
*--------------------------------*
MOVE ZERO TO J.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10
IF((PRMOPT(I) = '2')
OR
(PRMOPT(I) = '3')
OR
(PRMOPT(I) = '4')
OR
(PRMOPT(I) = '5'))
AND
( PRMTBN(I) NOT = SPACES)
ADD 1 TO J
MOVE PRMTBN(I) TO COMM-OPR-FNT-TABLE(J)
MOVE PRMSEQ(I) TO COMM-OPR-FNT-SEQ(J)
MOVE PRMOPT(I) TO COMM-OPR-OPTION(J)
END-IF
END-PERFORM.

IF(J = ZERO)
PERFORM GET-PRE-RECORD
MOVE 'SMG1002' TO COMM-SYMSG-MSGCOD
EXEC CICS LINK PROGRAM('SYOMSGM')
COMMAREA(GET-MSG-AREA)
LENGTH(GET-MSG-AREA-LENGTH)
END-EXEC
MOVE COMM-SYMSG-MSGTXT TO MESSAGEO
ELSE
MOVE J TO COMM-FNT-COUNT
MOVE 1 TO COMM-FNT-SEQNUM
MOVE SPACE TO MESSAGEO
*调用子程序CVODICD。
MOVE 'Y' TO COMM-SEND-MAP-TAG
EXEC CICS XCTL PROGRAM('CVOPRID')
COMMAREA(COMM-AREA)
LENGTH(COMM-AREA-LENGTH)
END-EXEC
END-IF.

*--------------------------------*
PROCESS-OPTION-END.
*--------------------------------*
EXIT.

*--------------------------------*
RETRIVE-SYSENV.
*--------------------------------*
*则由CICS REGION名查找系统ID表SYTSYSM,取出系统环境名等。
MOVE DFHBMASF TO CICSNAMA.
MOVE DFHBMASF TO TITLEMA.
MOVE DFHBMASF TO TITLEDA.
MOVE DFHBMASF TO TERMIDA.
MOVE DFHBMASF TO COPRIGTA.

MOVE CICSNAMO TO COMM-REGION-NAME.
MOVE 'CVOPRIM' TO COMM-PROGRAM-NAME.
MOVE 'CVOPRIM' TO CICSNAMO.
EXEC CICS LINK PROGRAM('SYOSYSM')
COMMAREA(GET-SYSENV-AREA)
LENGTH(GET-SYSENV-LENGTH)
END-EXEC.
*显示系统参数。
IF(COMM-SYSENV-RTCODE='00')
MOVE COMM-SYSTEM-NAME TO TITLEMO
MOVE COMM-APPLICATION-NAME TO TITLEDO
MOVE SPACES TO MESSAGEO
MOVE COMM-COPYRIGHT TO COPRIGTO
ELSE
MOVE SPACES TO TITLEMO
MOVE SPACES TO TITLEDO
MOVE SPACES TO COPRIGTO

MOVE 'SMG1003' TO COMM-SYMSG-MSGCOD
EXEC CICS LINK PROGRAM('SYOMSGM')
COMMAREA(GET-MSG-AREA)
LENGTH(GET-MSG-AREA-LENGTH)
END-EXEC
MOVE COMM-SYMSG-MSGTXT TO MESSAGEO
END-IF.
*--------------------------------*
GET-PRE-RECORD.
*--------------------------------*
*判断是否从子程序中退出，从而来决定首位置变量采用的值。
* MOVE PRITBNOI TO H-TABLE-NO.
MOVE PRITBNOI TO COMM-CURR-FIRST-TABLE.
* MOVE COMM-CURR-FIRST-SEQ TO H-SEQ-NO.
MOVE 0 TO COMM-CURR-FIRST-SEQ.


* EXEC SQL DECLARE CURSOR_PRIVRREC CURSOR FOR
* SELECT TABLE_NO,
* SEQ_NO
* FROM CVTIOPR
* WHERE (TABLE_NO = :H-TABLE-NO
* AND SEQ_NO < :H-SEQ-NO)
* OR TABLE_NO < :H-TABLE-NO
* ORDER BY TABLE_NO||(LPAD(TO_CHAR(SEQ_NO),3))
* DESC
* END-EXEC.
*
* EXEC SQL OPEN CURSOR_PRIVRREC END-EXEC.
* EXEC SQL FETCH CURSOR_PRIVRREC INTO
* :H-TABLE-NO,
* :H-SEQ-NO
* END-EXEC.
* IF(SQLCODE NOT = 0)
* MOVE '0' TO H-TABLE-NO
* MOVE 0 TO H-SEQ-NO
* END-IF.
*
* MOVE H-TABLE-NO TO COMM-CURR-FIRST-TABLE.
* MOVE H-SEQ-NO TO COMM-CURR-FIRST-SEQ.
* MOVE 0 TO COMM-CURR-FIRST-SEQ.
*记录定位记录后面的数据记录行数。
* EXEC SQL SELECT COUNT(*) INTO
* :RECORD-COUNT-PRERECORD
* FROM CVTIOPR
* WHERE (TABLE_NO = :H-TABLE-NO
* AND SEQ_NO >= :H-SEQ-NO)
* OR TABLE_NO > :H-TABLE-NO
* ORDER BY TABLE_NO||(LPAD(TO_CHAR(SEQ_NO),3))
* END-EXEC.
* IF(RECORD-COUNT-PRERECORD < 10)
* MOVE H-TABLE-NO TO COMM-CURR-LAST-TABLE
* MOVE H-SEQ-NO TO COMM-CURR-LAST-SEQ
* END-IF.
*
* EXEC SQL CLOSE CURSOR_PRIVRREC END-EXEC.
*
*--------------------------------*
CREATE-RECORD.
*--------------------------------*
*调用子程序SYOMTND。
MOVE '3' TO COMM-OPR-OPTION(1)
MOVE X'20' TO COMM-OPR-FNT-TABLE(I).
MOVE X'00' TO COMM-OPR-FNT-SEQ(I).
MOVE 1 TO COMM-FNT-COUNT.
MOVE 1 TO COMM-FNT-SEQNUM.
MOVE 'Y' TO COMM-SEND-MAP-TAG
EXEC CICS XCTL PROGRAM('CVOPRID')
COMMAREA(COMM-AREA)
LENGTH(COMM-AREA-LENGTH)
END-EXEC.
*-------------------------------------------------------------*
CHECK-TELLER.
*-------------------------------------------------------------*
MOVE COMM-TELLER-BANK TO H-BANK-NO.
MOVE COMM-TELLER-NO TO H-TELLER-NO.
MOVE COMM-TRAN-TABLE-NO TO H-TRAN-TABLE-NO.
EXEC CIC ENTER TRACEID(55) END-EXEC.
EXEC SQL SELECT TELLER_PASSWD
INTO :H-TELLER-PASSWD
FROM MGTTLER
WHERE BANK_NO = :H-BANK-NO
AND TELLER_NO = :H-TELLER-NO
AND TRAN_TABLE_NO = :H-TRAN-TABLE-NO
END-EXEC.
IF(SQLCODE NOT = 0 OR
H-TELLER-PASSWD NOT = COMM-TELLER-PASSWD)
MOVE 'Y' TO COMM-SEND-MAP-TAG
EXEC CICS XCTL PROGRAM('MGOVLDM') COMMAREA(COMM-AREA)
LENGTH(COMM-AREA-LENGTH) END-EXEC
END-IF.更多精彩文章及讨论，请光临枫下论坛 rolia.net