000010******************************************************************
000020*
000030*  RANDAM - 世界各地のダムをランダムに表示する
000040*  $Id: randam.cbl,v 1.7 2008/01/15 12:26:16 nzawa Exp nzawa $
000050*
000060******************************************************************
000070 IDENTIFICATION                  DIVISION.
000080 PROGRAM-ID.                     RANDAM.
000090 ENVIRONMENT                     DIVISION.
000100 INPUT-OUTPUT                    SECTION.
000110 FILE-CONTROL.
000120     SELECT  DAMDB
000130             ASSIGN        TO  'dam.db'
000140             ORGANIZATION  IS  LINE SEQUENTIAL.
000150 DATA                            DIVISION.
000160 FILE                            SECTION.
000170 FD  DAMDB.
000180 01  DAMDB-REC                   PIC  X(300).
000190******************************************************************
000200*  作業領域定義
000210******************************************************************
000220 WORKING-STORAGE                 SECTION.
000230 01  ST-FILE-STATUS.
000240   03  ST-DAMDB                  PIC  9(001)   VALUE ZERO.
000250*
000260 01  CT-COUNTER.
000270   03  CT-DAMDB                  PIC  9(003)   VALUE ZERO.
000280*
000290 01  DAMTBL.
000300   03  FILLER  OCCURS  999.
000310     05  DAMTBL-REC              PIC  X(300)   VALUE SPACE.
000320*
000330 01  DAMITEMS.
000340   03  DAM-NAME-KJ               PIC  X(055)   VALUE SPACE.
000350   03  DAM-NAME-KN               PIC  X(055)   VALUE SPACE.
000360   03  DAM-LINK-KJ               PIC  X(055)   VALUE SPACE.
000370   03  DAM-LINK-URI              PIC  X(155)   VALUE SPACE.
000380*
000390 01  DAMDISPLAY.
000400   03  DAMDISP                   PIC  X(305)   VALUE SPACE.
000410   03  ENDPOS                    PIC  9(003)   VALUE ZERO.
000420*
000430 01  WK-TIME.
000440   03  FILLER                    PIC  9(002)   VALUE ZERO.
000450   03  FILLER                    PIC  9(002)   VALUE ZERO.
000460   03  FILLER                    PIC  9(002)   VALUE ZERO.
000470   03  WK-SEED                   PIC  9(002)   VALUE ZERO.
000480*
000490 01  RND-IF.
000500   03  RND-MAX                   PIC  9(003)   VALUE ZERO.
000510   03  RND-RET                   PIC  9(003)   VALUE ZERO.
000520*
000530 PROCEDURE                       DIVISION.
000540******************************************************************
000550*  主処理
000560******************************************************************
000570 MAIN-RTN                        SECTION.
000580     PERFORM  INIT-RTN.
000590     PERFORM  DAMD-RTN.
000600     STOP RUN.
000610******************************************************************
000620*  前処理
000630******************************************************************
000640 INIT-RTN                        SECTION.
000650     OPEN  INPUT  DAMDB.
000660     PERFORM  UNTIL  ST-DAMDB  =  1  OR  CT-DAMDB  =  999
000670       READ  DAMDB
000680             AT END
000690                     MOVE  1          TO  ST-DAMDB
000700         NOT AT END
000710                     ADD   1          TO  CT-DAMDB
000720                     MOVE  DAMDB-REC  TO  DAMTBL-REC (CT-DAMDB)
000730       END-READ
000740     END-PERFORM.
000750     CLOSE  DAMDB.
000760******************************************************************
000770*  ダムを表示
000780******************************************************************
000790 DAMD-RTN                        SECTION.
000800     MOVE     CT-DAMDB  TO    RND-MAX.
000810     ACCEPT   WK-TIME   FROM  TIME.
000820     COMPUTE  RND-RET = FUNCTION RANDOM (WK-SEED) * RND-MAX + 1.
000830     DISPLAY  'Content-Type: text/plain; charset=UTF-8'.
000840     DISPLAY  ''.
000850     IF ( CT-DAMDB = 0 ) THEN
000860       DISPLAY  '表示できる'
000870                'ダムがありません！'
000880     ELSE
000890       UNSTRING  DAMTBL-REC (RND-RET)  DELIMITED  BY  X'09'
000900                 INTO  DAM-NAME-KJ  DAM-NAME-KN
000910                       DAM-LINK-KJ  DAM-LINK-URI
000920       END-UNSTRING
000930       STRING
000940         '<p>'            DELIMITED BY SIZE
000950         DAM-NAME-KJ      DELIMITED BY X'2020202020'
000960         '（'             DELIMITED BY SIZE
000970         DAM-NAME-KN      DELIMITED BY X'2020202020'
000980         '）'             DELIMITED BY SIZE
000990         'を '            DELIMITED BY SIZE
001000         '<a href="'      DELIMITED BY SIZE
001010         DAM-LINK-URI     DELIMITED BY X'2020202020'
001020         '">'             DELIMITED BY SIZE
001030         DAM-LINK-KJ      DELIMITED BY X'2020202020'
001040         '</a>'           DELIMITED BY SIZE
001050         ' でチェック！'  DELIMITED BY SIZE
001060         ' - '            DELIMITED BY SIZE
001070         'Powered by '    DELIMITED BY SIZE
001080         '<a href="'      DELIMITED BY SIZE
001090         '/2007/randam/'  DELIMITED BY SIZE
001100         '">'             DELIMITED BY SIZE
001110         'RANDAM'         DELIMITED BY SIZE
001120         '</a>'           DELIMITED BY SIZE
001130         '</p>'           DELIMITED BY SIZE
001140         INTO  DAMDISP
001150       END-STRING
001160       INSPECT  DAMDISP  TALLYING  ENDPOS
001170                FOR  CHARACTERS  BEFORE  INITIAL  X'2020202020'
001180       DISPLAY  '<h2>ランダム</h2>'
001190       DISPLAY  DAMDISP ( 1 : ENDPOS )
001200     END-IF.
001210*** RANDAM E-N-D ***