なんちゃって掲示板
2003/02/17
ＣＯＢＯＬで掲示板を作成してみました。Ｐｅｒｌのなんちゃって版なので「なんちゃって掲示板」と命名致しました。
現地点では全くシンプルな掲示板です。今後機能追加する予定です。まだまだ開発途中での公開ですので
不要なコーディングも御座います。また とりあえず今は100件までしか表示できません。
また もしかしたらバグを含んでいるかも知れません。（発見された方はこちら迄ご一報いただければ有難いです）
デコード部分はチャット版のデコードプログラムをバージョンアップ致しました。
まだ改良する個所は沢山あるのですが、とりあえずＶｅｒ０．１の形で公開いたします。
ご自由にソースを改良して頂いて使用して頂いても結構なのですが、当プログラムを使用した事による、不具合、トラブル等 一切の責任は持ちませんので、その点ご理解の上ご使用ください。
| 利用環境 | |
| ＯＳ | Red Hat Linux 7.2 |
| HTTPサーバー | ＡＰＡＣＨＥ |
| ＣＯＢＯＬ | ＯｐｅｎＣＯＢＯＬ 0.9.7 |
| なんちゃって掲示板 ソース 不要なワーク定義やセクションも有りますが今後のVerUP用です。 |
IDENTIFICATION DIVISION.
PROGRAM-ID. BBS02.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT BBSDAT ASSIGN TO "bbs01.dat"
ORGANIZATION IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD BBSDAT
DATA RECORD IS REC-A.
01 REC-A.
03 REC-A-NAME PIC X(14).
03 REC-A-MAIL PIC X(30).
03 REC-A-DATE PIC X(06).
03 REC-A-TIME PIC X(08).
03 REC-A-NAIYO PIC X(2000).
WORKING-STORAGE SECTION.
01 WK-INDAT PIC X(2146).
01 WK-INNAME.
03 FILLER PIC X(005).
03 WK-INNAMEX PIC X(60).
01 WK-INMAIL.
03 FILLER PIC X(005).
03 WK-INMAILX PIC X(60).
01 WK-INNAIYO.
03 FILLER PIC X(005).
03 WK-INNAIYOX PIC X(2000).
01 WK-NAME.
03 FILLER PIC X(005).
03 WK-NAMEX PIC X(060).
01 WK-MAIL.
03 FILLER PIC X(005).
03 WK-MAILX PIC X(060).
01 WK-NAIYO.
03 FILLER PIC X(005).
03 WK-NAIYOX PIC X(2000).
01 WK-COLOR.
03 FILLER PIC X(006).
03 WK-COLORX PIC X(006).
01 WK-FIRST.
03 FILLER PIC X(006).
03 WK-FIRSTX PIC X(005).
01 WK-BLK PIC X(007).
01 WK-BLU PIC X(007).
01 WK-RED PIC X(007).
01 WK-GRE PIC X(007).
01 WK-BRA PIC X(007).
01 WK-PUR PIC X(007).
01 WK-DATE PIC X(06).
01 WK-DDATE PIC X(08).
01 WK-DTIME PIC X(08).
01 WK-TIME PIC X(08).
01 I PIC S9(03) VALUE ZERO.
01 J PIC S9(03) VALUE ZERO.
01 K PIC S9(03) VALUE ZERO.
01 FILLER.
03 TBL-A OCCURS 100.
05 TBL-A-NAME PIC X(14).
05 TBL-A-MAIL PIC X(30).
05 TBL-A-DATE PIC X(06).
05 TBL-A-TIME PIC X(08).
05 TBL-A-NAIYO PIC X(2000).
PROCEDURE DIVISION.
******************************************************************
*
******************************************************************
A000-MAIN.
PERFORM X010-INIT.
PERFORM A100-SYORI.
PERFORM X090-END.
STOP RUN.
******************************************************************
*
******************************************************************
A100-SYORI SECTION.
A100-000.
A100-999.
EXIT.
******************************************************************
*
******************************************************************
X010-INIT SECTION.
X010-000.
MOVE SPACE TO WK-NAME WK-MAIL WK-NAIYO
WK-INNAME WK-INMAIL WK-FIRST
WK-INNAIYO WK-INDAT.
ACCEPT WK-INDAT.
UNSTRING WK-INDAT DELIMITED BY "&"
INTO WK-INNAME WK-INMAIL WK-INNAIYO WK-FIRST.
CALL "decode2" USING WK-INNAMEX WK-NAMEX.
CALL "decode2" USING WK-INMAILX WK-MAILX.
CALL "decode2" USING WK-INNAIYOX WK-NAIYOX.
INSPECT WK-NAMEX REPLACING ALL "+" BY " ".
INSPECT WK-MAILX REPLACING ALL "+" BY " ".
INSPECT WK-NAIYOX REPLACING ALL "+" BY " ".
IF WK-FIRST = SPACE
MOVE SPACE TO WK-NAMEX
WK-MAILX
WK-NAIYOX
ELSE
IF (WK-NAMEX = SPACE) OR
(WK-MAILX = SPACE)
PERFORM X900-ERR1
ELSE
IF WK-NAIYOX = SPACE
PERFORM X910-ERR2
ELSE
PERFORM X200-WRITE
END-IF
END-IF
END-IF.
DISPLAY 'Content-type: text/html'.
DISPLAY.
DISPLAY '<HTML>'.
DISPLAY '<HEAD>'.
DISPLAY '<TITLE>ＣＯＢＯＬ掲示板</TITLE>'.
DISPLAY '</HEAD>'.
DISPLAY '<BODY BGCOLOR="#D7EEFF" TEXT="#000000">'
'<CENTER>'.
DISPLAY '<IMG src="../at.gif"><BR>'.
DISPLAY '<FONT SIZE="5" COLOR="RED"><B>'.
DISPLAY 'なんちゃって掲示板'.
DISPLAY '</FONT></B><br>'.
DISPLAY 'この掲示板は全てＣＯＢＯＬで作成されております<BR>'.
DISPLAY 'なんなりと ご自由に書込み下さい</CENTER>'.
DISPLAY '<FORM method="POST"'
' action="../cgi-bin/bbs02">'.
DISPLAY '<BR>'.
DISPLAY ' お名前：'.
DISPLAY '<INPUT size="20" type="text" name="name"'
' VALUE="'
WK-NAMEX
'"><BR>'.
DISPLAY 'メールアドレス：'.
DISPLAY '<INPUT size="30" type="text" name="mail"'
' VALUE="'
WK-MAILX
'"><BR><BR>'.
DISPLAY ' 内容：<BR>'.
DISPLAY ' '.
DISPLAY '<TEXTAREA cols="80" rows="5" name="data">'
'</TEXTAREA><BR>'.
DISPLAY '<BR><INPUT type="submit" value=" 書込み ">'.
DISPLAY '<INPUT type="hidden" name="first"'
' value="11111" >'.
DISPLAY '</FORM>'.
DISPLAY '<HR><BR><BR>'.
DISPLAY '<HR><BR><BR>'.
X010-100.
OPEN INPUT BBSDAT.
MOVE ZERO TO K.
DISPLAY '<TABLE>'.
PERFORM X300-DISP.
DISPLAY '</TABLE>'.
CLOSE BBSDAT.
X010-200.
DISPLAY '<HR>'.
DISPLAY '</BODY>'.
DISPLAY '</HTML>'.
X010-999.
EXIT.
**************************************************************
* 終了処理
**************************************************************
X090-END SECTION.
X090-000.
X090-999.
EXIT.
**************************************************************
*
**************************************************************
X200-WRITE SECTION.
X200-000.
OPEN EXTEND BBSDAT.
ACCEPT WK-DATE FROM DATE.
ACCEPT WK-TIME FROM TIME.
MOVE WK-NAMEX TO REC-A-NAME.
MOVE WK-MAILX TO REC-A-MAIL.
MOVE WK-NAIYOX TO REC-A-NAIYO.
MOVE WK-DATE TO REC-A-DATE.
MOVE WK-TIME TO REC-A-TIME.
WRITE REC-A.
CLOSE BBSDAT.
X200-999.
EXIT.
**************************************************************
*
**************************************************************
X300-DISP SECTION.
X300-000.
READ BBSDAT AT END
GO TO X300-100.
ADD 1 TO K.
IF K > 100
GO TO X300-100.
MOVE REC-A TO TBL-A(K).
GO TO X300-000.
X300-100.
IF K < 1
GO TO X300-999.
DISPLAY '<TR>'.
DISPLAY '<TD>'.
DISPLAY 'お名前：<FONT COLOR="#FF0000">'.
DISPLAY '<A HREF="mailto:'.
DISPLAY TBL-A-MAIL (K).
DISPLAY '">'.
DISPLAY TBL-A-NAME (K).
DISPLAY "</A>".
DISPLAY '<TD>'.
DISPLAY " ".
MOVE TBL-A-DATE (K) (1:2) TO WK-DDATE(1:2).
MOVE "/" TO WK-DDATE(3:1).
MOVE TBL-A-DATE (K) (3:2) TO WK-DDATE(4:2).
MOVE "/" TO WK-DDATE(6:1).
MOVE TBL-A-DATE (K) (5:2) TO WK-DDATE(7:2).
DISPLAY '</FONT><FONT SIZE=2 COLOR="#337777">'.
DISPLAY WK-DDATE.
MOVE TBL-A-TIME (K) (1:2) TO WK-DTIME(1:2).
MOVE ":" TO WK-DTIME(3:1).
MOVE TBL-A-TIME (K) (3:2) TO WK-DTIME(4:2).
MOVE ":" TO WK-DTIME(6:1).
MOVE TBL-A-TIME (K) (5:2) TO WK-DTIME(7:2).
DISPLAY WK-DTIME.
DISPLAY '</TR>'.
DISPLAY '</FONT>'.
DISPLAY '<TR>'.
DISPLAY '<TD COLSPAN="2" bgcolor="ffffff">'.
DISPLAY TBL-A-NAIYO (K).
DISPLAY '</TR>'.
COMPUTE K = K - 1.
GO TO X300-100.
X300-999.
EXIT.
******************************************************************
*
******************************************************************
X900-ERR1 SECTION.
X900-000.
DISPLAY 'Content-type: text/html'.
DISPLAY.
DISPLAY '<HTML>'.
DISPLAY '<HEAD>'.
DISPLAY '<TITLE>エラー</TITLE>'.
DISPLAY '</HEAD>'.
DISPLAY '<BODY BGCOLOR="#FFFFFF" TEXT="#000000">'
'<CENTER>'.
DISPLAY '<FONT SIZE="4" COLOR="RED"><B>'.
DISPLAY 'お名前とメールアドレスを入力してね！！'.
DISPLAY '</FONT><BR>'.
DISPLAY '<A HREF=http://coboler.no-ip.com/cgi-bin/bbs02>'.
DISPLAY '戻る</A>'.
DISPLAY '</CENTER>'.
DISPLAY '</BODY>'.
DISPLAY '</HTML>'.
STOP RUN.
X900-999.
EXIT.
******************************************************************
*
******************************************************************
X910-ERR2 SECTION.
X910-000.
DISPLAY 'Content-type: text/html'.
DISPLAY.
DISPLAY '<HTML>'.
DISPLAY '<HEAD>'.
DISPLAY '<TITLE>エラー</TITLE>'.
DISPLAY '</HEAD>'.
DISPLAY '<BODY BGCOLOR="#FFFFFF" TEXT="#000000">'
'<CENTER>'.
DISPLAY '<FONT SIZE="4" COLOR="RED"><B>'.
DISPLAY '何か書いてね！！'.
DISPLAY '</FONT><BR>'.
DISPLAY '<A HREF=http://coboler.no-ip.com/cgi-bin/bbs02>'.
DISPLAY '戻る</A>'.
DISPLAY '</CENTER>'.
DISPLAY '</BODY>'.
DISPLAY '</HTML>'.
STOP RUN.
X910-999.
EXIT.
|
| デコード サブプログラム |
IDENTIFICATION DIVISION.
PROGRAM-ID. decode2.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WK-INTBL PIC X(2000).
01 WK-INTBLR REDEFINES WK-INTBL.
03 WK-INR PIC X(01) OCCURS 2000.
01 WK-OUTTBL.
03 WK-OUT PIC X(01) OCCURS 2000.
01 WK-IDX PIC 9(03).
01 IX PIC 9(04) VALUE ZERO.
01 IX2 PIC 9(04) VALUE ZERO.
01 SW-DECODE PIC 9(01) VALUE ZERO.
01 WK-CNT PIC 9(03) VALUE ZERO.
01 WK-HEN.
03 WK-HEN1 PIC X(01).
03 WK-HEN2 PIC X(01).
01 WK-HEXTBL.
03 WK-IN10VAL.
05 FILLER PIC X(32) VALUE
'000102030405060708090A0B0C0D0E0F'.
05 FILLER PIC X(32) VALUE
'101112131415161718191A1B1C1D1E1F'.
05 FILLER PIC X(32) VALUE
'202122232425262728292A2B2C2D2E2F'.
05 FILLER PIC X(32) VALUE
'303132333435363738393A3B3C3D3E3F'.
05 FILLER PIC X(32) VALUE
'404142434445464748494A4B4C4D4E4F'.
05 FILLER PIC X(32) VALUE
'505152535455565758595A5B5C5D5E5F'.
05 FILLER PIC X(32) VALUE
'606162636465666768696A6B6C6D6E6F'.
05 FILLER PIC X(32) VALUE
'707172737475767778797A7B7C7D7E7F'.
05 FILLER PIC X(32) VALUE
'808182838485868788898A8B8C8D8E8F'.
05 FILLER PIC X(32) VALUE
'909192939495969798999A9B9C9D9E9F'.
05 FILLER PIC X(32) VALUE
'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'.
05 FILLER PIC X(32) VALUE
'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'.
05 FILLER PIC X(32) VALUE
'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'.
05 FILLER PIC X(32) VALUE
'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'.
05 FILLER PIC X(32) VALUE
'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'.
05 FILLER PIC X(32) VALUE
'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'.
03 WK-IN10T REDEFINES WK-IN10VAL.
05 WK-IN10 PIC X(02) OCCURS 256 INDEXED BY IDX.
03 WK-IN16VAL.
05 FILLER PIC X(01) VALUE X'00'.
05 FILLER PIC X(01) VALUE X'01'.
05 FILLER PIC X(01) VALUE X'02'.
05 FILLER PIC X(01) VALUE X'03'.
05 FILLER PIC X(01) VALUE X'04'.
05 FILLER PIC X(01) VALUE X'05'.
05 FILLER PIC X(01) VALUE X'06'.
05 FILLER PIC X(01) VALUE X'07'.
05 FILLER PIC X(01) VALUE X'08'.
05 FILLER PIC X(01) VALUE X'09'.
05 FILLER PIC X(01) VALUE X'0A'.
05 FILLER PIC X(01) VALUE X'0B'.
05 FILLER PIC X(01) VALUE X'0C'.
05 FILLER PIC X(01) VALUE X'0D'.
05 FILLER PIC X(01) VALUE X'0E'.
05 FILLER PIC X(01) VALUE X'0F'.
05 FILLER PIC X(01) VALUE X'10'.
05 FILLER PIC X(01) VALUE X'11'.
05 FILLER PIC X(01) VALUE X'12'.
05 FILLER PIC X(01) VALUE X'13'.
05 FILLER PIC X(01) VALUE X'14'.
05 FILLER PIC X(01) VALUE X'15'.
05 FILLER PIC X(01) VALUE X'16'.
05 FILLER PIC X(01) VALUE X'17'.
05 FILLER PIC X(01) VALUE X'18'.
05 FILLER PIC X(01) VALUE X'19'.
05 FILLER PIC X(01) VALUE X'1A'.
05 FILLER PIC X(01) VALUE X'1B'.
05 FILLER PIC X(01) VALUE X'1C'.
05 FILLER PIC X(01) VALUE X'1D'.
05 FILLER PIC X(01) VALUE X'1E'.
05 FILLER PIC X(01) VALUE X'1F'.
05 FILLER PIC X(01) VALUE X'20'.
05 FILLER PIC X(01) VALUE X'21'.
05 FILLER PIC X(01) VALUE X'22'.
05 FILLER PIC X(01) VALUE X'23'.
05 FILLER PIC X(01) VALUE X'24'.
05 FILLER PIC X(01) VALUE X'25'.
05 FILLER PIC X(01) VALUE X'26'.
05 FILLER PIC X(01) VALUE X'27'.
05 FILLER PIC X(01) VALUE X'28'.
05 FILLER PIC X(01) VALUE X'29'.
05 FILLER PIC X(01) VALUE X'2A'.
05 FILLER PIC X(01) VALUE X'2B'.
05 FILLER PIC X(01) VALUE X'2C'.
05 FILLER PIC X(01) VALUE X'2D'.
05 FILLER PIC X(01) VALUE X'2E'.
05 FILLER PIC X(01) VALUE X'2F'.
05 FILLER PIC X(01) VALUE X'30'.
05 FILLER PIC X(01) VALUE X'31'.
05 FILLER PIC X(01) VALUE X'32'.
05 FILLER PIC X(01) VALUE X'33'.
05 FILLER PIC X(01) VALUE X'34'.
05 FILLER PIC X(01) VALUE X'35'.
05 FILLER PIC X(01) VALUE X'36'.
05 FILLER PIC X(01) VALUE X'37'.
05 FILLER PIC X(01) VALUE X'38'.
05 FILLER PIC X(01) VALUE X'39'.
05 FILLER PIC X(01) VALUE X'3A'.
05 FILLER PIC X(01) VALUE X'3B'.
05 FILLER PIC X(01) VALUE X'3C'.
05 FILLER PIC X(01) VALUE X'3D'.
05 FILLER PIC X(01) VALUE X'3E'.
05 FILLER PIC X(01) VALUE X'3F'.
05 FILLER PIC X(01) VALUE X'40'.
05 FILLER PIC X(01) VALUE X'41'.
05 FILLER PIC X(01) VALUE X'42'.
05 FILLER PIC X(01) VALUE X'43'.
05 FILLER PIC X(01) VALUE X'44'.
05 FILLER PIC X(01) VALUE X'45'.
05 FILLER PIC X(01) VALUE X'46'.
05 FILLER PIC X(01) VALUE X'47'.
05 FILLER PIC X(01) VALUE X'48'.
05 FILLER PIC X(01) VALUE X'49'.
05 FILLER PIC X(01) VALUE X'4A'.
05 FILLER PIC X(01) VALUE X'4B'.
05 FILLER PIC X(01) VALUE X'4C'.
05 FILLER PIC X(01) VALUE X'4D'.
05 FILLER PIC X(01) VALUE X'4E'.
05 FILLER PIC X(01) VALUE X'4F'.
05 FILLER PIC X(01) VALUE X'50'.
05 FILLER PIC X(01) VALUE X'51'.
05 FILLER PIC X(01) VALUE X'52'.
05 FILLER PIC X(01) VALUE X'53'.
05 FILLER PIC X(01) VALUE X'54'.
05 FILLER PIC X(01) VALUE X'55'.
05 FILLER PIC X(01) VALUE X'56'.
05 FILLER PIC X(01) VALUE X'57'.
05 FILLER PIC X(01) VALUE X'58'.
05 FILLER PIC X(01) VALUE X'59'.
05 FILLER PIC X(01) VALUE X'5A'.
05 FILLER PIC X(01) VALUE X'5B'.
05 FILLER PIC X(01) VALUE X'5C'.
05 FILLER PIC X(01) VALUE X'5D'.
05 FILLER PIC X(01) VALUE X'5E'.
05 FILLER PIC X(01) VALUE X'5F'.
05 FILLER PIC X(01) VALUE X'60'.
05 FILLER PIC X(01) VALUE X'61'.
05 FILLER PIC X(01) VALUE X'62'.
05 FILLER PIC X(01) VALUE X'63'.
05 FILLER PIC X(01) VALUE X'64'.
05 FILLER PIC X(01) VALUE X'65'.
05 FILLER PIC X(01) VALUE X'66'.
05 FILLER PIC X(01) VALUE X'67'.
05 FILLER PIC X(01) VALUE X'68'.
05 FILLER PIC X(01) VALUE X'69'.
05 FILLER PIC X(01) VALUE X'6A'.
05 FILLER PIC X(01) VALUE X'6B'.
05 FILLER PIC X(01) VALUE X'6C'.
05 FILLER PIC X(01) VALUE X'6D'.
05 FILLER PIC X(01) VALUE X'6E'.
05 FILLER PIC X(01) VALUE X'6F'.
05 FILLER PIC X(01) VALUE X'70'.
05 FILLER PIC X(01) VALUE X'71'.
05 FILLER PIC X(01) VALUE X'72'.
05 FILLER PIC X(01) VALUE X'73'.
05 FILLER PIC X(01) VALUE X'74'.
05 FILLER PIC X(01) VALUE X'75'.
05 FILLER PIC X(01) VALUE X'76'.
05 FILLER PIC X(01) VALUE X'77'.
05 FILLER PIC X(01) VALUE X'78'.
05 FILLER PIC X(01) VALUE X'79'.
05 FILLER PIC X(01) VALUE X'7A'.
05 FILLER PIC X(01) VALUE X'7B'.
05 FILLER PIC X(01) VALUE X'7C'.
05 FILLER PIC X(01) VALUE X'7D'.
05 FILLER PIC X(01) VALUE X'7E'.
05 FILLER PIC X(01) VALUE X'7F'.
05 FILLER PIC X(01) VALUE X'80'.
05 FILLER PIC X(01) VALUE X'81'.
05 FILLER PIC X(01) VALUE X'82'.
05 FILLER PIC X(01) VALUE X'83'.
05 FILLER PIC X(01) VALUE X'84'.
05 FILLER PIC X(01) VALUE X'85'.
05 FILLER PIC X(01) VALUE X'86'.
05 FILLER PIC X(01) VALUE X'87'.
05 FILLER PIC X(01) VALUE X'88'.
05 FILLER PIC X(01) VALUE X'89'.
05 FILLER PIC X(01) VALUE X'8A'.
05 FILLER PIC X(01) VALUE X'8B'.
05 FILLER PIC X(01) VALUE X'8C'.
05 FILLER PIC X(01) VALUE X'8D'.
05 FILLER PIC X(01) VALUE X'8E'.
05 FILLER PIC X(01) VALUE X'8F'.
05 FILLER PIC X(01) VALUE X'90'.
05 FILLER PIC X(01) VALUE X'91'.
05 FILLER PIC X(01) VALUE X'92'.
05 FILLER PIC X(01) VALUE X'93'.
05 FILLER PIC X(01) VALUE X'94'.
05 FILLER PIC X(01) VALUE X'95'.
05 FILLER PIC X(01) VALUE X'96'.
05 FILLER PIC X(01) VALUE X'97'.
05 FILLER PIC X(01) VALUE X'98'.
05 FILLER PIC X(01) VALUE X'99'.
05 FILLER PIC X(01) VALUE X'9A'.
05 FILLER PIC X(01) VALUE X'9B'.
05 FILLER PIC X(01) VALUE X'9C'.
05 FILLER PIC X(01) VALUE X'9D'.
05 FILLER PIC X(01) VALUE X'9E'.
05 FILLER PIC X(01) VALUE X'9F'.
05 FILLER PIC X(01) VALUE X'A0'.
05 FILLER PIC X(01) VALUE X'A1'.
05 FILLER PIC X(01) VALUE X'A2'.
05 FILLER PIC X(01) VALUE X'A3'.
05 FILLER PIC X(01) VALUE X'A4'.
05 FILLER PIC X(01) VALUE X'A5'.
05 FILLER PIC X(01) VALUE X'A6'.
05 FILLER PIC X(01) VALUE X'A7'.
05 FILLER PIC X(01) VALUE X'A8'.
05 FILLER PIC X(01) VALUE X'A9'.
05 FILLER PIC X(01) VALUE X'AA'.
05 FILLER PIC X(01) VALUE X'AB'.
05 FILLER PIC X(01) VALUE X'AC'.
05 FILLER PIC X(01) VALUE X'AD'.
05 FILLER PIC X(01) VALUE X'AE'.
05 FILLER PIC X(01) VALUE X'AF'.
05 FILLER PIC X(01) VALUE X'B0'.
05 FILLER PIC X(01) VALUE X'B1'.
05 FILLER PIC X(01) VALUE X'B2'.
05 FILLER PIC X(01) VALUE X'B3'.
05 FILLER PIC X(01) VALUE X'B4'.
05 FILLER PIC X(01) VALUE X'B5'.
05 FILLER PIC X(01) VALUE X'B6'.
05 FILLER PIC X(01) VALUE X'B7'.
05 FILLER PIC X(01) VALUE X'B8'.
05 FILLER PIC X(01) VALUE X'B9'.
05 FILLER PIC X(01) VALUE X'BA'.
05 FILLER PIC X(01) VALUE X'BB'.
05 FILLER PIC X(01) VALUE X'BC'.
05 FILLER PIC X(01) VALUE X'BD'.
05 FILLER PIC X(01) VALUE X'BE'.
05 FILLER PIC X(01) VALUE X'BF'.
05 FILLER PIC X(01) VALUE X'C0'.
05 FILLER PIC X(01) VALUE X'C1'.
05 FILLER PIC X(01) VALUE X'C2'.
05 FILLER PIC X(01) VALUE X'C3'.
05 FILLER PIC X(01) VALUE X'C4'.
05 FILLER PIC X(01) VALUE X'C5'.
05 FILLER PIC X(01) VALUE X'C6'.
05 FILLER PIC X(01) VALUE X'C7'.
05 FILLER PIC X(01) VALUE X'C8'.
05 FILLER PIC X(01) VALUE X'C9'.
05 FILLER PIC X(01) VALUE X'CA'.
05 FILLER PIC X(01) VALUE X'CB'.
05 FILLER PIC X(01) VALUE X'CC'.
05 FILLER PIC X(01) VALUE X'CD'.
05 FILLER PIC X(01) VALUE X'CE'.
05 FILLER PIC X(01) VALUE X'CF'.
05 FILLER PIC X(01) VALUE X'D0'.
05 FILLER PIC X(01) VALUE X'D1'.
05 FILLER PIC X(01) VALUE X'D2'.
05 FILLER PIC X(01) VALUE X'D3'.
05 FILLER PIC X(01) VALUE X'D4'.
05 FILLER PIC X(01) VALUE X'D5'.
05 FILLER PIC X(01) VALUE X'D6'.
05 FILLER PIC X(01) VALUE X'D7'.
05 FILLER PIC X(01) VALUE X'D8'.
05 FILLER PIC X(01) VALUE X'D9'.
05 FILLER PIC X(01) VALUE X'DA'.
05 FILLER PIC X(01) VALUE X'DB'.
05 FILLER PIC X(01) VALUE X'DC'.
05 FILLER PIC X(01) VALUE X'DD'.
05 FILLER PIC X(01) VALUE X'DE'.
05 FILLER PIC X(01) VALUE X'DF'.
05 FILLER PIC X(01) VALUE X'E0'.
05 FILLER PIC X(01) VALUE X'E1'.
05 FILLER PIC X(01) VALUE X'E2'.
05 FILLER PIC X(01) VALUE X'E3'.
05 FILLER PIC X(01) VALUE X'E4'.
05 FILLER PIC X(01) VALUE X'E5'.
05 FILLER PIC X(01) VALUE X'E6'.
05 FILLER PIC X(01) VALUE X'E7'.
05 FILLER PIC X(01) VALUE X'E8'.
05 FILLER PIC X(01) VALUE X'E9'.
05 FILLER PIC X(01) VALUE X'EA'.
05 FILLER PIC X(01) VALUE X'EB'.
05 FILLER PIC X(01) VALUE X'EC'.
05 FILLER PIC X(01) VALUE X'ED'.
05 FILLER PIC X(01) VALUE X'EE'.
05 FILLER PIC X(01) VALUE X'EF'.
05 FILLER PIC X(01) VALUE X'F0'.
05 FILLER PIC X(01) VALUE X'F1'.
05 FILLER PIC X(01) VALUE X'F2'.
05 FILLER PIC X(01) VALUE X'F3'.
05 FILLER PIC X(01) VALUE X'F4'.
05 FILLER PIC X(01) VALUE X'F5'.
05 FILLER PIC X(01) VALUE X'F6'.
05 FILLER PIC X(01) VALUE X'F7'.
05 FILLER PIC X(01) VALUE X'F8'.
05 FILLER PIC X(01) VALUE X'F9'.
05 FILLER PIC X(01) VALUE X'FA'.
05 FILLER PIC X(01) VALUE X'FB'.
05 FILLER PIC X(01) VALUE X'FC'.
05 FILLER PIC X(01) VALUE X'FD'.
05 FILLER PIC X(01) VALUE X'FE'.
05 FILLER PIC X(01) VALUE X'FF'.
03 WK-IN16T REDEFINES WK-IN16VAL.
05 WK-IN16 PIC X(01) OCCURS 256.
LINKAGE SECTION.
01 LN-IN PIC X(2000).
01 LN-OUT PIC X(2000).
PROCEDURE DIVISION USING LN-IN LN-OUT.
A000-SHORI.
MOVE ZERO TO IX2
SW-DECODE.
MOVE SPACE TO WK-OUTTBL.
MOVE LN-IN TO WK-INTBL.
PERFORM X100-SET VARYING IX FROM 1 BY 1
UNTIL IX > 1999.
MOVE WK-OUTTBL TO LN-OUT.
EXIT-PROGRAM.
******************************************************************
* *
******************************************************************
X100-SET SECTION.
X100-000.
IF WK-INR(IX) = "%"
MOVE 1 TO SW-DECODE
MOVE ZERO TO WK-CNT
ELSE
IF SW-DECODE = 1
ADD 1 TO WK-CNT
IF WK-CNT = 2
MOVE WK-INR(IX) TO WK-HEN2
MOVE ZERO TO SW-DECODE
IF WK-HEN = '0D'
ADD 1 TO IX2
MOVE '<' TO WK-OUT(IX2)
ADD 1 TO IX2
MOVE 'B' TO WK-OUT(IX2)
GO TO X100-999
END-IF
IF WK-HEN = '0A'
ADD 1 TO IX2
MOVE 'R' TO WK-OUT(IX2)
ADD 1 TO IX2
MOVE '>' TO WK-OUT(IX2)
GO TO X100-999
END-IF
SET IDX TO 1
SEARCH WK-IN10 VARYING IDX
AT END
ADD 1 TO IX2
MOVE ' ' TO WK-OUT(IX2)
WHEN WK-HEN = WK-IN10 (IDX)
SET WK-IDX TO IDX
END-SEARCH
ADD 1 TO IX2
MOVE WK-IN16(WK-IDX) TO WK-OUT(IX2)
ELSE
IF WK-CNT = 1
MOVE WK-INR(IX) TO WK-HEN1
ELSE
NEXT SENTENCE
ELSE
ADD 1 TO IX2
MOVE WK-INR(IX) TO WK-OUT(IX2).
X100-999.
EXIT.
|
| ＯＰＥＮ ＣＯＢＯＬコンパイル方法 |
| cobc -c -static -main bbs02.cob cobc -c -static decode2.cob cobc -o bbs02 bbs02.o decode2.o |