×

Loading...
Ad by
  • 推荐 OXIO 加拿大高速网络，最低月费仅$40. 使用推荐码 RCR37MB 可获得一个月的免费服务
Ad by
  • 推荐 OXIO 加拿大高速网络，最低月费仅$40. 使用推荐码 RCR37MB 可获得一个月的免费服务

@Florida

程序一: COBOL程序

thisunreal(饭得志)
本文发表在 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
(#2146446@0)
Last Updated: 2005-2-25
This post has been archived. It cannot be replied.
Report

Replies, comments and Discussions:

  • 工作学习 / IT技术讨论 / pc/390，把机器端口映射到路由器上了。。。在外面也可以成功登陆了。有没有想把主机技术检起来的弟兄？发pm给我，一起研究？ -thisunreal(饭得志); 2005-2-3 (#2107390@0)
    • Me..... -saper(NEW YEAR!!!); 2005-2-3 (#2107422@0)
    • 还有个问题：我以前没做过系统管理，只搞过一点开发，请问，怎么加一个用户？ -thisunreal(饭得志); 2005-2-3 {302} (#2107452@0)
      我用RACF菜单或者TSO命令'ACCOUNT'添加都不成功，加完了以后虽然说‘Account create'但不能登陆TSO。请问那位大虾有经验？能加用户了以后大家就可以一起研究了。。。。
      我把截图稿下来了。
      http://www.cacareer.com/sign/pics/1.jpg
      http://www.cacareer.com/sign/pics/2.jpg
      http://www.cacareer.com/sign/pics/3.jpg
      • MORE... -thisunreal(饭得志); 2005-2-3 {1108} (#2107461@0)
        本文发表在 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
        • 小饭:Lionel是个行家,发PM 给他.相信我,不会错的. -scottee(笑熬浆糊); 2005-2-3 (#2107501@0)
          • hehe, 对 -haah(1212123); 2005-2-7 (#2114536@0)
      • you need add TSO info to the user profile. Some systems also use TSO account. For example, IBMUSER is always in TSO account in case of RACF failure. -lionel(Lionel); 2005-2-3 (#2107486@0)
        • O,谢谢！我埋头研究了半天，早知道您那么快回信息我就少走不少弯路了，THX! -thisunreal(饭得志); 2005-2-3 (#2107519@0)
      • 截图现在能打开了. -scottee(笑熬浆糊); 2005-2-3 (#2107495@0)
    • 哈哈！增加成功了！原来TSO信息是位于ADDITIONAL的(OPTION),以前一直没注意！加了个用户SAPER
      -thisunreal(饭得志); 2005-2-3 (#2107517@0)
      • 替俺加个User ID 吧,并把IP告诉我.谢谢. -scottee(笑熬浆糊); 2005-2-3 (#2107525@0)
        • 已经建了。。。另外Lionel有空帮看看吗？cics,nvas,netview,ims那些都不知道怎么启动呀。 -thisunreal(饭得志); 2005-2-3 (#2107533@0)
          • If you are in Toronto, I can copy a ready-to-use demopack to you(7 CDs). I tested CICS, DB2, IMS, MQ on my system 3 years ago. Please send PM to me. -lionel(Lionel); 2005-2-3 (#2107732@0)
            • MSG sent. I will be back home after 7:00 PM, Thx. -thisunreal(饭得志); 2005-2-3 (#2107788@0)
            • Can i have a copy 2? thx -saper(NEW YEAR!!!); 2005-2-3 (#2107873@0)
      • Thx, i will do the testing.... Let's improve together.... -saper(NEW YEAR!!!); 2005-2-3 (#2107867@0)
    • 加我，加我，我也要拣起来！ -x888(做好国人，上班不唰网); 2005-2-3 (#2107815@0)
    • 没想到饭兄样样精通！俺搞MVS系统管理算来也有十来年了，握手！ 也和浆糊握手！ 另外，定义用户除了RACF, TSO account以外，还有如下几项要做： -unknown2me(行者); 2005-2-3 {213} (#2108103@0)
      建立一个HLQ， 例如SAPER.**, 给与ALTER 权利.
      给一个已定义好的Group,例如 SYS1
      特殊用户给与SPECIAL,OPERATIONAL, 或者AUDIT权利.
      UNIX System Service : PID, GROUP需要GID.
      CICS, IMS, DB2和Netview 通常需要另外的定义.
      • 多谢指点！小弟对主机开发只是略知一二，对系统管理基本上一窍不通。390 V2.9的RACF好像可以设置所有的这些东西。。。您有没有兴趣搞个用户上去玩玩？ -thisunreal(饭得志); 2005-2-3 (#2108117@0)
        • 请给我一个吧. 虽然我整天泡着MVS, 但是看到不一样的系统还是有意思的. 另外,有个MVS Freeware的网站, 俺也有些小软件发表在那里, 有兴趣可以去看一看. -unknown2me(行者); 2005-2-3 {103} (#2108136@0)
          我这里有一套OS/390 V2.5 和OS/390 V2.10, 现在公司用的是Z/OS 1.4.

          在家里的PC 慢的要死, 好久没有运行了.
          • 谢谢.宝库呀. -scottee(笑熬浆糊); 2005-2-3 (#2108152@0)
      • 握手! 握高手的手! -scottee(笑熬浆糊); 2005-2-3 (#2108121@0)
      • Can you open a mainframe class? Maybe there are lots of people who will take. I will have a PC with P4 2.6G with 2 GB memory as a platform. Of course you will get paid... -saper(NEW YEAR!!!); 2005-2-3 (#2108235@0)
        • 老弟是不是想回人家饭总的帖啊．就俺这半瓶醋，你还真有勇气！ -unknown2me(行者); 2005-2-4 (#2110183@0)
    • 让我上去玩玩，行吗？ -647i(盲人协会); 2005-2-4 (#2109483@0)
      • USER ===> X647I -thisunreal(饭得志); 2005-2-4 (#2109697@0)
    • 刚刚游览了一下，你的"Mainframe" 有17 MIPS, 512MB 内存，这相当于10年前一些省会城市的主机容量！记得那时候这样的系统动撤就是上百万美金，老饭你发财了！如果你愿意，俺可以给你搞一个新的登陆页，上面可写上“老饭”二字。 大家也可以出出注意，写上其他的招牌。 -unknown2me(行者); 2005-2-4 (#2109512@0)
      • 在启动的时候，我看hercules,最高的时候有57 mips。。。赫赫，里面的CICS/DB2/IMS/MQ都没启动，现在是烂系统一个。 -thisunreal(饭得志); 2005-2-4 (#2109687@0)
      • 这个监测软件如何？ -thisunreal(饭得志); 2005-2-4 (#2109809@0)
        • Good. -scottee(笑熬浆糊); 2005-2-4 (#2109820@0)
        • 俺用的是IPLINFO, 试一试在你的系统里的任何地方执行下面一个命令： -unknown2me(行者); 2005-2-4 {211} (#2110180@0)
          TSO EX 'HUNTER.REXX.LIBRARY(IPLINFO)'

          当然系统监测我们都是用RMF, 在用之前，启动下面MVS 系统命令：
          =13;14;LOG 进入SDSF LOG
          /S RMF
          /F RMF,S III

          你的DEMO PAKAGE应该带有Netview, 那可是一个又臭又长的东东．
    • I'm thinking to learn 390, too. Could you tell me the IP and account I can use to log in? -dotod(河石); 2005-2-6 (#2112247@0)
      • OK -thisunreal(饭得志); 2005-2-7 (#2113138@0)
        • I'm a very beginer in host environment. going to get some intro books to read. Thank you so much for the offer. -dotod(河石); 2005-2-8 (#2115061@0)
    • 请问,这个烂环境的cobol编译器有问题? 哪位能帮忙上去设置一下? -thisunreal(饭得志); 2005-2-7 {181} (#2114361@0)
      IKJ79319I ALTLIB terminated. Severe error allocating data sets for the DATASET
      keyword.+
      IKJ56228I DATA SET VSCOBOL2.V1R4M0.COB2CLIB NOT IN CATALOG OR CATALOG CAN NOT BE ACCESSED
      • 你的COBOL没有安装上。也许作为DEMO系统并不需要它。要不要我帮你拷一个？ -unknown2me(行者); 2005-2-8 (#2114917@0)
        • 早说。。。靠你了！ -thisunreal(饭得志); 2005-2-8 (#2114953@0)
          • 俺装了一个COBOL II，HLQ为COBOL。试一试COBOL.COB2LIB. -unknown2me(行者); 2005-2-8 (#2115741@0)
    • 发现这几天家里的网络特别稳定，没掉线。。。IP还是原来那个。顺便问一句：怎么设置390的网络的？我在里面用FTP, PING等都不通外面的网络？想传几个文件进去都不方便呀。 -thisunreal(饭得志); 2005-2-9 (#2116575@0)
      • 这个说来有点复杂，给你个连接吧。想必你饭爷脑袋一定很灵光，能够轻松搞定！ -unknown2me(行者); 2005-2-9 (#2117010@0)
        • 很感谢！回家再试试看。。。请问您自己的库下的文件是怎么搞到的？我试了一下390自己的s ftpd好像起不来啊。 -thisunreal(饭得志); 2005-2-9 (#2117053@0)
          • 我的文件是用IND$FILE上传的，14MB。这样吧，你把你PC所需的CTCI Drivers 等装好, 我帮你设置OS/390 的TCP/IP. -unknown2me(行者); 2005-2-9 {213} (#2117294@0)
            你现在的系统TCP/IP 是不能用的. 按照人家网站上的步骤来吧。

            DEMOPKG 提供FTP, UNIX telnet, TN3270 Telnet, HTTP Server（有现成的网页）, SMTP server, Printer Server , 反正能有的都改有。如果你有兴趣我们都可以搞起来。
            • 装好了.其实CTCI和VM Ware的bridge有点像?都是把虚拟的系统和基本平台联系起来.虚拟几个ip地址胡连. -thisunreal(饭得志); 2005-2-9 {757} (#2117375@0)
              .....................
              000C 3505 /usr/local/share/hercules/zzsacard.bin
              000D 3525 /pc390/punch00d.txt ascii
              000E 1403 /pc390/print00e.txt crlf
              0E20-0E21 3088 CTCI 192.168.1.88 192.168.1.77
              01c0 3390 /pc390/dmtres.1c0
              01c1 3390 /pc390/dmtcat.1c1

              ...............
              ................

              具体情况可以到http://fandezhi.homedns.org:8081/
              看看?好像都还算运行正常?
              ---------------------------------------
              TunTap32.dll version 2.0.3.379 initiated
              HHCCT073I 0E20: TUN device tun0 opened
              HHCDA020I /pc390/dmtres.1c0 cyls=2226 heads=15 tracks=33390 trklen=56832

              -----------------------------------------------------

              配置文档是不是http://www.softdevlabs.com/Hercules/ctci-w32-faq.html#MVSTCPIPconfig
              我太困了,收工睡觉了.
              • 辛苦了！再帮忙确认一下下面的事情： -unknown2me(行者); 2005-2-10 {925} (#2117828@0)
                1、告诉我下面信息：
                你的PC的IP address: (192.168.1.88)
                你给OS/390的IP address: (192.168.1.77)
                你的OS/390的hostname: (现在是tstmvs01，可以取一个fanos390).

                2、修改下面Hercules Config record:
                From:
                0E20-0E21 3088 CTCI 192.168.1.88 192.168.1.77
                To:
                0530-0531 3088 CTCI 192.168.1.88 192.168.1.77
                第一个IP(192.168.1.88) 是你的PC的IP地址，第二个IP(192.168.1.77)是给OS/390系统的地址。

                3、确认下面的几个小软件是否装在你的PC上， 如果没有，参照链接下载并装好：

                WinPCap
                FishPack-1.3.0.323-dll.zip 解压到你的\WINNT\SYSTEM32
                TunTap32-2.0.3.379-dll.zip 解压到你的\WINNT\SYSTEM32
                tt32info-1.0.2.133-exe.zip

                4.按照下面地址确认你的PC 的TCP/IP Forward is enabled：
                http://www.softdevlabs.com/Hercules/ctci-w32-readme.html

                OS/390 的TCP/IP 已经装好(hostname: tstmvs01, IP: 192.168.1.77)，试一试下面命令：

                =6 转到 TSO command,
                telnet tstmvs01

                这是以后我们将用的登陆方法。
                • Thx!...... -thisunreal(饭得志); 2005-2-10 {516} (#2117849@0)
                  昨晚我花了半个小时设置的情况：
                  1、PC的ip是1.77, 390的ip是1.88。。。呵呵，88太俗，一直以来都没用过在PC上
                  2、明白。不用改了。
                  3、这4个东西都下载了，装了第一个，解压了中间两个，最后一个是测试Debug用的吧。
                  4、已经改了注册表了

                  。。。。。
                  5、回家再看看了，现在打工活命要紧。
                  6、忽然记起来，昨天忘记关了那台机的serv-U ftp server了（装在WINXP上的，方便各位网友拷贝Japan AV）。。。这个肯定会导致你ftp测试失败。不过今早已经关掉serv-U了
                  7、帮忙把390的ip改回1.88？我都找不到那个配置ip的文件在哪个库下面，没法子，菜啊！
                  • 好了，就快好了。我可以ping 77和88。呵呵，七七八八的。 -unknown2me(行者); 2005-2-10 {421} (#2117925@0)
                    下面的事情就是将88(OS390)的下面TCP/IP ports映射到你的router:

                    21 FTP : 现在被Serv-U FTP server占着
                    23 TN3270
                    111 PORTMAP ; Portmap server
                    25 SMTP ; SMTP Server
                    80 HTTPD ; Web server
                    161 OSNMPD ; SNMP Server
                    1023 TELNET : UNIX Telnet
                    2023 TELNET : TN3270 telnet

                    另外，下次IPL使用下面参数：
                    01C1FD.1
                    • 谢谢！呵呵，刚才趁工头不注意看了两眼，SYS1.PARMLIB的配置文件不少嘛。。。对了，那台1.77我设置成暴露于路由器之外了，不用映射端口就可以。。。但有人攻击就over了；1.88那个ip嘛，不同端口映射到路由器上，只能回家再搞了。
                      -thisunreal(饭得志); 2005-2-10 (#2117953@0)
                      • 记号,HEIHEI
                        -thisunreal(饭得志); 2005-2-10 (#2118068@0)
                        • 试一试 tso ftp fanpc, 你可以从你的PC传文件了！ -unknown2me(行者); 2005-2-10 (#2118110@0)
                          • 呵呵，刚从FANPC上倒了个TASID装上去，效果不错
                            -thisunreal(饭得志); 2005-2-10 (#2118141@0)
      • 另外，你能否设置一个Dynamic DNS主机名，这样下次换IP时你不必通知所有人。你的Router应该支持这个功能。 -unknown2me(行者); 2005-2-9 (#2117020@0)
        • hehe，好几十块美金啊，去哪里偷？ -thisunreal(饭得志); 2005-2-9 (#2117045@0)
          • 我说老饭哪，花点时间看看人家网站，DDNS是免费的。为这我刚刚搞了一个。来这里看看啊。 -unknown2me(行者); 2005-2-9 {76} (#2117283@0)
            这是我的ROUTER的DDNS名称: 有本事进来看看：
            https://zhough.homedns.org:8080/
            • 赫赫,原来不是顶级域名,我就琢磨着呢,哪有那么爽的免费! 不过也好过没有,我暂时映射到fandezhi.homedns.org吧. -thisunreal(饭得志); 2005-2-9 {534} (#2117325@0)
              C:\Documents and Settings\Window>ping fandezhi.homedns.org

              Pinging fandezhi.homedns.org [70.48.102.101] with 32 bytes of data:

              Reply from 70.48.102.101: bytes=32 time<1ms TTL=64
              Reply from 70.48.102.101: bytes=32 time<1ms TTL=64
              Reply from 70.48.102.101: bytes=32 time<1ms TTL=64
              Reply from 70.48.102.101: bytes=32 time<1ms TTL=64

              Ping statistics for 70.48.102.101:
              Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),
              Approximate round trip times in milli-seconds:
              Minimum = 0ms, Maximum = 0ms, Average = 0ms
    • 老饭，你的mainframe 现在可以访问internet。就等你开放其TCP/IP ports. -unknown2me(行者); 2005-2-11 {221} (#2119500@0)
      试了一下 ftp.software.ibm.com:
      ftp 207.25.253.47

      你能否告诉我你ISP的DNS server IPs， 这样们就可以用主机名字了.


      另外，我做了如下修改：
      1、增加option S for SDSF. 试一试 =S
      2、将TSO 用户的空闲时间限制为30分钟。
      • 嗬嗬，很感谢啊！DNS名字我要回去查。。。早上我在回忆JCL编译COBOL。。。用你装的编译器cobol2。。有没有现成的编译作业流抄一下？我自己写的根本没法通过。。。。
        -thisunreal(饭得志); 2005-2-11 (#2119508@0)
        • 搞定，试一试你的作业。好像你的源程序有点问题。 -unknown2me(行者); 2005-2-11 (#2119554@0)
          • 赫赫，刚才亲眼看到您在修改。。。请教：为啥开始说找不到COB2UC? 这个作业流是我从公司以前的破程序报表抄来的。以前我从不手写作业流编译。。。。。惭愧啊。 -thisunreal(饭得志); 2005-2-11 (#2119575@0)
            • 我也惭愧惭愧。这么多年对COBOL提不起兴趣来，倒是对Assembler 和 REXX 很熟悉。 -unknown2me(行者); 2005-2-11 (#2120467@0)
          • 编译。。。 -thisunreal(饭得志); 2005-2-11 {10438} (#2119846@0)
            本文发表在 rolia.net 枫下论坛编译..............
            ********************************* Top of Data **********************************
            1 J E S 2 J O B L O G -- S Y S T E M 3 0 9 0 -- N O D E
            0
            02.45.29 JOB02355 ---- SATURDAY, 12 FEB 2005 ----
            02.45.29 JOB02355 IRR010I USERID JIA IS ASSIGNED TO THIS JOB.
            02.45.29 JOB02355 IEF677I WARNING MESSAGE(S) FOR JOB JIASJOBA ISSUED
            02.45.29 JOB02355 ICH70001I JIA LAST ACCESS AT 02:44:54 ON SATURDAY, FEBR
            02.45.29 JOB02355 $HASP373 JIASJOBA STARTED - INIT 1 - CLASS A - SYS 3090
            02.45.29 JOB02355 IEF403I JIASJOBA - STARTED - TIME=02.45.29
            02.45.30 JOB02355 IEF453I JIASJOBA - JOB FAILED - JCL ERROR - TIME=02.45.30
            02.45.30 JOB02355 $HASP395 JIASJOBA ENDED
            0------ JES2 JOB STATISTICS ------
            - 12 FEB 2005 JOB EXECUTION DATE
            - 14 CARDS READ
            - 220 SYSOUT PRINT RECORDS
            - 0 SYSOUT PUNCH RECORDS
            - 14 SYSOUT SPOOL KBYTES
            - 0.01 MINUTES EXECUTION TIME
            1 //JIASJOBA JOB (JIACOM,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1),
            // CLASS=A,NOTIFY=&SYSUID
            //*
            IEFC653I SUBSTITUTION JCL - (JIACOM,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1)
            2 // SET MEM=COBSAMP1
            //*
            3 //COBS1 EXEC COB2UCL,
            // PARM='MAP,APOST,NOOPT,SZ(MAX),
            // NOTERM,DATA(31),LIB,SOURCE'
            4 XXCOB2UCL PROC CMP='COBOL.COB2COMP',LIB='COBOL.COB2LIB'
            XX* PROC FOR COBOL II - COMPILE AND LINK
            5 XXCOB2 EXEC PGM=IGYCRCTL,PARM='OBJECT',REGION=1024K
            6 XXSTEPLIB DD DSNAME=&CMP,DISP=SHR
            IEFC653I SUBSTITUTION JCL - DSNAME=COBOL.COB2COMP,DISP=SHR
            7 //SYSPRINT DD SYSOUT=*
            X/SYSPRINT DD SYSOUT=*
            8 //SYSLIN DD DISP=SHR,DSN=WHY.JIA.LOAD(&MEM)
            IEFC653I SUBSTITUTION JCL - DISP=SHR,DSN=WHY.JIA.LOAD(COBSAMP1)
            X/SYSLIN DD DSNAME=&&LOADSET,UNIT=SYSDA,DISP=(MOD,PASS),
            X/ SPACE=(TRK,(3,3))
            9 XXSYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            10 XXSYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            11 XXSYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            12 XXSYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            13 XXSYSUT5 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            14 XXSYSUT6 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            15 XXSYSUT7 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            16 //SYSLIB DD DISP=SHR,DSN=COBOL.COB2LIB
            17 // DD DISP=SHR,DSN=WHY.JIA.COBCPY1
            18 //SYSIN DD DISP=SHR,DSN=WHY.JIA.COBOL(&MEM)
            IEFC653I SUBSTITUTION JCL - DISP=SHR,DSN=WHY.JIA.COBOL(COBSAMP1)
            19 XXLKED EXEC PGM=IEWL,PARM='LIST,XREF,LET,MAP',COND=(5,LT,COB2),
            XX REGION=512K
            20 XXSYSLIN DD DSNAME=&&LOADSET,DISP=(OLD,DELETE)
            21 XX DD DDNAME=SYSIN
            22 XXSYSLMOD DD DSNAME=&&GOSET(GO),DISP=(,PASS),UNIT=SYSDA,
            XX SPACE=(CYL,(1,1,1))
            23 XXSYSLIB DD DSNAME=&LIB,DISP=SHR
            IEFC653I SUBSTITUTION JCL - DSNAME=COBOL.COB2LIB,DISP=SHR
            24 XXSYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
            25 XXSYSPRINT DD SYSOUT=*
            //*
            STMT NO. MESSAGE
            3 IEFC001I PROCEDURE COB2UCL WAS EXPANDED USING SYSTEM LIBRARY CENTER.P
            25 IEF686I DDNAME REFERRED TO ON DDNAME KEYWORD IN PRIOR STEP WAS NOT RE
            ICH70001I JIA LAST ACCESS AT 02:44:54 ON SATURDAY, FEBRUARY 12, 2005
            IEF236I ALLOC. FOR JIASJOBA COB2 COBS1
            IGD103I SMS ALLOCATED TO DDNAME STEPLIB
            IEF237I JES2 ALLOCATED TO SYSPRINT
            IGD103I SMS ALLOCATED TO DDNAME SYSLIN
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT1 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100176 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS3
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT2 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100177 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS1
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT3 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100178 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS2
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT4 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100179 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS2
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT5 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100180 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS3
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT6 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100181 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS1
            IGD101I SMS ALLOCATED TO DDNAME (SYSUT7 )
            DSN (SYS05043.T024529.RA000.JIASJOBA.R0100182 )
            STORCLAS (OSBASE) MGMTCLAS ( ) DATACLAS ( )
            VOL SER NOS= DMTOS1
            IGD103I SMS ALLOCATED TO DDNAME SYSLIB
            IGD103I SMS ALLOCATED TO DDNAME
            IGD103I SMS ALLOCATED TO DDNAME SYSIN
            IEF142I JIASJOBA COB2 COBS1 - STEP WAS EXECUTED - COND CODE 0000
            IGD104I COBOL.COB2COMP RETAINED, DDNAME=STEPLIB
            IEF285I JIA.JIASJOBA.JOB02355.D0000101.? SYSOUT
            IGD104I WHY.JIA.LOAD RETAINED, DDNAME=SYSLIN
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100176 DELETED, DDNAME=SYSUT1
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100177 DELETED, DDNAME=SYSUT2
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100178 DELETED, DDNAME=SYSUT3
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100179 DELETED, DDNAME=SYSUT4
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100180 DELETED, DDNAME=SYSUT5
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100181 DELETED, DDNAME=SYSUT6
            IGD105I SYS05043.T024529.RA000.JIASJOBA.R0100182 DELETED, DDNAME=SYSUT7
            IGD104I COBOL.COB2LIB RETAINED, DDNAME=SYSLIB
            IGD104I WHY.JIA.COBCPY1 RETAINED, DDNAME=
            IGD104I WHY.JIA.COBOL RETAINED, DDNAME=SYSIN
            IEF373I STEP/COB2 /START 2005043.0245
            IEF374I STEP/COB2 /STOP 2005043.0245 CPU 0MIN 00.34SEC SRB 0MIN 00.07
            IEF212I JIASJOBA LKED COBS1 SYSLIN - DATA SET NOT FOUND
            IEF272I JIASJOBA LKED COBS1 - STEP WAS NOT EXECUTED.
            IEF373I STEP/LKED /START 2005043.0245
            IEF374I STEP/LKED /STOP 2005043.0245 CPU 0MIN 00.00SEC SRB 0MIN 00.00
            IEF375I JOB/JIASJOBA/START 2005043.0245
            IEF376I JOB/JIASJOBA/STOP 2005043.0245 CPU 0MIN 00.34SEC SRB 0MIN 00.07
            1PP 5668-958 IBM VS COBOL II Release 4.0 09/15/92 Date
            0Invocation parameters:
            MAP,APOST,NOOPT,SZ(MAX), NOTERM,DATA(31),LIB,SOURCE
            0Options in effect:
            ADV
            APOST
            NOAWO
            BUFSIZE(4096)
            NOCMPR2
            NOCOMPILE(S)
            DATA(31)
            NODBCS
            NODECK
            NODUMP
            NODYNAM
            NOEXIT
            NOFASTSRT
            NOFDUMP
            FLAG(I)
            NOFLAGMIG
            NOFLAGSAA
            NOFLAGSTD
            LANGUAGE(EN)
            LIB
            LINECOUNT(60)
            NOLIST
            MAP
            NONAME
            NONUMBER
            NUMPROC(NOPFD)
            OBJECT
            NOOFFSET
            NOOPTIMIZE
            OUTDD(SYSOUT)
            NORENT
            NORESIDENT
            SEQUENCE
            SIZE(MAX)
            SOURCE
            SPACE(1)
            NOSSRANGE
            NOTERM
            NOTEST
            TRUNC(STD)
            NOVBREF
            NOWORD
            NOXREF
            ZWB
            1PP 5668-958 IBM VS COBOL II Release 4.0 09/15/92 COBSAMP1 Date
            LineID PL SL ----+-*A-1-B--+----2----+----3----+----4----+----5----+----6--
            0 000001 000100 ID DIVISION.
            000002 000200 PROGRAM-ID. COBSAMP1.
            000003 000300 AUTHOR. FANDEZHI.
            000004 000400 DATE-WRITTEN. FEB-2005.
            000005 000500
            000006 000600 ENVIRONMENT DIVISION.
            000007 000700 CONFIGURATION SECTION.
            000008 000800 SOURCE-COMPUTER. IBM-370.
            000009 000900 OBJECT-COMPUTER. IBM-370.
            000010 000910 DATA DIVISION.
            000011 001000 WORKING-STORAGE SECTION.
            000012 001010 01 DSP-NA PIC S9(05).
            000013 001100 PROCEDURE DIVISION.
            000014 001200 DISPLAY 'HELLO, WORLD!'.
            000015 001300 STOP RUN.
            1PP 5668-958 IBM VS COBOL II Release 4.0 09/15/92 COBSAMP1 Date
            0Data Division Map
            0Data Definition Attribute codes (rightmost column) have the following meanings:
            D = Object of OCCURS DEPENDING G = GLOBAL S
            E = EXTERNAL O = Has OCCURS clause U
            F = Fixed length file OG= Group has own length definition V
            FB= Fixed length blocked file R = REDEFINES VB
            0Source Hierarchy and Base Hex-Displa
            LineID Data Name Locator Blk Stru
            2 PROGRAM-ID COBSAMP1 ---------------------------------------------------
            12 01 DSP-NA. . . . . . . . . . . . . . . . . . . . BLW=0000 000
            0PROGRAM GLOBAL TABLE BEGINS AT LOCATION 000080 FOR 000008 BYTES
            THE PGT CONTAINS 000001 CELL(S) FOR ADDRESSABILITY TO THE CGT
            PBL1 AT LOCATION 000110 FOR LINE 2
            0
            1PP 5668-958 IBM VS COBOL II Release 4.0 09/15/92 COBSAMP1 Date
            0CONSTANT GLOBAL TABLE BEGINS AT LOCATION 000088 FOR 000085 BYTES
            LITERAL POOL MAP FOR LITERALS IN THE CGT:

            00008C (LIT+0) 00000001 00000000 C8C5D3D3 D66B40E6 D6D9D3C4 5AC3D6C2 E2C1
            0000AC (LIT+32) D6E4E340 40000000 00000001 24000000 01000001 28000000 0100
            0000CC (LIT+64) 00800000 00408000 00000025 C0000140 00080800 00000019 8001
            0000EC (LIT+96) 0000000C FF800000 000040C0 00014000 08080000 00001902 4000
            00010C (LIT+128) 19
            0
            TGT LOCATED AT 0001C8 FOR 00000148 BYTES
            WRK-STOR LOCATED AT 000310 FOR 00000005 BYTES
            SPEC-REG LOCATED AT 000318 FOR 00000031 BYTES
            -* Statistics for COBOL program COBSAMP1:
            * Source records = 15
            * Data Division statements = 1
            * Procedure Division statements = 2
            0End of compilation 1, program COBSAMP1, no statements flagged.
            0Return code 0更多精彩文章及讨论，请光临枫下论坛 rolia.net
            • 编译的结果,看上去没有错.return code = 0. -scottee(笑熬浆糊); 2005-2-11 (#2119865@0)
              • 问个很弱的问题。。。怎么执行HELLO WORLD？ -thisunreal(饭得志); 2005-2-11 {4177} (#2119934@0)
                本文发表在 rolia.net 枫下论坛想后台执行，抄了个JCL
                //JIAHELLO JOB (HELLO,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1),
                // CLASS=A,NOTIFY=&SYSUID
                //***************************************************************
                //RUN EXEC PGM=COBSAMP1
                //STEPLIB DD DSN=WHY.JIA.LOAD,DISP=SHR
                //SYSOUT DD SYSOUT=*
                ------------------------------------------
                结果出错说找不到MODULE COBSAMP1。。。。是否WHY.JIA.LOAD在建立的时候属性设错了？
                ********************************* TOP OF DATA **********************************
                J E S 2 J O B L O G -- S Y S T E M 3 0 9 0 -- N O D E

                03.34.27 JOB02370 ---- SATURDAY, 12 FEB 2005 ----
                03.34.27 JOB02370 IRR010I USERID JIA IS ASSIGNED TO THIS JOB.
                03.34.27 JOB02370 ICH70001I JIA LAST ACCESS AT 03:34:08 ON SATURDAY, FEBRU
                03.34.27 JOB02370 $HASP373 JIAHELLO STARTED - INIT 1 - CLASS A - SYS 3090
                03.34.27 JOB02370 IEF403I JIAHELLO - STARTED - TIME=03.34.27
                03.34.27 JOB02370 IEW4007I FIND FOR MODULE COBSAMP1 FAILED BECAUSE DIRECTORY ENTRY IS NOT VALID FOR A LOAD MODULE.
                03.34.27 JOB02370 CSV003I REQUESTED MODULE COBSAMP1 NOT FOUND
                03.34.27 JOB02370 CSV028I ABEND806-04 JOBNAME=JIAHELLO STEPNAME=RUN
                03.34.27 JOB02370 IEA995I SYMPTOM DUMP OUTPUT
                SYSTEM COMPLETION CODE=806 REASON CODE=00000004
                TIME=03.34.27 SEQ=00133 CPU=0000 ASID=0017
                PSW AT TIME OF ERROR 070C1000 81123086 ILC 2 INTC 0D
                NO ACTIVE MODULE FOUND
                NAME=UNKNOWN
                DATA AT PSW 01123080 - 9F8C181C 0A0D18FB 180C181D
                GPR 0-3 00001C00 84806000 00FCBED0 00000010
                GPR 4-7 000000FF 007ECD40 00000004 0000000C
                GPR 8-11 007CB450 811225D0 011235CF 00000000
                GPR 12-15 84806000 007CB450 81123008 00000004
                END OF SYMPTOM DUMP
                03.34.27 JOB02370 IEF450I JIAHELLO RUN - ABEND=S806 U0000 REASON=00000004
                TIME=03.34.27
                03.34.27 JOB02370 IEF404I JIAHELLO - ENDED - TIME=03.34.27
                03.34.27 JOB02370 $HASP395 JIAHELLO ENDED
                0------ JES2 JOB STATISTICS ------
                - 12 FEB 2005 JOB EXECUTION DATE
                - 6 CARDS READ
                - 66 SYSOUT PRINT RECORDS
                - 0 SYSOUT PUNCH RECORDS
                - 4 SYSOUT SPOOL KBYTES
                - 0.00 MINUTES EXECUTION TIME
                1 //JIAHELLO JOB (HELLO,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1),
                // CLASS=A,NOTIFY=&SYSUID
                //***************************************************************
                IEFC653I SUBSTITUTION JCL - (HELLO,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1)
                2 //RUN EXEC PGM=COBSAMP1
                3 //STEPLIB DD DSN=WHY.JIA.LOAD,DISP=SHR
                4 //SYSOUT DD SYSOUT=*
                ICH70001I JIA LAST ACCESS AT 03:34:08 ON SATURDAY, FEBRUARY 12, 2005
                IEF236I ALLOC. FOR JIAHELLO RUN
                IGD103I SMS ALLOCATED TO DDNAME STEPLIB
                IEF237I JES2 ALLOCATED TO SYSOUT
                IEW4007I FIND FOR MODULE COBSAMP1 FAILED BECAUSE DIRECTORY ENTRY IS NOT VALID F
                CSV003I REQUESTED MODULE COBSAMP1 NOT FOUND
                CSV028I ABEND806-04 JOBNAME=JIAHELLO STEPNAME=RUN
                IEA995I SYMPTOM DUMP OUTPUT
                SYSTEM COMPLETION CODE=806 REASON CODE=00000004
                TIME=03.34.27 SEQ=00133 CPU=0000 ASID=0017
                PSW AT TIME OF ERROR 070C1000 81123086 ILC 2 INTC 0D
                NO ACTIVE MODULE FOUND
                NAME=UNKNOWN
                DATA AT PSW 01123080 - 9F8C181C 0A0D18FB 180C181D
                GPR 0-3 00001C00 84806000 00FCBED0 00000010
                GPR 4-7 000000FF 007ECD40 00000004 0000000C
                GPR 8-11 007CB450 811225D0 011235CF 00000000
                GPR 12-15 84806000 007CB450 81123008 00000004
                END OF SYMPTOM DUMP
                IEF472I JIAHELLO RUN - COMPLETION CODE - SYSTEM=806 USER=0000 REASON=00000004
                IGD104I WHY.JIA.LOAD RETAINED, DDNAME=STEPLIB
                IEF285I JIA.JIAHELLO.JOB02370.D0000101.? SYSOUT
                IEF373I STEP/RUN /START 2005043.0334
                IEF374I STEP/RUN /STOP 2005043.0334 CPU 0MIN 00.03SEC SRB 0MIN 00.00
                IEF375I JOB/JIAHELLO/START 2005043.0334
                IEF376I JOB/JIAHELLO/STOP 2005043.0334 CPU 0MIN 00.03SEC SRB 0MIN 00.00更多精彩文章及讨论，请光临枫下论坛 rolia.net
                • 刚刚忙回来。 我帮你试了一下，不错啊，另外，要用WHY.JIA.LOAD, not WHY.JIA.OBJECT. 还有，MSGCLASS 最好用H. 参照JOBCARD. -unknown2me(行者); 2005-2-11 (#2120459@0)
                  • 有个问题还想请教一下.... -thisunreal(饭得志); 2005-2-11 {789} (#2120515@0)
                    Command - Enter "/" to select action Dsorg Recfm Lrecl Blksz
                    -------------------------------------------------------------------------------
                    WHY.JIA.COBCPY1 PO FB 80 3120
                    WHY.JIA.COBOL PO FB 80 3120
                    WHY.JIA.JCL PO FB 80 3120
                    WHY.JIA.LOAD PO U 80 3120
                    WHY.JIA.LOADLIB PO FB 80 3120
                    WHY.JIA.OBJECT PO FB 80 3120

                    这里的Recfm,我建立WHY.JIA.OBJECT的时候已经设置为'U'了,为啥编译个HELLO WORLD进去后就自动变成'FB'了? 还是编译的什么地方没设置对?
                    • 这个问题我也不是很清楚，但是RECFM肯定是可以改变的。另外，如果不是大程序，我们一般将OBJECT放在临时文件中，省去OBJECT库了。你的TCP/IP telnet ports(23,1023,2023)映射好了吗？ -unknown2me(行者); 2005-2-11 (#2120556@0)
                • 帮你做了一个REXX程序， WHY.JIA.JCL(HELLO)。 -unknown2me(行者); 2005-2-11 (#2120572@0)
                  • 呵呵.那是你的强项.过几天我也来折腾一下. -scottee(笑熬浆糊); 2005-2-11 (#2120726@0)
                  • 赫赫,刚搬了几万行cobol程序上去.........这些程序最初由VSE移植到unix,现在又搬回来玩....就指望着老兄整好CICS了.......... -thisunreal(饭得志); 2005-2-12 (#2120876@0)
        • 你的连接我怎么打不开? -scottee(笑熬浆糊); 2005-2-11 (#2119591@0)
          • .... -thisunreal(饭得志); 2005-2-11 {467} (#2119622@0)
            //JIASJOBA JOB (JIACOM,JIA),JIA,MSGCLASS=H,MSGLEVEL=(1,1),
            // CLASS=A,NOTIFY=&SYSUID
            //*
            // SET MEM=COBSAMP1
            //*
            //COBS1 EXEC COB2UC,
            // PARM='MAP,APOST,NOOPT,SZ(MAX),
            // NOTERM,DATA(31),LIB,SOURCE'
            //SYSLIB DD DISP=SHR,DSN=COBOL.COB2LIB
            // DD DISP=SHR,DSN=WHY.JIA.COBCPY1
            //SYSPRINT DD SYSOUT=*
            //SYSLIN DD DISP=SHR,DSN=WHY.JIA.OBJECT(&MEM)
            //SYSIN DD DISP=SHR,DSN=WHY.JIA.COBOL(&MEM)
            //*
    • 该环境日趋完善。。。欢迎肉乐们共同研究学习，谢谢！ -thisunreal(饭得志); 2005-2-14 (#2123808@0)
    • Restart complete.....IP变了,域名不变.... -thisunreal(饭得志); 2005-2-14 {641} (#2124701@0)
      下午可能断电了,机器和router都重新启动了.....域名不变,改了个ip,赫赫
      C:\Documents and Settings\Window>ping fandezhi.homedns.org

      Pinging fandezhi.homedns.org [67.70.156.215] with 32 bytes of data:

      Reply from 67.70.156.215: bytes=32 time<1ms TTL=64
      Reply from 67.70.156.215: bytes=32 time<1ms TTL=64
      Reply from 67.70.156.215: bytes=32 time<1ms TTL=64
      Reply from 67.70.156.215: bytes=32 time<1ms TTL=64

      Ping statistics for 67.70.156.215:
      Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),
      Approximate round trip times in milli-seconds:
      Minimum = 0ms, Maximum = 0ms, Average = 0ms

      C:\Documents and Settings\Window>
    • 今天试了一下输入输出的cobol程序，发现sequential的都行，但定义为indexed的有问题。。。是否是那些文件要在ISPF里面特殊定义？呵呵，批量的东西做得少，见笑啦！ -thisunreal(饭得志); 2005-2-15 {48} (#2126403@0)
      在此要多谢‘浆糊’和‘行者’两位老兄的大力帮助！
      • 再问一些cobol上的indexed file问题？ -thisunreal(饭得志); 2005-2-15 {1302} (#2126434@0)
        本文发表在 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
        • 我们是用FileAid来看Index file的,你的系统没有这功能.告诉我你的源程序.我凭经验看一下. -scottee(笑熬浆糊); 2005-2-15 (#2126570@0)
          • SRC是JIA.COBOL.SRC(TESTINP), JCL是JIA.COBOL.JCL(RUNINP1), THX! -thisunreal(饭得志); 2005-2-15 (#2126588@0)
            • 简单地看了一下程序.有点问题.你用I-O方式打开文件的话,要求该文件至少有一条记录.看来很可能原文件为空(希望以后附上错误信息).解决方法: -scottee(笑熬浆糊); 2005-2-15 {176} (#2127016@0)
              1. 在程序里先用output方法建立一个记录.
              2. 然后关闭.
              3. 再用I-O 方式打开
              4. 你就可以自由地随意读和写了.

              当然,也可以用其他Utility加上一条记录.这里就不展开了.

              Good Luck!
              • 多谢！刚才又试了一下，迷茫中。。。 -thisunreal(饭得志); 2005-2-16 {1752} (#2127443@0)
                本文发表在 rolia.net 枫下论坛相同程序在unix下面编译执行都是对的，生成了文件和索引idx. 而在390上出错为
                A user logic error occurred. Neither FILE STATUS nor a declarative was specified for file 'UPD001' in program'TESTINP2' at relative location X'02C6'. The I-O status code was '48'.

                '48',我查对照表，意思应该是'WRITE, NOT OPEN OR NOT OPEN MODE'，是否是外面定义的那个有索引的文件JIA.DATA.VKSD0080还是有问题？ 我改了一下程序里的文件定义，写一个SEQUENTIAL的文件比如JIA.COBOL.OUTPUT(ABC)是没问题的。。。。所以我越发觉得是外面那个文件定义有问题，否则就是JCL写得不对，呵呵。

                程序很简单，大致如下
                ID DIVISION.
                PROGRAM-ID. TESTINP2.
                AUTHOR. FANDEZHI.
                DATE-WRITTEN. JUN-2004.

                ENVIRONMENT DIVISION.
                CONFIGURATION SECTION.
                SOURCE-COMPUTER. IBM-370.
                OBJECT-COMPUTER. IBM-370.
                INPUT-OUTPUT SECTION.
                FILE-CONTROL.

                SELECT CLAIMS-OUT ASSIGN TO
                UPD001
                ORGANIZATION IS INDEXED
                ACCESS IS DYNAMIC
                RECORD KEY IS REC-KEY.
                DATA DIVISION.
                FILE SECTION.

                FD CLAIMS-OUT
                LABEL RECORDS ARE STANDARD
                RECORD CONTAINS 80 CHARACTERS
                DATA RECORD CLAIMS-OUT-REC.
                01 CLAIMS-OUT-REC.
                05 REC-KEY PIC X(8).
                05 REC-CONTENT PIC X(72).

                WORKING-STORAGE SECTION.
                PROCEDURE DIVISION.
                OPEN OUTPUT CLAIMS-OUT.
                MOVE 'GHIJ' TO REC-KEY.
                MOVE 'THIS IS THE GHIJ' TO REC-CONTENT.
                WRITE CLAIMS-OUT-REC INVALID KEY
                DISPLAY 'CANNOT INPUT DUPLICATED MSG'.
                CLOSE CLAIMS-OUT.
                STOP RUN.更多精彩文章及讨论，请光临枫下论坛 rolia.net
                • 哦，呵呵，搞好了 -thisunreal(饭得志); 2005-2-16 {367} (#2127586@0)
                  刚才又试验了一下，发现原来是定义外部文件JIA.DATA.VKSD0080的键值是1-6位，而程序里定义的是1-8位，难怪会出错。现在好了。感谢浆糊的提醒！

                  相比而言，UNIX系统里的INDEX文件不需要初始定义的，哪怕程序里写的是不存在的文件，在运行的时候也会创建相应的新文件。IBM的VSAM就作得比较严，必须要先定义好文件，而且文件的KEY起始位数都要设置全对才可以访问，否则会认为INDEX文件打开错误。
    • 哈哈，忙了一个晚上，终于搞了个http://fandezhi.homedns.org:8080 -thisunreal(饭得志); 2005-2-16 (#2129188@0)
      • 我这里的中文显示有问题. -scottee(笑熬浆糊); 2005-2-16 (#2129248@0)
        • hehe,现在可以显示简体了吧 -thisunreal(饭得志); 2005-2-16 (#2129559@0)
    • CICS, DB2都起来啦！ -unknown2me(行者); 2005-2-17 {332} (#2130358@0)
      下面的软件将在IPL时候起来:
      CICS TS 1.3 (tasks: ICSPRT1, CICSPRA1, CTGATE)
      DB2 V6 (tasks: DSNA*)
      DB2 DataProp Apply and Capture, DataHub
      Host Command Facility (HCF)
      Host On Demand (HODSRV)
      Netview (NETVSSI, NETVIEW)
      Tivoli Storage Manager (TIVSM)
      TCP/IP tasks (telnet, FTP, SMTP,SNMP.)
      MQ Series (MQ*)
      Webserver (WEBSRV)
      • 老兄真是北美一巨牛！ 感谢！ 我准备把CICS和MQ的一些学习资料发布在网站8080端口上，呵呵，陈年老文档了。 -thisunreal(饭得志); 2005-2-17 (#2130417@0)
    • Shutdown 注意事项： 请一定用命令S SHUTDOWN来让系统按照次序停下来，然后用$PJES2,TERM停止JES2. 下次IPL 将不会有任何REPLY MESSAGE. -unknown2me(行者); 2005-2-17 (#2130367@0)
      • 有点小问题。。。。TSO 进不去了，主控台信息是 -thisunreal(饭得志); 2005-2-17 {108} (#2130820@0)
        *06.48.03 DEMOPKG STC03595 *ANR0110E An unexpected system date has been
        * detected; the server is disabled.
        • 我的可以啊，你用port 23试一试.你的信息是Tivoli Storage Manager(ADSM)发出的。我已经搞定。 -unknown2me(行者); 2005-2-17 (#2130830@0)
    • MQ.....error?
      -thisunreal(饭得志); 2005-2-18 (#2131936@0)
      • 哈哈，搞定MQ，测试了个Local Q -thisunreal(饭得志); 2005-3-24 (#2200351@0)
    • 想做个SIGNUP系统，挂在网页上。通过在网上登记可以创建390的用户。。。这样就不用手工创建了。。。 -thisunreal(饭得志); 2005-2-23 {407} (#2140794@0)
      因为FANDEZHI.HOMEDNS.ORG:8080的网站是用APACHE+MYSQL+PHP搭的，要加入这种功能，在不借助其他通讯软件比如MQ的情况下，是否要通过SOCKET通讯？不记得PHP有这种功能，不过CGI程序肯定有。

      就是网站那台机器写个往390这边某端口发送数据包的程序，然后390那边写个开启某个端口接收数据的程序，然后唤醒390内部的创建用户的JCL OR REXX程序？
      欢迎各位提出建议！我想写好这个功能以后应该会有很多人愿意一起上来讨论主机技术的。谢谢！
      • 这个容易，让我细细道来。 -unknown2me(行者); 2005-2-23 {898} (#2141363@0)
        中心思想： 使用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.
        • 谢谢！其实我还有另外一种想法： -thisunreal(饭得志); 2005-2-23 {507} (#2141450@0)
          390上面装有websphere的，肯定也可以起http服务到80端口。能否直接在390上开发个页面，接受注册信息，然后调用后面的JCL增加用户？ 虽然这种方法最‘不安全’，呵呵。

          以前做过的最相似的就是网上银行。前台WEB服务器接收用户输入信息，通过中间的应用服务器(AIX)计算和校验，然后调用后台(390)程序更新业务数据。这种三层架构，安全是很安全，但挺复杂的。

          有空帮忙传socket服务器端程序上去看看？我觉得发送数据包到socket是很可行的方法，思路简单，而且巨安全（390开放的某个端口，只要路由器不映射，外面无法访问，只能由我的pc访问）
      • 试一试OS390 TCP/IP Socket 通信. -unknown2me(行者); 2005-2-24 {473} (#2143108@0)
        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 命令方式执行。
    • 我私自改了TSO 登陆的LOGO. 假若你不满意，请告诉我一声。 -unknown2me(行者); 2005-2-24 (#2143534@0)
      • 哈哈！改得不错。。。。在哪个文件改的？ 今天忙了一天了，才闲下来。。。晚上准备试一下编译以前写的CICS+DB2+COBOL程序，有MAP的。。准备给CICS也搞个初始交易和联机画面 -thisunreal(饭得志); 2005-2-24 (#2143544@0)
        • CENTER.SOURCE(USSFAN) -unknown2me(行者); 2005-2-24 (#2143833@0)
    • 到国内的一些论坛宣传了一下，开始有人来学习了390。。。有个问题，如果想剪裁ISPF菜单给一般用户，一般是怎样做的？ -thisunreal(饭得志); 2005-2-25 {143} (#2144897@0)
      是否修改登陆的那些PROCEDURE, 例如'SYSUSER', 'DBAUSER'等等？
      另外就是权限的问题，我发现我建立的‘低权限’用户都有权修改其他人的源代码。。。
      • ISPF 菜单可以用剪刀来裁剪，权限可以通过我党一把手来设置！ -unknown2me(行者); 2005-2-25 {399} (#2145233@0)
        ISPF 菜单们都在**.ISPPLIB。此系统修改过的菜单在CENTER.ISPPLIB里。建议没有碰过的朋友十分小心，搞不好大家都死光光。

        权限这是一个大问题。
        1、首先所有用户都应该有自己的ALIAS，要不然所有文件都堆到Master Catalog。着需要一些MIGRATE工作。
        2、每个用户的文件定义一个dataset profile.都可以设置成下面模式：
        userid.**
        3、给该用户以ALTER权限，其他用户READ权限。
        4、剥夺一般用户的SPECIAL和OPERATIONAL权限。
        • 有没有个详细的例子,针对设立某个用户的?能截图最好 -thisunreal(饭得志); 2005-2-25 (#2146434@0)
    • 找到了以前的程序,是RS/6000上COBOL+ORACLE+CICS的,带有MAP,请问390上的样本编译JCL在哪里?包括CICS和DB2预编译器的? -thisunreal(饭得志); 2005-2-25 (#2146445@0)
      • 程序一: COBOL程序 -thisunreal(饭得志); 2005-2-25 {41293} (#2146446@0)
        本文发表在 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
        • MAPS源程序 -thisunreal(饭得志); 2005-2-25 {5740} (#2146448@0)
          本文发表在 rolia.net 枫下论坛CVMPRIM DFHMSD TYPE=&SYSPARM,LANG=COBOL,TIOAPFX=YES,MODE=INOUT, X
          CTRL=(FREEKB,FRSET),TERM=3270,DATA=FIELD
          CVMPRIM DFHMDI SIZE=(24,80),SOSI=YES,MAPATTS=(HILIGHT)
          CICSNAM DFHMDF POS=(01,01),LENGTH=08,ATTRB=(FSET,PROT)
          TERMID DFHMDF POS=(02,01),LENGTH=04,ATTRB=(FSET,PROT)
          TITLEM DFHMDF POS=(01,20),LENGTH=40,ATTRB=(PROT,FSET)
          TITLED DFHMDF POS=(02,20),LENGTH=40,ATTRB=(PROT,FSET)
          DFHMDF POS=(01,65),LENGTH=05,ATTRB=(ASKIP,BRT),INITIAL='日期:'
          PRIDATE DFHMDF POS=(01,71),LENGTH=08,ATTRB=(ASKIP)
          DFHMDF POS=(02,65),LENGTH=05,ATTRB=(ASKIP,BRT),INITIAL='时间:'
          PRITIME DFHMDF POS=(02,71),LENGTH=08,ATTRB=(ASKIP)
          DFHMDF POS=(05,01),LENGTH=10,ATTRB=(ASKIP,BRT), X
          INITIAL='表号:'
          PRITBNO DFHMDF POS=(05,11),LENGTH=10,ATTRB=(UNPROT,FSET,IC), X
          INITIAL='__________'
          DFHMDF POS=(05,22),LENGTH=01,ATTRB=(ASKIP)
          DFHMDF POS=(07,01),LENGTH=60,ATTRB=(ASKIP,BRT), X
          INITIAL='键入任选项,然后按执行键'
          DFHMDF POS=(08,03),LENGTH=70,ATTRB=(ASKIP,BRT), X
          INITIAL='2=编辑 3=复制 4=删除 5=查看'
          DFHMDF POS=(10,01),LENGTH=70,ATTRB=(ASKIP,BRT), X
          INITIAL='Opt 表号 顺序号 目标字段 说明'
          PRIOPT1 DFHMDF POS=(11,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(11,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN1 DFHMDF POS=(11,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ1 DFHMDF POS=(11,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN1 DFHMDF POS=(11,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC1 DFHMDF POS=(11,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT2 DFHMDF POS=(12,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(12,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN2 DFHMDF POS=(12,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ2 DFHMDF POS=(12,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN2 DFHMDF POS=(12,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC2 DFHMDF POS=(12,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT3 DFHMDF POS=(13,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(13,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN3 DFHMDF POS=(13,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ3 DFHMDF POS=(13,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN3 DFHMDF POS=(13,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC3 DFHMDF POS=(13,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT4 DFHMDF POS=(14,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(14,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN4 DFHMDF POS=(14,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ4 DFHMDF POS=(14,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN4 DFHMDF POS=(14,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC4 DFHMDF POS=(14,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT5 DFHMDF POS=(15,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(15,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN5 DFHMDF POS=(15,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ5 DFHMDF POS=(15,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN5 DFHMDF POS=(15,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC5 DFHMDF POS=(15,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT6 DFHMDF POS=(16,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(16,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN6 DFHMDF POS=(16,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ6 DFHMDF POS=(16,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN6 DFHMDF POS=(16,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC6 DFHMDF POS=(16,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT7 DFHMDF POS=(17,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(17,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN7 DFHMDF POS=(17,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ7 DFHMDF POS=(17,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN7 DFHMDF POS=(17,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC7 DFHMDF POS=(17,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT8 DFHMDF POS=(18,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(18,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN8 DFHMDF POS=(18,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ8 DFHMDF POS=(18,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN8 DFHMDF POS=(18,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC8 DFHMDF POS=(18,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT9 DFHMDF POS=(19,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(19,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN9 DFHMDF POS=(19,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ9 DFHMDF POS=(19,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN9 DFHMDF POS=(19,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC9 DFHMDF POS=(19,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          PRIOPT0 DFHMDF POS=(20,02),LENGTH=01,ATTRB=(UNPROT,FSET),INITIAL='_'
          DFHMDF POS=(20,04),LENGTH=01,ATTRB=(ASKIP)
          PRITBN0 DFHMDF POS=(20,08),LENGTH=10,ATTRB=(ASKIP,FSET)
          PRISEQ0 DFHMDF POS=(20,20),LENGTH=03,ATTRB=(ASKIP,FSET)
          PRITGN0 DFHMDF POS=(20,28),LENGTH=08,ATTRB=(ASKIP,FSET)
          PRIDSC0 DFHMDF POS=(20,38),LENGTH=40,ATTRB=(ASKIP,FSET)
          MESSAGE DFHMDF POS=(21,01),LENGTH=68,ATTRB=(ASKIP,BRT)
          LOCATTR DFHMDF POS=(21,70),LENGTH=8,ATTRB=(ASKIP,FSET)
          DFHMDF POS=(22,01),LENGTH=12,ATTRB=(ASKIP,BRT), X
          INITIAL=' F1=帮助'
          DFHMDF POS=(22,26),LENGTH=12,ATTRB=(ASKIP,BRT), X
          INITIAL=' F3=返回'
          DFHMDF POS=(22,53),LENGTH=12,ATTRB=(ASKIP,BRT), X
          INITIAL=' F5=刷新'
          DFHMDF POS=(22,65),LENGTH=12,ATTRB=(ASKIP,BRT), X
          INITIAL=' F6=创建'
          DFHMDF POS=(23,01),LENGTH=12,ATTRB=(ASKIP,BRT), X
          INITIAL=' F7=上页'
          DFHMDF POS=(23,13),LENGTH=12,ATTRB=(ASKIP,BRT), X
          INITIAL=' F8=下页'
          COPRIGT DFHMDF POS=(24,01),LENGTH=70,ATTRB=(ASKIP,FSET)
          DFHMSD TYPE=FINAL
          END更多精彩文章及讨论，请光临枫下论坛 rolia.net
          • AIX上的编译SCRIPT -thisunreal(饭得志); 2005-2-25 {2313} (#2146452@0)
            本文发表在 rolia.net 枫下论坛#-------------------------------------------------------------#
            # Note:This makefile is researched by why in 2001/10/10. #
            # Anyone can use it to develop his own applications. #
            # But remember,never use it without any changes! #
            #-------------------------------------------------------------#

            #-------------------------------------------------------------#
            # Part I: ENVIROMENTS #
            # (环境变量) #
            include ../_css_precomp.mk
            #-------------------------------------------------------------#

            #-------------------------------------------------------------#
            # Part II: YOUR PROGRAMS #
            # Note:Write down your maps and procob programs! #
            # (在此加入你想编译的map和cobol程序) #
            MAPS= cvmprim cvmprid
            PROCOBS= cvoprim cvoprid
            #-------------------------------------------------------------#

            #-------------------------------------------------------------#
            # Part III: MACROS #
            # #
            INSTALL= install
            CLEAN= clean
            all:$(MAPS) $(PROCOBS) $(INSTALL) $(CLEAN)
            #-------------------------------------------------------------#

            $(MAPS):
            cicsmap $@.bms

            $(PROCOBS):
            $(PROCOB) $(PROCOBFLAGS) iname=$@.pco
            mv $@.cob $@.ccp
            $(CICSTCL) -e -d -lCOBOL $@

            $(INSTALL):
            cp -f *.map $(ROOTMAPBIN)
            mv *.map $(CSSMAPBIN)
            cp -f *.gnt $(ROOTBIN)
            mv *.gnt $(CSSBIN)
            $(CLEAN):
            rm *.lis *.ccp
            -------------------------------------------------------------------------------------

            _css_precomp.mk

            #-------------------------------------------------------------#
            # Part I: ENVIROMENTS #
            # (环境变量) #
            #-------------------------------------------------------------#
            CSSPATH=/home/csskf
            CSSBIN=$(CSSPATH)/run/bin
            CSSMAPBIN=$(CSSPATH)/run/mapbin
            ROOTPATH=/home/csskf
            ROOTBIN=$(ROOTPATH)/run/bin
            ROOTMAPBIN=$(ROOTPATH)/run/mapbin
            PROCOB=$(ORACLE_HOME)/bin/procob
            PROCOBFLAGS=release_cursor=yes sqlcheck=syntax ireclen=512
            CICSTCL=cicstcl
            #-------------------------------------------------------------#更多精彩文章及讨论，请光临枫下论坛 rolia.net
    • 这两天好好搞了一下网站，因为不少小朋友不懂得访问8080端口，所以我就把80和8080端口一并映射到apache服务上；390自带的web准备映射到'88'端口，我已经在路由器上作了设置。 -thisunreal(饭得志); 2005-2-26 (#2147481@0)
    • 哈哈，有人抢注了Sailor的账号。。。 -thisunreal(饭得志); 2005-3-2 (#2153772@0)
    • 我也来up一个，我也在Mainframe os390上干了好几年，真挺怀念黑地绿字的屏幕呢 -lizpan(亚麻色的心情); 2005-3-2 (#2153790@0)
      • 老胸去注册了会员没有？ -thisunreal(饭得志); 2005-3-2 (#2153852@0)
        • 小胸弟去看看吧 -lizpan(亚麻色的心情); 2005-3-2 (#2153906@0)
          • OK,请到那边去查收用户和密码。也希望老前辈多多指教！ -thisunreal(饭得志); 2005-3-2 (#2153918@0)
    • 哈哈，测试了半天终于把CICS MAP给搞透了，看来不同平台的CICS原理都差不多 -thisunreal(饭得志); 2005-3-4 (#2158975@0)
    • 我自己再顶一下:刚写好一个hello world for CICS 给想入门CICS编程的朋友们-----有我在,大伙就不用出钱学CICS了,哈哈 -thisunreal(饭得志); 2005-3-9 (#2167598@0)
    • 哈哈，埋头苦干了2天，终于搞定了样本程序 -thisunreal(饭得志); 2005-3-24 (#2199612@0)
      • 小问题: 你的价格和汽油标号 是什么东西? 价格才8.55 ? 汽油标号 5.254? -scottee(笑熬浆糊); 2005-3-24 (#2200614@0)
        • 呵呵,多谢指正.现已调试好样本程序,有上下翻屏,增加/删除/修改/拷贝等功能 -thisunreal(饭得志); 2005-3-26 (#2204050@0)
          • 呵呵.不错 -scottee(笑熬浆糊); 2005-3-27 (#2204304@0)

More Topics

  • 脑洞大开，突发奇想，用力来传播信息
  • 看大家讨论日语，俺也正在认真学习。其实语言问题应该是很快也很容易就解决的，可能比自动驾驶来的还快。TREK里面，全宇宙的人都在大脑里安装了UNIVERSAL TRANSLATOR，外星人之间相互交流无障碍。废话少说，看视频。。。加上个MIC和耳机，不同国家的人就可以无障碍交流。
  • 肉脸真有搞 IT 的？Linux 把俄国中国伊朗踢出去了好像肉脸 IT 没啥感觉似的
  • 请问web developer和software developer技术上有什么区别？
  • Elon Musk 带着川普总统奔向火星了。
    • 枫下论坛主坛 /  工作学习 /  IT技术讨论