5.4.1 CUPとSPPの作成
「3.3.1 CUPとSPPの作成」に示すCUPとSPPの構成例の，CUPをCOBOL言語で作成した場合のコーディング例を次に示します。
000010 * 000020 ************************************************** 000030 * CUPサンプルプログラム * 000040 ************************************************** 000050 * 000060 IDENTIFICATION DIVISION. 000070 PROGRAM-ID. CUP01. 000080 * 000090 ************************************************** 000100 * データ領域の設定 * 000110 ************************************************** 000120 * 000130 DATA DIVISION. 000140 WORKING-STORAGE SECTION. 000150 01 DCCLS-CLTIN-ARG. 000160 02 DCCLS-CLTIN-REQUEST PIC X(8) VALUE 'CLTIN '. 000170 02 DCCLS-CLTIN-STATUS-CODE PIC X(5). 000180 02 FILLER PIC X(3). 000190 02 DCCLS-CLTIN-FLAGS PIC S9(9) COMP VALUE ZERO. 000200 02 DCCLS-CLTIN-T-HOST PIC X(64). 000210 02 DCCLS-CLTIN-LOGNAME PIC X(16). 000220 02 DCCLS-CLTIN-PASSWD PIC X(16). 000230 02 DCCLS-CLTIN-S-HOST PIC X(64). 000240 02 DCCLS-CLTIN-HWND PIC 9(4) COMP. 000250 02 FILLER PIC X(2). 000260 02 DCCLS-CLTIN-CLTID PIC 9(18) COMP. 000270 02 DCCLS-CLTIN-DEFPATH PIC X(256). 000280 * 000290 01 DCCLS-CLTOUT-ARG. 000300 02 DCCLS-CLTOUT-REQUEST PIC X(8) VALUE 'CLTOUT '. 000310 02 DCCLS-CLTOUT-STATUS-CODE PIC X(5). 000320 02 FILLER PIC X(3). 000330 02 DCCLS-CLTOUT-FLAGS PIC S9(9) COMP VALUE ZERO. 000340 02 FILLER PIC X(4). 000350 02 DCCLS-CLTOUT-CLTID PIC 9(18) COMP. 000360 * 000370 01 DCRPS-OPEN-ARG1. 000380 02 DCRPS-OPEN-REQUEST PIC X(8) VALUE 'OPEN '. 000390 02 DCRPS-OPEN-STATUS-CODE PIC X(5). 000400 02 FILLER PIC X(3). 000410 02 DCRPS-OPEN-FLAGS PIC S9(9) COMP VALUE ZERO. 000420 02 FILLER PIC X(4). 000430 02 DCRPS-OPEN-CLTID PIC 9(18) COMP. 000440 * 000450 01 DCRPS-OPEN-ARG2. 000460 02 FILLER PIC X(1). 000470 * 000480 01 DCRPS-OPEN-ARG3. 000490 02 FILLER PIC X(1). 000500 * 000510 01 DCRPS-CALL-ARG1. 000520 02 DCRPS-CALL-REQUEST PIC X(8) VALUE 'CALL '. 000530 02 DCRPS-CALL-STATUS-CODE PIC X(5). 000540 02 FILLER PIC X(3). 000550 02 DCRPS-CALL-FLAGS PIC S9(9) COMP VALUE ZERO. 000560 02 DCRPS-CALL-DESCRIPTER PIC S9(9) COMP. 000570 02 DCRPS-CALL-SVGROUP PIC X(32). 000580 02 DCRPS-CALL-SVNAME PIC X(32). 000590 02 DCRPS-CALL-CLTID PIC 9(18) COMP. 000600 * 000610 01 DCRPS-CALL-ARG2. 000620 02 DCRPS-CALL-INDATALEN PIC S9(9) COMP. 000630 02 DCRPS-CALL-INDATA PIC X(512). 000640 * 000650 01 DCRPS-CALL-ARG3. 000660 02 DCRPS-CALL-OUTDATALEN PIC S9(9) COMP. 000670 02 DCRPS-CALL-OUTDATA PIC X(512). 000680 * 000690 01 DCRPS-CLOSE-ARG1. 000700 02 DCRPS-CLOSE-REQUEST PIC X(8) VALUE 'CLOSE '. 000710 02 DCRPS-CLOSE-STATUS-CODE PIC X(5). 000720 02 FILLER PIC X(3). 000730 02 DCRPS-CLOSE-FLAGS PIC S9(9) COMP VALUE ZERO. 000740 02 FILLER PIC X(4). 000750 02 DCRPS-CLOSE-CLTID PIC 9(18) COMP. 000760 * 000770 01 DCRPS-CLOSE-ARG2. 000780 02 FILLER PIC X(1). 000790 * 000800 01 DCRPS-CLOSE-ARG3. 000810 02 FILLER PIC X(1). 000820 * 000830 77 FOREVER-FLAG PIC 9 COMP VALUE ZERO. 000840 77 INDATA PIC X(512) VALUE SPACE. 000850 * 000860 ************************************************** 000870 * CUPの開始 * 000880 ************************************************** 000890 PROCEDURE DIVISION. 000900 MAIN SECTION. 000910 PROG-START. 000920 * 000930 ************************************************** 000940 * クライアントユーザの認証要求 * 000950 ************************************************** 000960 MOVE 'CLTIN ' TO DCCLS-CLTIN-REQUEST IN DCCLS-CLTIN-ARG. 000970 MOVE ZERO TO DCCLS-CLTIN-FLAGS IN DCCLS-CLTIN-ARG. 000980 MOVE SPACE TO DCCLS-CLTIN-T-HOST IN DCCLS-CLTIN-ARG. 000990 MOVE 'user01' TO DCCLS-CLTIN-LOGNAME IN DCCLS-CLTIN-ARG. 001000 MOVE 'puser01' TO DCCLS-CLTIN-PASSWD IN DCCLS-CLTIN-ARG. 001010 MOVE ZERO TO DCCLS-CLTIN-HWND IN DCCLS-CLTIN-ARG. 001020 MOVE SPACE TO DCCLS-CLTIN-DEFPATH IN DCCLS-CLTIN-ARG. 001030 * 001040 * ******************************* 001050 CALL 'CBLDCCLS' USING DCCLS-CLTIN-ARG. 001060 * ******************************* 001070 IF DCCLS-CLTIN-STATUS-CODE 001080 IN DCCLS-CLTIN-ARG NOT = '00000' 001090 THEN 001100 DISPLAY 'CUP01: CBLDCCLS(CLTIN)に失敗しました。CODE=' 001110 DCCLS-CLTIN-STATUS-CODE IN DCCLS-CLTIN-ARG 001120 GO TO PROG-EXIT 001130 END-IF. 001140 * 001150 ************************************************** 001160 * RPC-OPEN(RPC環境の初期設定) * 001170 ************************************************** 001180 MOVE 'OPEN ' TO 001190 DCRPS-OPEN-REQUEST IN DCRPS-OPEN-ARG1. 001200 MOVE ZERO TO 001210 DCRPS-OPEN-FLAGS IN DCRPS-OPEN-ARG1. 001220 MOVE DCCLS-CLTIN-CLTID IN DCCLS-CLTIN-ARG TO 001230 DCRPS-OPEN-CLTID IN DCRPS-OPEN-ARG1. 001240 * 001250 * ******************************* 001260 CALL 'CBLDCRPS' USING DCRPS-OPEN-ARG1 001270 DCRPS-OPEN-ARG2 DCRPS-OPEN-ARG3. 001280 * ******************************* 001290 IF DCRPS-OPEN-STATUS-CODE IN DCRPS-OPEN-ARG1 001300 NOT = '00000' 001310 THEN 001320 DISPLAY 'CUP01: CBLDCRPS(OPEN)に失敗しました。CODE=' 001330 DCRPS-OPEN-STATUS-CODE IN DCRPS-OPEN-ARG1 001340 GO TO PROG-END 001350 END-IF. 001360 * 001370 PERFORM UNTIL FOREVER-FLAG NOT = ZERO 001380 DISPLAY '****** 伝言板メニュー ******' 001390 DISPLAY '伝言の取り出し .... [1]' 001400 '伝言の書き込み .... [2]' 001410 DISPLAY '終了 .............. [9]' 001420 DISPLAY '番号を入力して下さい。=>' 001430 ACCEPT INDATA 001440 EVALUATE INDATA 001450 WHEN '1' 001460 * 001470 * ********************************************* 001480 * * RPC-CALL(RPCの実行) * 001490 * ********************************************* 001500 MOVE 'CALL ' TO 001510 DCRPS-CALL-REQUEST IN DCRPS-CALL-ARG1 001520 MOVE ZERO TO 001530 DCRPS-CALL-FLAGS IN DCRPS-CALL-ARG1 001540 MOVE 'spp01' TO 001550 DCRPS-CALL-SVGROUP IN DCRPS-CALL-ARG1 001560 MOVE 'get' TO 001570 DCRPS-CALL-SVNAME IN DCRPS-CALL-ARG1 001580 MOVE DCCLS-CLTIN-CLTID IN DCCLS-CLTIN-ARG TO 001590 DCRPS-CALL-CLTID IN DCRPS-CALL-ARG1 001600 MOVE 'cup01 ' TO 001610 DCRPS-CALL-INDATA IN DCRPS-CALL-ARG2 001620 MOVE 512 TO 001630 DCRPS-CALL-INDATALEN IN DCRPS-CALL-ARG2 001640 MOVE SPACE TO 001650 DCRPS-CALL-OUTDATA IN DCRPS-CALL-ARG3 001660 MOVE 512 TO 001670 DCRPS-CALL-OUTDATALEN IN DCRPS-CALL-ARG3 001680 * 001690 * ************************************************** 001700 CALL 'CBLDCRPS' USING DCRPS-CALL-ARG1 001710 DCRPS-CALL-ARG2 DCRPS-CALL-ARG3 001720 * ************************************************** 001730 IF DCRPS-CALL-STATUS-CODE IN DCRPS-CALL-ARG1 001740 NOT = '00000' 001750 THEN 001760 DISPLAY 'CUP01: CBLDCRPS(CALL)に失敗しました。CODE=' 001770 DCRPS-CALL-STATUS-CODE IN DCRPS-CALL-ARG1 001780 GO TO PROG-END 001790 END-IF 001800 DISPLAY '伝言板の内容: ' DCRPS-CALL-OUTDATA 001810 IN DCRPS-CALL-ARG3 001820 WHEN '2' 001830 DISPLAY '伝言を入力して下さい =>' 001840 ACCEPT INDATA 001850 IF INDATA = SPACE 001860 THEN 001870 MOVE '伝言はありません。' TO INDATA 001880 END-IF 001890 * 001900 * ********************************************* 001910 * * RPC-CALL(RPCの実行) * 001920 * ********************************************* 001930 MOVE 'CALL ' TO 001940 DCRPS-CALL-REQUEST IN DCRPS-CALL-ARG1 001950 MOVE ZERO TO 001960 DCRPS-CALL-FLAGS IN DCRPS-CALL-ARG1 001970 MOVE 'spp01' TO 001980 DCRPS-CALL-SVGROUP IN DCRPS-CALL-ARG1 001990 MOVE 'put' TO 002000 DCRPS-CALL-SVNAME IN DCRPS-CALL-ARG1 002010 MOVE DCCLS-CLTIN-CLTID IN DCCLS-CLTIN-ARG TO 002020 DCRPS-CALL-CLTID IN DCRPS-CALL-ARG1 002030 MOVE INDATA TO 002040 DCRPS-CALL-INDATA IN DCRPS-CALL-ARG2 002050 MOVE 512 TO 002060 DCRPS-CALL-INDATALEN IN DCRPS-CALL-ARG2 002070 MOVE SPACE TO 002080 DCRPS-CALL-OUTDATA IN DCRPS-CALL-ARG3 002090 MOVE 512 TO 002100 DCRPS-CALL-OUTDATALEN IN DCRPS-CALL-ARG3 002110 002120 * 002130 * ************************************************** 002140 CALL 'CBLDCRPS' USING DCRPS-CALL-ARG1 002150 DCRPS-CALL-ARG2 DCRPS-CALL-ARG3 002160 * ************************************************** 002170 IF DCRPS-CALL-STATUS-CODE IN DCRPS-CALL-ARG1 002180 NOT = '00000' 002190 THEN 002200 DISPLAY 'CUP01: CBLDCRPS(CALL)に失敗しました。CODE=' 002210 DCRPS-CALL-STATUS-CODE IN DCRPS-CALL-ARG1 002220 GO TO PROG-END 002230 END-IF 002240 DISPLAY DCRPS-CALL-OUTDATA IN DCRPS-CALL-ARG3 002250 WHEN '9' 002260 GO TO PROG-END 002270 WHEN OTHER 002280 CONTINUE 002290 END-EVALUATE 002300 END-PERFORM. 002310 PROG-END. 002320 * 002330 ************************************************** 002340 * RPC-CLOSE(RPC環境の解除) * 002350 ************************************************** 002360 MOVE 'CLOSE ' TO 002370 DCRPS-CLOSE-REQUEST IN DCRPS-CLOSE-ARG1. 002380 MOVE ZERO TO 002390 DCRPS-CLOSE-FLAGS IN DCRPS-CLOSE-ARG1. 002400 MOVE DCCLS-CLTIN-CLTID IN DCCLS-CLTIN-ARG TO 002410 DCRPS-CLOSE-CLTID IN DCRPS-CLOSE-ARG1. 002420 * 002430 * ******************************* 002440 CALL 'CBLDCRPS' USING DCRPS-CLOSE-ARG1. 002450 * ******************************* 002460 PROG-EXIT. 002470 MOVE 'CLTOUT ' TO 002480 DCCLS-CLTOUT-REQUEST IN DCCLS-CLTOUT-ARG. 002490 MOVE ZERO TO 002500 DCCLS-CLTOUT-FLAGS IN DCCLS-CLTOUT-ARG. 002510 MOVE DCCLS-CLTIN-CLTID IN DCCLS-CLTIN-ARG TO 002520 DCCLS-CLTOUT-CLTID IN DCCLS-CLTOUT-ARG. 002530 * 002540 * ******************************* 002550 CALL 'CBLDCCLS' USING DCCLS-CLTOUT-ARG. 002560 * ******************************* 002570 STOP RUN. 002580 * 002590 MAIN-EXIT SECTION. 002600 EXIT.