![[目次]](FIGURE/CONTENT.GIF)
スケーラブルデータベースサーバ HiRDB Version 8 UAP開発ガイド
![[索引]](FIGURE/INDEX.GIF)
![[前へ]](FIGURE/FRONT.GIF)
![[次へ]](FIGURE/AFTER.GIF)
COBOL言語による埋込み型UAPのプログラム例題を示します。
なお，SQLの文法の詳細については，マニュアル「HiRDB Version 8 SQLリファレンス」を参照してください。
プログラム例題4のPADチャートを図7-11〜図7-13に示します。
図7-11 プログラム例題4のPADチャート（1/3）
![[図データ]](FIGURE/ZU070302.GIF)
図7-12 プログラム例題4のPADチャート（2/3）
![[図データ]](FIGURE/ZU070303.GIF)
図7-13 プログラム例題4のPADチャート（3/3）
![[図データ]](FIGURE/ZU070304.GIF)
プログラム例題4のコーディング例を次に示します。
00010*ZAIKO KANRI PROG. 00020* 00030* 00040* ALL RIGHTS RESERVED,COPYRIGHT (C)1997 HITACHI,LTD. 00050* LICENSED MATERIAL OF HITACHI,LTD. 00060* 00070 IDENTIFICATION DIVISION. 00080 PROGRAM-ID. ECOBUAP. 00090* 00100 ENVIRONMENT DIVISION. 00110 CONFIGURATION SECTION. 00120 SOURCE-COMPUTER. HITAC. 00130 OBJECT-COMPUTER. HITAC. 00140 INPUT-OUTPUT SECTION. 00150 FILE-CONTROL. 00160 SELECT INPUT-CARD-FILE 00170 ASSIGN TO DISK 00180 ORGANIZATION IS LINE SEQUENTIAL. 00190 SELECT PRINT-ZAIKO-FILE 00200 ASSIGN TO LP. 00210* 00220 DATA DIVISION. 00230 FILE SECTION. 00240 FD INPUT-CARD-FILE 00250 DATA RECORD USER-CARD-REC I-ZAIKO-REC. 00260* 00270 01 USER-CARD-REC. 00280 02 IUSERID PIC X(20). 00290 02 IPSWD PIC X(20). 00300 02 FILLER PIC X(40). 00310* 00320 01 I-ZAIKO-REC. 00330 02 IKUBUN PIC X(1). 00340 02 FILLER PIC X(2). 00350 02 ISCODE PIC X(4). 00360 02 FILLER PIC X(2). 00370 02 ISNAME PIC N(8). 00380 02 ICOL PIC N(1). 00390 02 ITANKA PIC X(9). 00400 02 IGRYO PIC X(9). 00410 02 IIOKBN PIC X(1). 00420 02 FILLER PIC X(34). 00430* 00440 FD PRINT-ZAIKO-FILE RECORDING MODE IS F 00450 LABEL RECORD IS OMITTED 00460 DATA RECORD PRINT-ZAIKO-REC. 00470 01 PRINT-ZAIKO-REC PIC X(132). 00480* 00490 WORKING-STORAGE SECTION. 00500* 00510 EXEC SQL 1 00520 BEGIN DECLARE SECTION 1 00530 END-EXEC. 1 00540 77 XUSERID PIC X(30). 1 00550 77 XPSWD PIC X(30). 1 00560 77 XSCODE PIC X(4) VALUE '0000'. 1 00570 77 XSNAME PIC N(8). 1 00580 77 XCOL PIC N(1). 1 00590 77 XTANKA PIC S9(9) COMP. 1 00600 77 XGRYO PIC S9(9) COMP. 1 00610* INDICATOR VARIABLE 1 00620 77 XISCODE PIC S9(4) COMP VALUE 1040. 1 00630 77 XISNAME PIC S9(4) COMP VALUE 1050. 1 00640 77 XICOL PIC S9(4) COMP VALUE 1060. 1 00650 77 XITANKA PIC S9(4) COMP VALUE 1070. 1 00660 77 XIGRYO PIC S9(4) COMP VALUE 1080. 1 00670* 1 00680* 1 00690 EXEC SQL 1 00700 END DECLARE SECTION 1 00710 END-EXEC. 1 00720* 00730 01 MIDASHI-REC. 00740 02 FILLER PIC X(13) VALUE SPACE. 00750 02 FILLER PIC X(32) 00760 VALUE '****** ZAIKO TABLE LIST ******'. 00770 02 FILLER PIC X(87) VALUE SPACE. 00780* 00790 01 RETSUMEI-REC. 00800 02 FILLER PIC X(14) VALUE SPACE. 00810 02 FILLER PIC X(9) VALUE 'SCODE'. 00820 02 FILLER PIC X(16) VALUE 'SNAME'. 00830 02 FILLER PIC X(8) VALUE 'COLOR'. 00840 02 FILLER PIC X(8) VALUE 'TANKA'. 00850 02 FILLER PIC X(8) VALUE 'SURYO'. 00860 02 FILLER PIC X(69) VALUE SPACE. 00870* 00880 01 LINE-REC. 00890 02 FILLER PIC X(14) VALUE SPACE. 00900 02 FILLER PIC X(9) VALUE '----- '. 00910 02 FILLER PIC X(16) VALUE '-------- '. 00920 02 FILLER PIC X(8) VALUE '------- '. 00930 02 FILLER PIC X(8) VALUE '------- '. 00940 02 FILLER PIC X(8) VALUE '------- '. 00950 02 FILLER PIC X(69) VALUE SPACE. 00960* 00970 01 SELECT-OUT-REC. 00980 02 FILLER PIC X(14) VALUE SPACE. 00990 02 O-SCODE PIC X(5). 01000 02 FILLER PIC X(2) VALUE SPACE. 01010 02 O-KANJI CHARACTER TYPE KEIS. 01020 03 O-SNAME PIC N(8). 01030 03 FILLER PIC X(2) VALUE SPACE. 01040 03 O-COL PIC N(1). 01050 03 FILLER PIC X(6) VALUE SPACE. 01060 03 O-TANKA PIC X(8) JUST RIGHT. 01070 03 FILLER PIC X(2) VALUE SPACE. 01080 03 O-GRYO PIC X(8) JUST RIGHT. 01090 03 FILLER PIC X(69) VALUE SPACE. 01100 77 O-SCODE-NULL PIC X(5) VALUE '*****'. 01110 77 O-SNAME-NULL PIC N(8) VALUE NC'−−−−−−'. 01120 77 O-COL-NULL PIC N(1) VALUE NC'−'. 01130 77 O-TANKA-NULL PIC X(8) VALUE '********'. 01140 77 O-GRYO-NULL PIC X(8) VALUE '********'. 01150* 01160 01 I-CARD-ERROR-REC. 01170 02 FILLER PIC X(14) VALUE SPACE. 01180 02 FILLER PIC X(41) 01190 VALUE '*** ERROR *** NO CARD FOR CONNECT ***'. 01200 02 FILLER PIC X(77) VALUE SPACE. 01210* 01220 01 CONNECT-ERROR-REC. 01230 02 FILLER PIC X(14) VALUE SPACE. 01240 02 FILLER PIC X(45) 01250 VALUE '*** ERROR *** CANNOT CONNECT *** CODE = '. 01260 02 CNCT-EC PIC X(5). 01270 02 FILLER PIC X(68) VALUE SPACE. 01280* 01290 01 NORMAL-END-REC. 01300 02 FILLER PIC X(14) VALUE SPACE. 01310 02 FILLER PIC X(22) 01320 VALUE '*** NORMAL ENDED ***'. 01330 02 FILLER PIC X(96) VALUE SPACE. 01340* 01350 01 SQLERR-PRINT-REC. 01360 02 FILLER PIC X(14) VALUE SPACE. 01370 02 FILLER PIC X(34) 01380 VALUE '*** HiRDB SQL ERROR MESSAGE-ID = '. 01390 02 RC-MSGID PIC X(8). 01400 02 FILLER PIC X(14) VALUE ' SQLERRORMC ='. 01500 02 RC-SQLERRMC PIC X(62). 01510* 01520 01 WSQLCODE PIC -(10)9. 01530* 01540 01 WMSGID. 01550 02 FILLER PIC X(8). 01560 02 MSGID PIC X(3). 01570* 01580 01 ERRORMSGID. 01590 02 FILLER PIC X(5) VALUE 'KFPA1'. 01600 02 E-MSGID PIC X(4). 01610 02 FILLER PIC X(2) VALUE '-E'. 01620* 01630 01 EOF PIC X(1) VALUE '0'. 01640 01 ERR-FLG PIC X(1) VALUE '0'. 01650* 01660* 01670 PROCEDURE DIVISION. 01680 MAIN SECTION. 01690 M-1. 01700 OPEN INPUT INPUT-CARD-FILE 01710 OUTPUT PRINT-ZAIKO-FILE. 01720 READ INPUT-CARD-FILE 01730 AT END 01740 MOVE '1' TO ERR-FLG 01750 GO TO M-3 01760 END-READ. 01770 MOVE IUSERID TO XUSERID. 01780 MOVE IPSWD TO XPSWD. 01790* 01800 EXEC SQL (a) 2 01810 WHENEVER SQLERROR (a) 2 01820 GO TO M-2 (a) 2 01830 END-EXEC. (a) 2 01840 EXEC SQL (b) 2 01850 CONNECT USER :XUSERID USING :XPSWD (b) 2 01860 END-EXEC. (b) 2 01870 PERFORM HENKOU. 01880 GO TO M-3. 01890 M-2. 01900 MOVE '2' TO ERR-FLG. 01910* 01920 M-3. 01930 EVALUATE ERR-FLG 01940 WHEN '0' 01950 PERFORM FUTSUU 01960 WHEN '1' 01970 WRITE PRINT-ZAIKO-REC 01980 FROM I-CARD-ERROR-REC 01990 AFTER ADVANCING 2 LINES 02000 WHEN '2' 02010 MOVE SQLCODE TO CNCT-EC 02020 WRITE PRINT-ZAIKO-REC 02030 FROM CONNECT-ERROR-REC 02040 AFTER ADVANCING 2 LINES 02050 WHEN '3' 02060 PERFORM IJYOU 02070 END-EVALUATE. 02080 M-4. 02090 CLOSE INPUT-CARD-FILE 02100 PRINT-ZAIKO-FILE. 02110 M-EX. 02120 EXEC SQL 02130 WHENEVER SQLERROR CONTINUE 02140 END-EXEC. 02150 EXEC SQL 02160 WHENEVER NOT FOUND CONTINUE 02170 END-EXEC 02180 EXEC SQL 02190 WHENEVER SQLWARNING CONTINUE 02200 END-EXEC. 02210 EXEC SQL 02220 DISCONNECT 02230 END-EXEC. 02240 GOBACK. 02250 HENKOU SECTION. 02260 H-1. 02270 READ INPUT-CARD-FILE 02280 AT END 02290 MOVE '1' TO ERR-FLG 02300 END-READ. 02310 EXEC SQL 02320 WHENEVER SQLERROR 02330 GO TO H-2 02340 END-EXEC. 02350 PERFORM UNTIL EOF = '1' OR ERR-FLG NOT = '0' 02360 EVALUATE IKUBUN 02370 WHEN 'I' 02380 PERFORM TSUIKA 02390 WHEN 'U' 02400 PERFORM KOUSHIN 02410 WHEN 'D' 02420 PERFORM SAKUJO 02430 END-EVALUATE 02440 READ INPUT-CARD-FILE 02450 AT END 02460 MOVE '1' TO EOF 02470 END-READ 02480 END-PERFORM. 02490 GO TO H-EX. 02500 H-2. 02510 MOVE '3' TO ERR-FLG. 02520 H-EX. 02530 EXIT. 02540* 02550 TSUIKA SECTION. 02560 T-1. 02570 MOVE ISCODE TO XSCODE. 02580 MOVE ISNAME TO XSNAME. 02590 MOVE ICOL TO XCOL. 02600 MOVE ITANKA TO XTANKA. 02610 MOVE IGRYO TO XGRYO. 02620 EXEC SQL 02610 WHENEVER SQLERROR GO TO T-2 02620 END-EXEC. 02630 EXEC SQL 3 02640 INSERT INTO ZAIKO(SCODE, SNAME, COL, TANKA, ZSURYO) 3 02650 VALUES(:XSCODE, :XSNAME, :XCOL, :XTANKA, :XGRYO) 3 02660 END-EXEC. 3 02670 GO TO T-EX. 02680 T-2. 02690 MOVE '3' TO ERR-FLG. 02700 T-EX. 02710 EXIT. 02720 KOUSHIN SECTION. 02730 K-1. 02740 MOVE ISCODE TO XSCODE. 02750 MOVE IGRYO TO XGRYO. 02760 EXEC SQL 02770 WHENEVER SQLERROR GO TO K-2 02780 END-EXEC. 02790 EVALUATE IIOKBN 02800 WHEN '1' 4 02810 EXEC SQL (a) 4 02820 UPDATE ZAIKO SET ZSURYO = ZSURYO + :XGRYO (a) 4 02830 WHERE SCODE=:XSCODE (a) 4 02840 END-EXEC (a) 4 02850 WHEN '2' 4 02860 EXEC SQL (b) 4 02870 UPDATE ZAIKO SET ZSURYO = ZSURYO - :XGRYO (b) 4 02880 WHERE SCODE=:XSCODE (b) 4 02890 END-EXEC (b) 4 02900 END-EVALUATE. 02910 GO TO K-EX. 02920 K-2. 02930 MOVE '3' TO ERR-FLG. 02940 K-EX. 02950 EXIT. 02960* 02970 SAKUJO SECTION. 02980 S-1. 02990 MOVE ISCODE TO XSCODE. 03010 EXEC SQL 03020 WHENEVER SQLERROR GO TO S-2 03030 END-EXEC. 03040 EXEC SQL 5 03050 DELETE FROM ZAIKO 5 03060 WHERE SCODE=:XSCODE 5 03070 END-EXEC. 5 03080 GO TO S-EX. 03090 S-2. 03100 MOVE '3' TO ERR-FLG. 03110 S-EX. 03120 EXIT. 03130* 03140 FUTSUU SECTION. 03150 F-0. 03160 WRITE PRINT-ZAIKO-REC 03170 FROM MIDASHI-REC 03180 AFTER ADVANCING 4 LINES. 03190 WRITE PRINT-ZAIKO-REC 03200 FROM RETSUMEI-REC 03210 AFTER ADVANCING 2 LINES. 03220 WRITE PRINT-ZAIKO-REC 03230 FROM LINE-REC 03240 AFTER ADVANCING 2 LINES. 03250 F-1. 03260 EXEC SQL 03270 WHENEVER SQLERROR GO TO F-4 03280 END-EXEC. 03290 EXEC SQL (a) 6 03300 DECLARE CR1 CURSOR FOR (a) 6 03310 SELECT SCODE,SNAME,COL,TANKA,ZSURYO FROM ZAIKO (a) 6 03320 END-EXEC. (a) 6 03330 EXEC SQL (b) 6 03340 OPEN CR1 (b) 6 03350 END-EXEC. (b) 6 03360 F-2. 03370 EXEC SQL (a) 7 03380 WHENEVER NOT FOUND (a) 7 03390 GO TO F-3 (a) 7 03400 END-EXEC. (a) 7 03410 EXEC SQL (b) 7 03420 FETCH CR1 (b) 7 03430 INTO :XSCODE:XISCODE, :XSNAME:XISNAME, (b) 7 03440 :XCOL:XICOL, :XTANKA:XITANKA, :XGRYO:XIGRYO (b) 7 03450 END-EXEC. (b) 7 03460 EXEC SQL 03470 WHENEVER NOT FOUND 03480 CONTINUE 03490 END-EXEC. 03500 IF XISCODE IS >= 0 THEN 03510 MOVE XSCODE TO O-SCODE 03520 ELSE 03530 MOVE O-SCODE-NULL TO O-SCODE 03540 END-IF. 03550 IF XISNAME IS >= 0 THEN 03560 MOVE XSNAME TO O-SNAME 03570 ELSE 03580 MOVE O-SNAME-NULL TO O-SNAME 03590 END-IF. 03600 IF XICOL IS >= 0 THEN 03610 MOVE XCOL TO O-COL 03620 ELSE 03630 MOVE O-COL-NULL TO O-COL 03640 END-IF. 03650 IF XITANKA IS >= 0 THEN 03660 MOVE XTANKA TO O-TANKA 03670 ELSE 03680 MOVE O-TANKA-NULL TO O-TANKA 03690 END-IF. 03700 IF XIGRYO IS >= 0 THEN 03710 MOVE XGRYO TO O-GRYO 03720 ELSE 03730 MOVE O-GRYO-NULL TO O-GRYO 03740 END-IF. 03750 WRITE PRINT-ZAIKO-REC 03760 FROM SELECT-OUT-REC 03770 AFTER ADVANCING 2 LINES. 03780 GO TO F-2. 03790 F-3. 03800 EXEC SQL 03810 WHENEVER SQLERROR CONTINUE 03820 END-EXEC. 03830 EXEC SQL 03840 WHENEVER NOT FOUND CONTINUE 03850 END-EXEC 03860 EXEC SQL 03870 WHENEVER SQLWARNING CONTINUE 03880 END-EXEC. 03890 EXEC SQL (a) 8 03900 CLOSE CR1 (a) 8 03910 END-EXEC. (a) 8 03920* 03930 EXEC SQL (b) 8 03940 COMMIT (b) 8 03950 END-EXEC. (b) 8 03960* 03970 WRITE PRINT-ZAIKO-REC 03980 FROM NORMAL-END-REC 03990 AFTER ADVANCING 2 LINES. 04000 GO TO F-EX. 04010 F-4. 04020 PERFORM IJYOU. 04030 F-EX. 04040 EXIT. 04050 IJYOU SECTION. 04060 I-1. 04070 MOVE SQLCODE TO WSQLCODE. 04080 MOVE WSQLCODE TO WMSGID. 04090 MOVE MSGID TO E-MSGID. 04100 MOVE ERRORMSGID TO RC-MSGID. 04110 MOVE SQLERRMC TO RC-SQLERRMC. 04120 WRITE PRINT-ZAIKO-REC 04130 FROM SQLERR-PRINT-REC 04140 AFTER ADVANCING 2 LINES. 04150 EXEC SQL (a) 9 04160 WHENEVER SQLERROR CONTINUE (a) 9 04170 END-EXEC. (a) 9 04180 EXEC SQL (a) 9 04190 WHENEVER NOT FOUND CONTINUE (a) 9 04200 END-EXEC. (a) 9 04210 EXEC SQL (a) 9 04220 WHENEVER SQLWARNING CONTINUE (a) 9 04230 END-EXEC. (a) 9 04240 EXEC SQL (b) 9 04250 ROLLBACK (b) 9 04260 END-EXEC. (b) 9 04270 I-EX. 04280 EXIT.
プログラム例題5のPADチャートを図7-14〜図7-17に示します。
図7-14 プログラム例題5のPADチャート（1/4）
![[図データ]](FIGURE/ZU070305.GIF)
図7-15 プログラム例題5のPADチャート（2/4）
![[図データ]](FIGURE/ZU070306.GIF)
図7-16 プログラム例題5のPADチャート（3/4）
![[図データ]](FIGURE/ZU070307.GIF)
図7-17 プログラム例題5のPADチャート（4/4）
![[図データ]](FIGURE/ZU070308.GIF)
00010***************************************************************
00020* *
00030* 埋込み型SQL COBOL UAP *
00040* ROW インタフェースサンプル *
00050* 1997/11/27 *
00060***************************************************************
00070 IDENTIFICATION DIVISION.
00080 PROGRAM-ID. ROW-SAMPLE.
00090 AUTHOR. CLIENT.
00100 DATA-WRITTEN. 1997/11/27.
00110 DATA-COMPILED. ROW-SAMPLE.
00120 REMARKS.
00130*
00140 ENVIRONMENT DIVISION.
00150 CONFIGURATION SECTION.
00160 SOURCE-COMPUTER. HITAC.
00170 OBJECT-COMPUTER. HITAC.
00180 INPUT-OUTPUT SECTION.
00190 FILE-CONTROL.
00200 SELECT OUTLIST ASSIGN TO LP.
00210*
00220 DATA DIVISION.
00230 FILE SECTION.
00240 FD OUTLIST RECORDING MODE IS F
00250 LABEL RECORD IS OMITTED
00260 DATA RECORD OUTREC.
00270 01 OUTREC PIC X(80).
00280*
00290 WORKING-STORAGE SECTION.
00300 EXEC SQL
00310 BEGIN DECLARE SECTION
00320 END-EXEC.
00330 01 IN-REC1 IS GLOBAL.
00340 02 IN-CHR1 PIC X(15) VALUE 'EVA-00'.
00350 02 IN-INT1 PIC S9(9) COMP VALUE 255.
00360 02 IN-INT2 PIC S9(9) COMP VALUE 1.
00370
00380 01 XSQLROW IS GLOBAL. 1
00390 02 ROW-CHR1 PIC X(30). 1
00400 02 ROW-INT1 PIC S9(9) COMP. 1
00410 02 ROW-INT2 PIC S9(9) COMP. 1
00420
00430 EXEC SQL
00440 END DECLARE SECTION
00450 END-EXEC.
00460
00470 01 DISP-REC IS GLOBAL.
00480 02 DISP-CHR1 PIC X(15).
00490 02 DISP-INT1 PIC S9(9).
00500 02 DISP-INT2 PIC S9(4).
00510 01 ERRFLG PIC S9(4) COMP IS GLOBAL.
00520
00530 01 MSG-ERR PIC X(10) VALUE '!! ERROR'.
00540 01 MSG-CODE IS GLOBAL.
00550 02 FILLER PIC X(15) VALUE '!! SQLCODE ='.
00560 02 MSG-SQLCODE PIC S9(9) DISPLAY.
00570 01 MSG-MC IS GLOBAL.
00580 02 FILLER PIC X(15) VALUE '!! SQLERRMC ='.
00590 02 MSG-SQLERRMC PIC X(100).
00600
00610 PROCEDURE DIVISION.
00620**********************************************
00630* DISPLAY TITLE
00640**********************************************
00650 MAIN SECTION.
00660 CALL 'DISPLAY-TITLE'.
00670 MOVE ZERO TO ERRFLG.
00680
00690**********************************************
00700* CONNECT
00710**********************************************
00720 EXEC SQL
00730 WHENEVER SQLERROR GOTO ERR-EXIT
00740 END-EXEC
00750
00760 DISPLAY '***** CONNECT '.
00770 EXEC SQL 2
00780 CONNECT 2
00790 END-EXEC. 2
00800 DISPLAY '***** CONNECT : END'.
00810
00820*********************************************************
00830* INIT
00840*********************************************************
00850 DISPLAY '## テーブルの初期化を行います'.
00860 CALL 'INIT-TABLE'.
00870 IF ERRFLG < ZERO
00880 GO TO ERR-EXIT
00890 END-IF
00900 DISPLAY '## 正常です'.
00910
00920*********************************************************
00930* INSERT
00940*********************************************************
00950 DISPLAY '## DATAをINSERT'.
00960 CALL 'TEST-INSERT'.
00970 IF ERRFLG < ZERO
00980 GO TO ERR-EXIT
00990 END-IF
01000 DISPLAY '## 正常です'.
01010
01020*********************************************************
01030* ROW
01040*********************************************************
01050 DISPLAY '## ROW型のテストを行います'.
01060 CALL 'TEST-ROW'.
01070 IF ERRFLG < ZERO
01080 GO TO ERR-EXIT
01090 END-IF
01100 DISPLAY '## 正常です'.
01110
01120*********************************************************
01130* DISCONNECT
01140*********************************************************
01150 ERR-EXIT.
01160 IF SQLCODE < ZERO
01170 MOVE SQLCODE TO MSG-SQLCODE
01180 MOVE SQLERRMC TO MSG-SQLERRMC
01190 DISPLAY MSG-ERR
01200 DISPLAY MSG-CODE
01210 DISPLAY MSG-MC
01220 MOVE -1 TO ERRFLG
01230 END-IF
01240
01250 EXEC SQL
01260 WHENEVER SQLERROR CONTINUE
01270 END-EXEC
01280 EXEC SQL
01290 WHENEVER NOT FOUND CONTINUE
01300 END-EXEC
01310 EXEC SQL
01320 WHENEVER SQLWARNING CONTINUE
01330 END-EXEC
01340
01350 DISPLAY '##DISCONNECT'
01360
01370 EXEC SQL 3
01380 DISCONNECT 3
01390 END-EXEC 3
01400 STOP RUN.
01410
01420************************************************************
01430* INSERT文のテスト
01440************************************************************
01450 IDENTIFICATION DIVISION.
01460 PROGRAM-ID. TEST-INSERT.
01470 DATA DIVISION.
01480 WORKING-STORAGE SECTION.
01490 01 DCNT PIC S9(9) COMP.
01500 PROCEDURE DIVISION.
01510 EXEC SQL
01520 WHENEVER SQLERROR GOTO :Exit-Test-Insert
01530 END-EXEC.
01540*********************************************************
01550* INSERT HOST
01560*********************************************************
01570 DISPLAY '***** 埋込み変数によるINSERT start'
01580 MOVE ZERO TO DCNT.
01590 INSERT-LOOP.
01600 COMPUTE IN-INT1 = DCNT
01610 COMPUTE IN-INT2 = DCNT + 100
01620 COMPUTE DCNT = DCNT + 1
01630 EXEC SQL 4
01640 INSERT INTO TT1(CLM1, 4
01650 CLM2, 4
01660 CLM3) 4
01670 VALUES (:IN-CHR1, 4
01680 :IN-INT1, 4
01690 :IN-INT2) 4
01700 END-EXEC 4
01710 IF DCNT < 20 THEN
01720 GO TO INSERT-LOOP
01730 END-IF
01740 DISPLAY '***** insert : SUCCESS'.
01750*********************************************************
01760*
01770*********************************************************
01780 EXIT-TEST-INSERT.
01790 IF SQLCODE < ZERO
01800 MOVE SQLCODE TO MSG-SQLCODE
01810 MOVE SQLERRMC TO MSG-SQLERRMC
01820 DISPLAY MSG-CODE
01830 DISPLAY MSG-MC
01840 MOVE -1 TO ERRFLG
01850 END-IF
01860 DISPLAY '>> TEST-INSERT <<'
01870 GOBACK.
01880******************************************************
01890* WARNING
01900******************************************************
01910 INSERT-WARNING.
01920 DISPLAY 'WARINING'
01930 MOVE SQLCODE TO MSG-SQLCODE
01940 MOVE SQLERRMC TO MSG-SQLERRMC
01950 DISPLAY MSG-CODE
01960 DISPLAY MSG-MC.
01970 END PROGRAM TEST-INSERT.
01980
01990******************************************************
02000* ROWのテスト
02010******************************************************
02020 IDENTIFICATION DIVISION.
02030 PROGRAM-ID. TEST-ROW.
02040 DATA DIVISION.
02050 WORKING-STORAGE SECTION.
02060 PROCEDURE DIVISION.
02070 DISPLAY '***** ROW CURSOR OPEN'
02080 EXEC SQL 5
02090 DECLARE CUR_ROW CURSOR FOR 5
02100 SELECT ROW FROM TT1 5
02110 WHERE CLM2 = 10 5
02120 FOR UPDATE OF CLM3 5
02130 END-EXEC 5
02140******************************************************
02150* ROW CURSOR
02160******************************************************
02170 DISPLAY '***** ROW CURSOR OPEN'.
02180 EXEC SQL
02190 WHENEVER SQLERROR GOTO :Exit-Test-ROW
02200 END-EXEC
02210 EXEC SQL 6
02220 OPEN CUR_ROW 6
02230 END-EXEC 6
02240
02250******************************************************
02260* FETCH ROW CURSOR
02270******************************************************
02280 DISPLAY '***** ROW CURSOR FETCH'
02290 EXEC SQL
02300 WHENEVER NOT FOUND GOTO :Exit-Test-ROW
02310 END-EXEC
02320 EXEC SQL
02330 WHENEVER SQLERROR GOTO :Exit-Test-ROW
02340 END-EXEC
02350 MOVE SPACE TO XSQLROW
02360 EXEC SQL 7
02370 FETCH CUR_ROW INTO :XSQLROW 7
02380 END-EXEC 7
02390 DISPLAY '## FETCH DATA'
02400 MOVE ROW-CHR1 TO DISP-CHR1
02410 MOVE ROW-INT1 TO DISP-INT1
02420 MOVE ROW-INT2 TO DISP-INT2
02430 DISPLAY DISP-REC
02440
02450 DISPLAY '***** ROW UPDATE'
02460 MOVE 'ANGEL' TO ROW-CHR1
02470 EXEC SQL 8
02480 UPDATE TT1 SET ROW = :XSQLROW 8
02490 WHERE CURRENT OF CUR_ROW 8
02500 END-EXEC 8
02510
02520******************************************************
02530* FETCH ROW CURSOR
02540******************************************************
02550 DISPLAY '***** ROW CURSOR CLOSE'
02560 EXEC SQL
02570 WHENEVER NOT FOUND CONTINUE
02580 END-EXEC
02590 EXEC SQL
02600 WHENEVER SQLERROR CONTINUE
02610 END-EXEC
02620 EXEC SQL 9
02630 CLOSE CUR_ROW 9
02640 END-EXEC. 9
02650******************************************************
02660*
02670******************************************************
02680 EXIT-TEST-ROW.
02690 IF SQLCODE < ZERO THEN
02700 MOVE SQLCODE TO MSG-SQLCODE
02710 MOVE SQLERRMC TO MSG-SQLERRMC
02720 DISPLAY MSG-CODE
02730 DISPLAY MSG-MC
02740 MOVE -1 TO ERRFLG
02750 END-IF
02760 EXEC SQL
02770 WHENEVER NOT FOUND CONTINUE
02780 END-EXEC
02790 EXEC SQL
02800 WHENEVER SQLERROR CONTINUE
02810 END-EXEC
02820 EXEC SQL
02830 COMMIT
02840 END-EXEC
02850 DISPLAY '>> TEST-ROW END <<'
02860 GOBACK.
02870
02880******************************************************
02890* WARNING
02900******************************************************
02910 ROW-WARNING.
02920 DISPLAY 'WARINING'
02930 MOVE SQLCODE TO MSG-SQLCODE
02940 MOVE SQLERRMC TO MSG-SQLERRMC
02950 DISPLAY MSG-CODE
02960 DISPLAY MSG-MC.
02970 END PROGRAM TEST-ROW.
02980
02990
03000 *****************************************************
03010 * テーブルの初期化
03020 *****************************************************
03030 IDENTIFICATION DIVISION.
03040 PROGRAM-ID. INIT-TABLE.
03050 DATA DIVISION.
03060 WORKING-STORAGE SECTION.
03070 PROCEDURE DIVISION.
03080 EXEC SQL
03090 WHENEVER SQLERROR CONTINUE
03100 END-EXEC
03110
03120*****************************************************
03130* DROP TABLE
03140*****************************************************
03150 DISPLAY '***** DROP TABLE'.
03160 EXEC SQL 10
03170 DROP TABLE TT1 10
03180 END-EXEC 10
03190 DISPLAY '***** CREATE SCHEMA'.
03200 EXEC SQL 11
03210 CREATE SCHEMA 11
03220 END-EXEC 11
03230
03240*********************************************************
03250* COMMIT
03260*********************************************************
03270 DISPLAY '***** COMMIT START'.
03280 EXEC SQL
03290 WHENEVER SQLERROR GOTO EXIT-INIT-TABLE
03300 END-EXEC
03310 EXEC SQL
03320 COMMIT
03330 END-EXEC
03340 DISPLAY '***** COMMIT : END'.
03350
03360*********************************************************
03370* CREATE TABLE
03380*********************************************************
03390 DISPLAY '***** create table'.
03400 EXEC SQL 12
03410 CREATE FIX TABLE TT1(CLM1 CHAR(30), 12
03420 CLM2 INTEGER, 12
03430 CLM3 INTEGER) 12
03440 END-EXEC 12
03450
03460 DISPLAY '***** create table : SUCCESS'.
03470
03480******************************************************
03490*
03500******************************************************
03510 EXIT-INIT-TABLE.
03520 IF SQLCODE < ZERO THEN
03530 MOVE SQLCODE TO MSG-SQLCODE
03540 MOVE SQLERRMC TO MSG-SQLERRMC
03550 DISPLAY MSG-CODE
03560 DISPLAY MSG-MC
03570 MOVE -1 TO ERRFLG
03580 END-IF
03590 GOBACK.
03600
03610******************************************************
03620* WARNING
03630******************************************************
03640 INIT-TABLE-WARNING.
03650 DISPLAY 'WARINING'
03660 MOVE SQLCODE TO MSG-SQLCODE
03670 MOVE SQLERRMC TO MSG-SQLERRMC
03680 DISPLAY MSG-CODE
03690 DISPLAY MSG-MC.
03700 END PROGRAM INIT-TABLE.
03710
03720******************************************************
03730* DISPLAY
03740******************************************************
03750 IDENTIFICATION DIVISION.
03760 PROGRAM-ID. DISPLAY-TITLE.
03770 DATA DIVISION.
03780 WORKING-STORAGE SECTION.
03790 PROCEDURE DIVISION.
03800 DISPLAY '##############################################'
03810 DISPLAY '# #'
03820 DISPLAY '# このプログラムはROW型インタフェースの #'
03830 DISPLAY '# サンプルプログラムです #'
03840 DISPLAY '# #'
03850 DISPLAY '##############################################'.
03860 END PROGRAM DISPLAY-TITLE.
03870 END PROGRAM ROW-SAMPLE.
TYPE句，TYPEDEF句，及びSAME AS句を使用したコーディング例を次に示します。
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. CBL001. 000300 DATA DIVISION. 000400 WORKING-STORAGE SECTION. 000500 EXEC SQL BEGIN DECLARE SECTION END-EXEC. 000600* -- type declaration -- 000700 01 VCHR20 TYPEDEF. 000800 05 LEN PIC S9(4) COMP. 000900 05 STR PIC X(20). 001000 001100* -- data declaration -- 001200 01 D-4C. 001300 05 XCUT TYPE VCHR20. 001400 05 XCOLOR PIC X(10). 001500 05 XCLARITY SAME AS XCOLOR. 001600 05 XCARAT PIC S9(4) COMP. 001700 001800 EXEC SQL END DECLARE SECTION END-EXEC. : : : : 002000 PROCEDURE DIVISION. 002100 CB_001 SECTION. : : : : 003400 INS-1. 003500 EXEC SQL 003600 INSERT INTO A_DIM (C1, C2, C3, C4) 003700 VALUES (:XCUT, :XCOLOR, :XCLARITY, :XCARAT) 003800 END-EXEC. : : : : 005000 INS-EX. 005100 EXIT. 005200 END PROGRAM CBL001.
All Rights Reserved. Copyright (C) 2006, 2016, Hitachi, Ltd.