2001/07/20版
| 当バージョンでは 運賃データをPostgreSQLとしました。(PostgreSQL7.1.1使用) PostgreSQLとのインターフェイスはTinycobolのtest.codeディレクトリのtdb02.cobの方法を そのまま利用しております。 (tdb02a.cというC言語のプログラムでインターフェイスを取っています。) 今回は見た目(GUIの部分)は変わりなしです。 開発環境 Red Hat 7.1 Tinycobol-0.54 |
|
![]() |
GUIの部分は以前と変わり無しです。 Red Hat7.1になったので Tcl/Tkのバージョンが 変わりました。 tcl-8.3.1 tk-8.3.1です。 実行はPostgreSQLのユーザでXにログインし実行させます。 postmasterを起動させれば あとは今まで通り./unchin.tclで実行可能です。 |
![]() |
データベース名 unchin テーブル名 yamato 列名 サイズがsizeでinteger 発地がhatでinteger 着地がchkでinteger 運賃がuncnでinteger 以下 作成方法を簡単に説明します。 1.unchinデータベース作成 $createdb unchin 2.yamatoテーブル作成 $psql unchin unchin=> CREATE TABLE yamato (size integer,hat integer,chk integer,uncn integer); |
|
![]() |
左のログはPoatgreSQLにデータを登録するCOBOLプログラム(test01.cob)を実行させた時のログです。 前回までのyamato.cobのワーク部分オンコーディングテーブルを順番にINSERTする プログラムです。 実行方法は以下です。 postmasterを起動しpostgreSQLのユーザにてtest01を実行する。 |
|
![]() |
上記で登録した後 SELECT分で内容を表示させてログです。 左からサイズ・発地・着地・運賃です。 初地と着地は以前までのyamato.cobの名残で地域を数字で表しています。 |
|
以下にソースを紹介いたします。 |
||
まずはCOBOLでyamato.cobです。 赤字の部分がpostgreSQL関係で、紫の部分がCのプログラムをCALLしている個所です。 IDENTIFICATION DIVISION. PROGRAM-ID. YAMATO. ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 01 WK-OUT PIC X(20). 01 CMDLINE-PARMS PIC X(64). 01 WK-PRONAME PIC X(10) VALUE '$$$$$$$$$$'. 01 WK-ACC01 PIC X(15) VALUE '$$$$$$$$$$$$$$$'. 01 WK-ACC02 PIC X(15) VALUE '$$$$$$$$$$$$$$$'. 01 WK-ACC03 PIC X(15) VALUE '$$$$$$$$$$$$$$$'. 01 WK-ACC04 PIC X(15) VALUE '$$$$$$$$$$$$$$$'. 01 WK-ACC05 PIC X(02) VALUE '$$'. 01 WK-ACC06 PIC X(02) VALUE '$$'. 01 A PIC X(15). 01 C PIC S9(12)V9(3). 01 JSW PIC 9. 01 WK-KWKKA. 03 WK-TATE PIC S9(06)V9(3). 03 WK-YOKO PIC S9(06)V9(3). 03 WK-TAKA PIC S9(06)V9(3). 03 WK-OMOS PIC S9(06)V9(3). 01 WK-SIZE1 PIC S9(06)V9(3). 01 WK-SIZE2 PIC S9(06)V9(3). 01 WK-SIZE PIC 9(03). 01 WK-3HEN PIC S9(06)V9(3). 01 WK-DKIN PIC ZZ,ZZZ,ZZ9. 01 WK-OUT PIC X(10). 01 I PIC 9(3). 01 J PIC 9(3). 01 WK-INDEXH PIC 9(3). 01 WK-INDEXC PIC 9(3). 77 DATABASE-NAME PIC X(80). 77 SQL-QUERY PIC X(200). 77 DB-HANDLE PIC 9(12) COMP. 77 QRY-HANDLE PIC 9(12) COMP. 77 NTUPLE PIC 9(12) COMP. 77 NFIELD PIC 9(12) COMP. 77 MAX-TUPLE PIC 9(12) COMP. 77 MAX-FIELD PIC 9(12) COMP. 77 COLUMN-VALUE PIC X(80) VALUE SPACES. 77 CMD PIC 9. 77 DB-STATUS PIC 9(12) COMP. 77 DB-MESSAGE Pic X(200). 01 MYTBL-RECORD PIC X(15). 01 WK-TBL. 03 WK-TBLVALUE. 05 FILLER PIC X(48) VALUE "010202020303030404040404040404050506060607070707". 05 FILLER PIC X(46) VALUE "0606060606060909090909101010101111111111111112". 03 WK-CHIKITBL REDEFINES WK-TBLVALUE. 05 WK-CHIKI PIC 9(02) OCCURS 47. * PROCEDURE DIVISION. A-000. ACCEPT CMDLINE-PARMS FROM COMMAND-LINE. UNSTRING CMDLINE-PARMS DELIMITED BY ' ' INTO WK-PRONAME WK-ACC01 WK-ACC02 WK-ACC03 WK-ACC04 WK-ACC05 WK-ACC06. ** 縦 ** MOVE WK-ACC01 TO A. MOVE ZERO TO C. CALL "SUBX" USING A C JSW. MOVE C TO WK-TATE. ** 横 ** MOVE WK-ACC02 TO A. MOVE ZERO TO C. CALL "SUBX" USING A C JSW. MOVE C TO WK-YOKO. ** 高さ ** MOVE WK-ACC03 TO A. MOVE ZERO TO C. CALL "SUBX" USING A C JSW. MOVE C TO WK-TAKA. ** 重量 ** MOVE WK-ACC04 TO A. MOVE ZERO TO C. CALL "SUBX" USING A C JSW. MOVE C TO WK-OMOS. ** 発地 ** MOVE WK-ACC05 TO WK-INDEXH. ** 着地 ** MOVE WK-ACC06 TO WK-INDEXC. * ** サイズチェック ** COMPUTE WK-3HEN = WK-TATE + WK-YOKO + WK-TAKA. IF WK-3HEN NOT > 60 MOVE 60 TO WK-SIZE1 ELSE IF WK-3HEN NOT > 80 MOVE 80 TO WK-SIZE1 ELSE IF WK-3HEN NOT > 100 MOVE 100 TO WK-SIZE1 ELSE IF WK-3HEN NOT > 120 MOVE 120 TO WK-SIZE1 ELSE IF WK-3HEN NOT > 140 MOVE 140 TO WK-SIZE1 ELSE IF WK-3HEN NOT > 160 MOVE 160 TO WK-SIZE1 ELSE MOVE "サイズ オーバー" TO WK-OUT GO TO A-999. * IF WK-OMOS NOT > 2000 MOVE 60 TO WK-SIZE2 ELSE IF WK-OMOS NOT > 5000 MOVE 80 TO WK-SIZE2 ELSE IF WK-OMOS NOT > 10000 MOVE 100 TO WK-SIZE ELSE IF WK-OMOS NOT > 15000 MOVE 120 TO WK-SIZE2 ELSE IF WK-OMOS NOT > 20000 MOVE 140 TO WK-SIZE2 ELSE IF WK-OMOS NOT > 25000 MOVE 160 TO WK-SIZE2 ELSE MOVE "重量 オーバー" TO WK-OUT GO TO A-999. * IF WK-SIZE1 > WK-SIZE2 MOVE WK-SIZE1 TO WK-SIZE ELSE MOVE WK-SIZE2 TO WK-SIZE. * *---- FROM INDEX SET ----* COMPUTE WK-INDEXH = WK-INDEXH + 1. MOVE WK-CHIKI(WK-INDEXH) TO I. *---- TO INDEX SET ----* COMPUTE WK-INDEXC = WK-INDEXC + 1. MOVE WK-CHIKI(WK-INDEXC) TO J. * * *---- DB CONNECT ----* MOVE "unchin" TO DATABASE-NAME. CALL "sql_connect_db" USING DATABASE-NAME DB-HANDLE DB-STATUS. IF DB-STATUS NOT = ZEROS DISPLAY "Error in database connection!" STOP RUN. * *---- DB SELECT ----* STRING "select uncn from yamato where size = " WK-SIZE " and hat = " I " and chk = " J " ;;" INTO SQL-QUERY. * CALL "sql_exec_query" USING DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. IF (DB-STATUS NOT = 1 AND DB-STATUS NOT = 2) MOVE SPACES TO DB-MESSAGE CALL "sql_status_message" USING DB-HANDLE DB-MESSAGE DISPLAY DB-MESSAGE. * CALL "sql_max_tuple" USING QRY-HANDLE MAX-TUPLE. CALL "sql_max_field" USING QRY-HANDLE MAX-FIELD. MOVE ZERO TO NTUPLE PERFORM UNTIL NTUPLE = MAX-TUPLE CALL "sql_get_tuple" USING QRY-HANDLE NTUPLE MYTBL-RECORD ADD 1 TO NTUPLE END-PERFORM. * CALL "sql_clear_query" USING QRY-HANDLE. * *---- DB DISCONNECT ----* CALL "sql_disconnect_db" USING DB-HANDLE. * ** 縦 ** MOVE MYTBL-RECORD TO A. MOVE ZERO TO C. CALL "SUBX" USING A C JSW. MOVE C TO WK-DKIN. MOVE WK-DKIN TO WK-OUT. A-999. DISPLAY WK-OUT. EXIT-PROGRAM. |
||
| データ作成用のCOBOLプログラム test01.cobです。 IDENTIFICATION DIVISION. PROGRAM-ID. TEST01. ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 01 I PIC 9(2). 01 J PIC 9(2). 01 WT-TBL. 03 WT-60DAT. 05 WT-60DAT1 PIC X(48) VALUE "074009501050116011601260126014701580168017901890". 05 WT-60DAT2 PIC X(48) VALUE "095007400740084008400950095010501160126013701580". 05 WT-60DAT3 PIC X(48) VALUE "105007400740074007400840084009501160126013701470". 05 WT-60DAT4 PIC X(48) VALUE "116008400740074007400740074008400950105011601260". 05 WT-60DAT5 PIC X(48) VALUE "116008400740074007400740074008400950105011601370". 05 WT-60DAT6 PIC X(48) VALUE "126009500840074007400740074007400840095009501260". 05 WT-60DAT7 PIC X(48) VALUE "126009500840074007400740074007400840095009501370". 05 WT-60DAT8 PIC X(48) VALUE "126009500840074007400740074007400840095009501370". 05 WT-60DAT9 PIC X(48) VALUE "158011601160095009500840084007400740084007401260". 05 WT-60DAT10 PIC X(48) VALUE "168012601260105010500950095008400840074008401260". 05 WT-60DAT11 PIC X(48) VALUE "179013701370116011600950095008400740084007401160". 05 WT-60DAT12 PIC X(48) VALUE "189015801470126013701260137012601260126011600740". 03 WT-60TBL. 05 WT-60TBLX OCCURS 12. 07 WT-60KIN PIC 9(04) OCCURS 12. 01 WT-80. 03 WT-80DAT. 05 WT-80DAT1 PIC X(48) VALUE "095011601260137013701470147016801790189020002420". 05 WT-80DAT2 PIC X(48) VALUE "116009500950105010501160116012601370147015802100". 05 WT-80DAT3 PIC X(48) VALUE "126009500950095009501050105011601370147015802000". 05 WT-80DAT4 PIC X(48) VALUE "137010500950095009500950095010501160126013701790". 05 WT-80DAT5 PIC X(48) VALUE "137010500950095009500950095010501160126013701890". 05 WT-80DAT6 PIC X(48) VALUE "147011601050095009500950095009501050116011601790". 05 WT-80DAT7 PIC X(48) VALUE "147011601050095009500950095009501050116011601890". 05 WT-80DAT8 PIC X(48) VALUE "168012601160105010500950095009500950105010501790". 05 WT-80DAT9 PIC X(48) VALUE "179013701370116011601050105009500950105009501790". 05 WT-80DAT10 PIC X(48) VALUE "189014701470126012601160116010501050095010501790". 05 WT-80DAT11 PIC X(48) VALUE "200015801580137013701160116010500950105009501680". 05 WT-80DAT12 PIC X(48) VALUE "242021002000179018901790189017901790179016800950". 03 WT-80TBL. 05 WT-80TBLX OCCURS 12. 07 WT-80KIN PIC 9(04) OCCURS 12. 01 WT-100. 03 WT-100DAT. 05 WT-100DAT1 PIC X(48) VALUE "116013701470158015801680168018902000210022102940". 05 WT-100DAT2 PIC X(48) VALUE "137011601160126012601370137014701580168017902630". 05 WT-100DAT3 PIC X(48) VALUE "147011601160116011601260126013701580168017902520". 05 WT-100DAT4 PIC X(48) VALUE "158012601160116011601160116012601370147015802310". 05 WT-100DAT5 PIC X(48) VALUE "158012601160116011601160116012601370147015802420". 05 WT-100DAT6 PIC X(48) VALUE "168013701260116011601160116011601260137013702310". 05 WT-100DAT7 PIC X(48) VALUE "168013701260116011601160116011601260137013702420". 05 WT-100DAT8 PIC X(48) VALUE "189014701370126012601160116011601160126012602310". 05 WT-100DAT9 PIC X(48) VALUE "200015801580137013701260126011601160126011602310". 05 WT-100DAT10 PIC X(48) VALUE "210016801680147014701370137012601260116012602310". 05 WT-100DAT11 PIC X(48) VALUE "221017901790158015801370137012601160126011602210". 05 WT-100DAT12 PIC X(48) VALUE "294026302520231024202310242023102310231022101160". 03 WT-100TBL. 05 WT-100TBL1 PIC 9(04) OCCURS 12. 07 WT-100KIN PIC 9(04) OCCURS 12. 01 WT-120. 03 WT-120DAT. 05 WT-120DAT1 PIC X(48) VALUE "137015801680179017901890189021002210231024203470". 05 WT-120DAT2 PIC X(48) VALUE "158013701370147014701580158016801790189020003150". 05 WT-120DAT3 PIC X(48) VALUE "168013701370137013701470147015801790189020003050". 05 WT-120DAT4 PIC X(48) VALUE "179014701370137013701370137014701580168017902840". 05 WT-120DAT5 PIC X(48) VALUE "179014701370137013701370137014701580168017902940". 05 WT-120DAT6 PIC X(48) VALUE "189015801470137013701370137013701470158015802840". 05 WT-120DAT7 PIC X(48) VALUE "189015801470137013701370137013701470158015802940". 05 WT-120DAT8 PIC X(48) VALUE "210016801580147014701370137013701370147014702840". 05 WT-120DAT9 PIC X(48) VALUE "221017901790158015801470147013701370147013702840". 05 WT-120DAT10 PIC X(48) VALUE "231018901890168016801580158014701470137014702840". 05 WT-120DAT11 PIC X(48) VALUE "242020002000179017901580158014701370147013702730". 05 WT-120DAT12 PIC X(48) VALUE "347031503050284029402840294028402840284027301370". 03 WT-120TBL. 05 WT-120TBL1 PIC 9(04) OCCURS 12. 07 WT-120KIN PIC 9(04) OCCURS 12. 01 WT-140. 03 WT-140DAT. 05 WT-140DAT1 PIC X(48) VALUE "158017901890200020002100210023102420252026303990". 05 WT-140DAT2 PIC X(48) VALUE "179015801580168016801790179018902000210022103680". 05 WT-140DAT3 PIC X(48) VALUE "189015801580158015801680168017902000210022103570". 05 WT-140DAT4 PIC X(48) VALUE "200016801580158015801580158016801790189020003360". 05 WT-140DAT5 PIC X(48) VALUE "200016801580158015801580158016801790189020003470". 05 WT-140DAT6 PIC X(48) VALUE "210017901680158015801580158015801680179017903360". 05 WT-140DAT7 PIC X(48) VALUE "210017901680158015801580158015801680179017903470". 05 WT-140DAT8 PIC X(48) VALUE "231018901790168016801580158015801580168016803360". 05 WT-140DAT9 PIC X(48) VALUE "242020002000179017901680168015801580168015803360". 05 WT-140DAT10 PIC X(48) VALUE "252021002100189018901790179016801680158016803360". 05 WT-140DAT11 PIC X(48) VALUE "263022102210200020001790179016801580168015803260". 05 WT-140DAT12 PIC X(48) VALUE "399036803570336034703360347033603360336032601580". 03 WT-140TBL. 05 WT-140TBL1 PIC 9(04) OCCURS 12. 07 WT-140KIN PIC 9(04) OCCURS 12. 01 WT-160. 03 WT-160DAT. 05 WT-160DAT1 PIC X(48) VALUE "179020002100221022102310231025202630273028404520". 05 WT-160DAT2 PIC X(48) VALUE "200017901790189018902000200021002210231024204200". 05 WT-160DAT3 PIC X(48) VALUE "210017901790179017901890189020002210231024204100". 05 WT-160DAT4 PIC X(48) VALUE "221018901790179017901790179018902000210022103890". 05 WT-160DAT5 PIC X(48) VALUE "221018901790179017901790179018902000210022103990". 05 WT-160DAT6 PIC X(48) VALUE "231020001890179017901790179017901890200020003890". 05 WT-160DAT7 PIC X(48) VALUE "231020001890179017901790179017901890200020003990". 05 WT-160DAT8 PIC X(48) VALUE "252021002000189018901790179017901790189018903890". 05 WT-160DAT9 PIC X(48) VALUE "263022102210200020001890189017901790189017903890". 05 WT-160DAT10 PIC X(48) VALUE "273023102310210021002000200018901890179018903890". 05 WT-160DAT11 PIC X(48) VALUE "284024202420221022102000200018901790189017903780". 05 WT-160DAT12 PIC X(48) VALUE "452042004100389039903890399038903890389037801790". 03 WT-160TBL. 05 WT-160TBL1 PIC 9(04) OCCURS 12. 07 WT-160KIN PIC 9(04) OCCURS 12. 77 DATABASE-NAME PIC X(80). 77 SQL-QUERY PIC X(200). 77 DB-HANDLE PIC 9(12) COMP. 77 DB-STATUS PIC 9(12) COMP. 77 DB-MESSAGE PIC X(80) COMP. 77 QRY-HANDLE PIC 9(12) COMP. 01 WK-INSERT. 03 WK-INS01 PIC X(28) VALUE "INSERT INTO yamato VALUES (". 03 WK-INS02 PIC 9(03). 03 WK-INS03 PIC X(01) VALUE ",". 03 WK-INS04 PIC 9(02). 03 WK-INS05 PIC X(01) VALUE ",". 03 WK-INS06 PIC 9(02). 03 WK-INS07 PIC X(01) VALUE ",". 03 WK-INS08 PIC 9(04). 03 WK-INS09 PIC X(03) VALUE ");;". PROCEDURE DIVISION. A-000. MOVE "unchin" to DATABASE-NAME. CALL "sql_connect_db" USING DATABASE-NAME DB-HANDLE DB-STATUS. IF DB-STATUS not = zeros display "Error in database connection!" stop run. MOVE WT-60DAT TO WT-60TBL. MOVE WT-80DAT TO WT-80TBL. MOVE WT-100DAT TO WT-100TBL. MOVE WT-120DAT TO WT-120TBL. MOVE WT-140DAT TO WT-140TBL. MOVE WT-160DAT TO WT-160TBL. MOVE 0 TO I. MOVE 1 TO J. A-010. ADD 1 TO I. IF I > 12 MOVE 1 TO I ADD 1 TO J. IF J > 12 GO TO A-020. MOVE 60 TO WK-INS02. MOVE J TO WK-INS04. MOVE I TO WK-INS06. MOVE WT-60KIN(J I) TO WK-INS08. MOVE WK-INSERT TO SQL-QUERY. DISPLAY SQL-QUERY. call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. * display "DB-STATUS = " DB-STATUS. if (DB-STATUS not = 1 and DB-STATUS not = 2) move spaces to DB-MESSAGE call "sql_status_message" using DB-HANDLE DB-MESSAGE display DB-MESSAGE. GO TO A-010. A-020. MOVE 0 TO I. MOVE 1 TO J. A-030. ADD 1 TO I. IF I > 12 MOVE 1 TO I ADD 1 TO J. IF J > 12 GO TO A-040. MOVE 80 TO WK-INS02. MOVE J TO WK-INS04. MOVE I TO WK-INS06. MOVE WT-80KIN(J I) TO WK-INS08. MOVE WK-INSERT TO SQL-QUERY. DISPLAY SQL-QUERY. call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. * display "DB-STATUS = " DB-STATUS. if (DB-STATUS not = 1 and DB-STATUS not = 2) move spaces to DB-MESSAGE call "sql_status_message" using DB-HANDLE DB-MESSAGE display DB-MESSAGE. GO TO A-030. A-040. MOVE 0 TO I. MOVE 1 TO J. A-050. ADD 1 TO I. IF I > 12 MOVE 1 TO I ADD 1 TO J. IF J > 12 GO TO A-060. MOVE 100 TO WK-INS02. MOVE J TO WK-INS04. MOVE I TO WK-INS06. MOVE WT-100KIN(J I) TO WK-INS08. MOVE WK-INSERT TO SQL-QUERY. DISPLAY SQL-QUERY. call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. * display "DB-STATUS = " DB-STATUS. if (DB-STATUS not = 1 and DB-STATUS not = 2) move spaces to DB-MESSAGE call "sql_status_message" using DB-HANDLE DB-MESSAGE display DB-MESSAGE. GO TO A-050. A-060. MOVE 0 TO I. MOVE 1 TO J. A-070. ADD 1 TO I. IF I > 12 MOVE 1 TO I ADD 1 TO J. IF J > 12 GO TO A-080. MOVE 120 TO WK-INS02. MOVE J TO WK-INS04. MOVE I TO WK-INS06. MOVE WT-120KIN(J I) TO WK-INS08. MOVE WK-INSERT TO SQL-QUERY. DISPLAY SQL-QUERY. call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. * display "DB-STATUS = " DB-STATUS. if (DB-STATUS not = 1 and DB-STATUS not = 2) move spaces to DB-MESSAGE call "sql_status_message" using DB-HANDLE DB-MESSAGE display DB-MESSAGE. GO TO A-070. A-080. MOVE 0 TO I. MOVE 1 TO J. A-090. ADD 1 TO I. IF I > 12 MOVE 1 TO I ADD 1 TO J. IF J > 12 GO TO A-100. MOVE 140 TO WK-INS02. MOVE J TO WK-INS04. MOVE I TO WK-INS06. MOVE WT-140KIN(J I) TO WK-INS08. MOVE WK-INSERT TO SQL-QUERY. DISPLAY SQL-QUERY. call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. * display "DB-STATUS = " DB-STATUS. if (DB-STATUS not = 1 and DB-STATUS not = 2) move spaces to DB-MESSAGE call "sql_status_message" using DB-HANDLE DB-MESSAGE display DB-MESSAGE. GO TO A-090. A-100. MOVE 0 TO I. MOVE 1 TO J. A-110. ADD 1 TO I. IF I > 12 MOVE 1 TO I ADD 1 TO J. IF J > 12 GO TO A-999. MOVE 160 TO WK-INS02. MOVE J TO WK-INS04. MOVE I TO WK-INS06. MOVE WT-160KIN(J I) TO WK-INS08. MOVE WK-INSERT TO SQL-QUERY. DISPLAY SQL-QUERY. call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS. * display "DB-STATUS = " DB-STATUS. if (DB-STATUS not = 1 and DB-STATUS not = 2) move spaces to DB-MESSAGE call "sql_status_message" using DB-HANDLE DB-MESSAGE display DB-MESSAGE. GO TO A-110. A-999. call "sql_disconnect_db" using DB-HANDLE. stop run. |
Tcl/Tkは今回変わり無しですので省略致します。 |