 |
入り口の画面です。 お名前とメールアドレスを入れます。 入室のボタンでチャットに入室します。 過去ログボタンで過去のログ１００件が表示されます。 |
 |
チャット入室時の画面です。 内容に入力して「コーディング」のボタンを押すと書き込めます。 内容に何も入力しないで「コーディング」のボタンを押した時はリロード機能となります。 ＣＯＢＯＬのコーディングシートをイメージしております。 |
 |
過去ログ表示です。 １００件まで出力されます。 |
１００％ Ｐｕｒｅ ＣＯＢＯＬ チャット
2002/10/18
ＨＴＭＬとＯｐｅｎＣＯＢＯＬのみでチャットを作成致しました。
今回の新しい試みはＵＲＬエンコーディングされたデータをＣＯＢＯＬでデコードしてみました。
Ｐｅｒｌを利用すれば2行で終わるのですが 100％ＣＯＢＯＬで作成したかったので
あえてＣＯＢＯＬで作成してみました。
チャットＣＧＩとしては機能的にまだまだなのですが、今回Ｖｅｒ1.1と言う事で公開いたします。
以後 機能追加をして本格的なチャットＣＧＩへと進めて行く予定です。
一緒に試行錯誤し「本格的なチャットＣＧＩへと進めてやろう」と言うＣＯＢＯＬドリーマーな方
こちらまでメール頂ければ詳細（といってもこれだけですが（＾＾；）ご連絡させて頂きます。
もちろん報酬等は全く御座いません、ただＣＯＢＯＬプログラムでどこまで出来るか、それを楽しむだけです。
| 利用環境 | |
| ＯＳ | Red Hat Linux 7.2 |
| HTTPサーバー | ＡＰＡＣＨＥ |
| ＣＯＢＯＬ | ＯｐｅｎＣＯＢＯＬ 0.9.7 |
|
入り口の画面です。 お名前とメールアドレスを入れます。 入室のボタンでチャットに入室します。 過去ログボタンで過去のログ１００件が表示されます。 |
|
チャット入室時の画面です。 内容に入力して「コーディング」のボタンを押すと書き込めます。 内容に何も入力しないで「コーディング」のボタンを押した時はリロード機能となります。 ＣＯＢＯＬのコーディングシートをイメージしております。 |
|
過去ログ表示です。 １００件まで出力されます。 |
| ＨＴＭＬのソースです （ＣＯＢＯＬの実行形式 chat01 を起動しております） |
| <HTML> <HEAD> <META HTTP-EQUIV="Content-type" CONTENT="text/html"> <TITLE>ＣＯＢＯＬチャット</TITLE> </HEAD> <BODY BGCOLOR="lavender" TEXT="#000000" LINK="#229955" VLINK="#999933" ALINK="#FF0000"> <CENTER><IMG src="at.gif"> <br><FONT SIZE="5" COLOR="RED">１００％ Ｐｕｒｅ ＣＯＢＯＬ チャット</FONT></CENTER><br> <FORM method="POST" action="../cgi-bin/chat01"> <BR> お名前：<INPUT size="14" type="text" name="name" ><BR> メールアドレス：<INPUT size="30" type="text" name="mail" ><BR><BR> <INPUT type="hidden" name="data" value="入室いたしました"><BR> <BR> <INPUT type="submit" value=" 入室 "> 名前の色: <INPUT type="radio" name="color" value="000000 " checked>黒 <INPUT type="radio" name="color" value="0000ff ">青 <INPUT type="radio" name="color" value="ff0000 ">赤 <INPUT type="radio" name="color" value="008000 ">緑 <INPUT type="radio" name="color" value="800000 ">茶 <INPUT type="radio" name="color" value="800080 ">紫 <INPUT type="hidden" name="first" value="FIRST "> </FORM> <FORM method="POST" action="../cgi-bin/chat00"> <BR> <INPUT type="submit" value=" 過去ログ "> 過去のログ１００件が出ます。 </FORM><BR><BR><BR> <BR><BR><FONT SIZE="4" COLOR="RED"> <CENTER>このチャットはＨＴＭＬとＯｐｅｎＣＯＢＯＬのみで作成致しました。 </FONT><br><br> <a href="http://www.coboler.com">[ ホームページへ戻る ]</a></CENTER> </BODY> </HTML> |
| チャット本体部分です |
IDENTIFICATION DIVISION.
PROGRAM-ID. chat01.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CHATDAT ASSIGN TO "chat.dat".
DATA DIVISION.
FILE SECTION.
FD CHATDAT
DATA RECORD IS REC-A.
01 REC-A.
03 REC-A-NAIYOTBL OCCURS 100.
05 REC-A-KEY PIC 9(03).
05 REC-A-NAME PIC X(14).
05 REC-A-MAIL PIC X(30).
05 REC-A-DATE PIC X(06).
05 REC-A-TIME PIC X(08).
05 REC-A-NAIYO PIC X(150).
05 REC-A-COLOR PIC X(06).
WORKING-STORAGE SECTION.
01 WK-INDAT PIC X(400).
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(250).
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(150).
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.
PROCEDURE DIVISION.
******************************************************************
*
******************************************************************
A000-MAIN.
PERFORM X010-INIT.
PERFORM A100-SYORI.
PERFORM X090-END.
STOP RUN.
******************************************************************
*
******************************************************************
A100-SYORI SECTION.
A100-000.
READ CHATDAT AT END
MOVE SPACE TO REC-A
WRITE REC-A
GO TO A100-999.
A100-100.
ACCEPT WK-DATE FROM DATE.
ACCEPT WK-TIME FROM TIME.
IF WK-FIRSTX NOT = SPACE
PERFORM X200-SET VARYING I FROM 100 BY -1
UNTIL I < 2
MOVE 1 TO REC-A-KEY(1)
MOVE '<B>管理人</B>' TO REC-A-NAME(1)
MOVE SPACE TO REC-A-MAIL(1)
MOVE SPACE TO REC-A-NAIYO(1)
MOVE WK-NAMEX TO REC-A-NAIYO(1) (1:14)
MOVE 'さんいらっしゃ〜い！！'
TO REC-A-NAIYO(1) (15:37)
MOVE '#00AA22' TO REC-A-COLOR(1)
MOVE WK-DATE TO REC-A-DATE(1)
MOVE WK-TIME TO REC-A-TIME(1)
REWRITE REC-A
ELSE
IF WK-NAIYOX NOT = SPACE
PERFORM X200-SET VARYING I FROM 100 BY -1
UNTIL I < 2
MOVE 1 TO REC-A-KEY(1)
MOVE WK-NAMEX TO REC-A-NAME(1)
MOVE WK-MAILX TO REC-A-MAIL(1)
MOVE WK-NAIYOX TO REC-A-NAIYO(1)
MOVE WK-COLORX TO REC-A-COLOR(1)
MOVE WK-DATE TO REC-A-DATE(1)
MOVE WK-TIME TO REC-A-TIME(1)
REWRITE REC-A
END-IF
END-IF.
CLOSE CHATDAT.
A100-200.
DISPLAY 'Content-type: text/html'.
DISPLAY.
DISPLAY '<HTML>'.
DISPLAY '<HEAD>'.
DISPLAY '<TITLE>ＣＯＢＯＬチャット</TITLE>'.
DISPLAY '</HEAD>'.
DISPLAY '<BODY BGCOLOR="lavender" TEXT="#000000">'
'<CENTER>'.
DISPLAY '<IMG src="../at.gif"><BR>'.
DISPLAY '<FONT SIZE="4" COLOR="RED"><B>'.
DISPLAY '１００％ Ｐｕｒｅ ＣＯＢＯＬ チャット'.
DISPLAY '</CENTER></FONT></B><br>'.
DISPLAY '<FORM method="POST"'
' action="../cgi-bin/chat01">'.
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 ' 内容：'.
DISPLAY '<INPUT size="80" type="text" name="data"><BR>'.
DISPLAY '<BR><INPUT type="submit" value=" コーディング ">'.
DISPLAY ' 名前の色:'.
MOVE SPACE TO WK-BLK
WK-BLU
WK-RED
WK-GRE
WK-BRA
WK-PUR.
EVALUATE WK-COLORX
WHEN "000000"
MOVE "checked" TO WK-BLK
WHEN "0000ff"
MOVE "checked" TO WK-BLU
WHEN "ff0000"
MOVE "checked" TO WK-RED
WHEN "008000"
MOVE "checked" TO WK-GRE
WHEN "800000"
MOVE "checked" TO WK-BRA
WHEN "800080"
MOVE "checked" TO WK-PUR
END-EVALUATE.
DISPLAY '<INPUT type="radio" name="color"'
' value="000000"' WK-BLK '>黒 '.
DISPLAY '<INPUT type="radio" name="color"'
' value="0000ff"' WK-BLU '>青 '.
DISPLAY '<INPUT type="radio" name="color"'
' value="ff0000"' WK-RED '>赤 '.
DISPLAY '<INPUT type="radio" name="color"'
' value="008000"' WK-GRE '>緑 '.
DISPLAY '<INPUT type="radio" name="color"'
' value="800000"' WK-BRA '>茶 '.
DISPLAY '<INPUT type="radio" name="color"'
' value="800080"' WK-PUR '>紫 '.
DISPLAY '<INPUT type="hidden" name="first"'
' value=" " >'.
DISPLAY '</FORM><TABLE><TR><FONT SIZE="4" COLOR="RED">'.
DISPLAY '<A HREF=../chat01.htm>[退室]</A></FONT><BR><BR>'.
DISPLAY '<TD WIDTH="775" background="../seat02.jpg">'.
DISPLAY '<IMG src="../seat00.jpg">'.
A100-300.
OPEN INPUT CHATDAT.
READ CHATDAT AT END
GO TO A100-400.
PERFORM X300-DISP VARYING I FROM 1 BY 1
UNTIL I > 20.
A100-400.
DISPLAY '</TR></TABLE><HR>'.
DISPLAY '</BODY>'.
DISPLAY '</HTML>'.
A100-999.
EXIT.
******************************************************************
*
******************************************************************
X010-INIT SECTION.
X010-000.
OPEN I-O CHATDAT.
MOVE SPACE TO WK-NAME WK-MAIL WK-NAIYO
WK-COLOR WK-FIRST
WK-INNAME WK-INMAIL
WK-INNAIYO.
ACCEPT WK-INDAT.
UNSTRING WK-INDAT DELIMITED BY "&"
INTO WK-INNAME WK-INMAIL WK-INNAIYO WK-COLOR WK-FIRST.
CALL "decode" USING WK-INNAMEX WK-NAMEX.
CALL "decode" USING WK-INMAILX WK-MAILX.
CALL "decode" USING WK-INNAIYOX WK-NAIYOX.
INSPECT WK-NAMEX REPLACING ALL "+" BY " ".
INSPECT WK-MAILX REPLACING ALL "+" BY " ".
INSPECT WK-NAIYOX REPLACING ALL "+" BY " ".
INSPECT WK-COLORX REPLACING ALL "+" BY " ".
INSPECT WK-FIRSTX REPLACING ALL "+" BY " ".
X010-999.
EXIT.
**************************************************************
* 終了処理
**************************************************************
X090-END SECTION.
X090-000.
CLOSE CHATDAT
X090-999.
EXIT.
**************************************************************
*
**************************************************************
X200-SET SECTION.
X200-000.
COMPUTE J = I - 1.
MOVE I TO REC-A-KEY(I).
MOVE REC-A-NAME(J) TO REC-A-NAME(I).
MOVE REC-A-MAIL(J) TO REC-A-MAIL(I).
MOVE REC-A-NAIYO(J) TO REC-A-NAIYO(I).
MOVE REC-A-COLOR(J) TO REC-A-COLOR(I).
MOVE REC-A-DATE(J) TO REC-A-DATE(I).
MOVE REC-A-TIME(J) TO REC-A-TIME(I).
X200-999.
EXIT.
**************************************************************
*
**************************************************************
X300-DISP SECTION.
X300-000.
DISPLAY '<FONT COLOR="#'
REC-A-COLOR(I)
'">'.
DISPLAY REC-A-NAME(I).
DISPLAY '</FONT><FONT COLOR="#000000">'.
DISPLAY "＞".
DISPLAY REC-A-NAIYO(I).
DISPLAY " ".
MOVE REC-A-DATE(I) (1:2) TO WK-DDATE(1:2).
MOVE "/" TO WK-DDATE(3:1).
MOVE REC-A-DATE(I) (3:2) TO WK-DDATE(4:2).
MOVE "/" TO WK-DDATE(6:1).
MOVE REC-A-DATE(I) (5:2) TO WK-DDATE(7:2).
DISPLAY '</FONT><FONT SIZE=2 COLOR="#337777">'.
DISPLAY WK-DDATE.
MOVE REC-A-TIME(I) (1:2) TO WK-DTIME(1:2).
MOVE ":" TO WK-DTIME(3:1).
MOVE REC-A-TIME(I) (3:2) TO WK-DTIME(4:2).
MOVE ":" TO WK-DTIME(6:1).
MOVE REC-A-TIME(I) (5:2) TO WK-DTIME(7:2).
DISPLAY WK-DTIME.
DISPLAY '</FONT>'.
DISPLAY '<BR><BR>'.
X300-999.
EXIT.
|
| デコード用のサブ プログラムです。 （HEXコード変換テーブルを作成し1バイトずつ変換しています） |
IDENTIFICATION DIVISION.
PROGRAM-ID. decode.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WK-INTBL PIC X(250).
01 WK-INTBLR REDEFINES WK-INTBL.
03 WK-INR PIC X(01) OCCURS 250.
01 WK-OUTTBL.
03 WK-OUT PIC X(01) OCCURS 250.
01 WK-IDX PIC 9(03).
01 IX PIC 9(03) VALUE ZERO.
01 IX2 PIC 9(03) 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(250).
01 LN-OUT PIC X(150).
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 > 249.
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
SET IDX TO 1
SEARCH WK-IN10 VARYING IDX
AT END
ADD 1 TO IX2
MOVE X'30' 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.
|
| 過去ログ表示のソースです |
IDENTIFICATION DIVISION.
PROGRAM-ID. chat00.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CHATDAT ASSIGN TO "chat.dat".
DATA DIVISION.
FILE SECTION.
FD CHATDAT
DATA RECORD IS REC-A.
01 REC-A.
03 REC-A-NAIYOTBL OCCURS 100.
05 REC-A-KEY PIC 9(03).
05 REC-A-NAME PIC X(14).
05 REC-A-MAIL PIC X(30).
05 REC-A-DATE PIC X(06).
05 REC-A-TIME PIC X(08).
05 REC-A-NAIYO PIC X(150).
05 REC-A-COLOR PIC X(06).
WORKING-STORAGE SECTION.
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.
PROCEDURE DIVISION.
******************************************************************
*
******************************************************************
A000-MAIN.
PERFORM X010-INIT.
PERFORM A100-SYORI.
PERFORM X090-END.
STOP RUN.
******************************************************************
*
******************************************************************
A100-SYORI SECTION.
A100-000.
A100-200.
DISPLAY 'Content-type: text/html'.
DISPLAY.
DISPLAY '<HTML>'.
DISPLAY '<HEAD>'.
DISPLAY '<TITLE>ＣＯＢＯＬチャット</TITLE>'.
DISPLAY '</HEAD>'.
DISPLAY '<BODY BGCOLOR="lavender" TEXT="#000000" '
'LINK="#229955" '
'VLINK="#999933" ALINK="#FF0000"><CENTER>'.
DISPLAY '<IMG src="../at.gif"><BR>'.
DISPLAY '<FONT SIZE="4" COLOR="RED"><B>'.
DISPLAY '１００％ Ｐｕｒｅ ＣＯＢＯＬ チャット 過去ログ'.
DISPLAY '</CENTER></FONT></B><br>'.
DISPLAY '<TABLE><TR>'.
DISPLAY '<TD WIDTH="775" background="../seat02.jpg">'.
DISPLAY '<IMG src="../seat00.jpg">'.
A100-300.
READ CHATDAT AT END
GO TO A100-400.
PERFORM X300-DISP VARYING I FROM 1 BY 1
UNTIL I > 100.
A100-400.
DISPLAY '</TR></TABLE><HR>'.
DISPLAY '<A HREF=../chat01.htm>戻る</A></CENTER>'.
DISPLAY '</BODY>'.
DISPLAY '</HTML>'.
A100-999.
EXIT.
******************************************************************
*
******************************************************************
X010-INIT SECTION.
X010-000.
OPEN INPUT CHATDAT.
X010-999.
EXIT.
**************************************************************
* 終了処理
**************************************************************
X090-END SECTION.
X090-000.
CLOSE CHATDAT
X090-999.
EXIT.
**************************************************************
*
**************************************************************
X300-DISP SECTION.
X300-000.
DISPLAY '<FONT COLOR="#'
REC-A-COLOR(I)
'">'.
DISPLAY REC-A-NAME(I).
DISPLAY '</FONT><FONT COLOR="#000000">'.
DISPLAY "＞".
DISPLAY REC-A-NAIYO(I).
DISPLAY " ".
MOVE REC-A-DATE(I) (1:2) TO WK-DDATE(1:2).
MOVE "/" TO WK-DDATE(3:1).
MOVE REC-A-DATE(I) (3:2) TO WK-DDATE(4:2).
MOVE "/" TO WK-DDATE(6:1).
MOVE REC-A-DATE(I) (5:2) TO WK-DDATE(7:2).
DISPLAY '</FONT><FONT SIZE=2 COLOR="#337777">'.
DISPLAY WK-DDATE.
MOVE REC-A-TIME(I) (1:2) TO WK-DTIME(1:2).
MOVE ":" TO WK-DTIME(3:1).
MOVE REC-A-TIME(I) (3:2) TO WK-DTIME(4:2).
MOVE ":" TO WK-DTIME(6:1).
MOVE REC-A-TIME(I) (5:2) TO WK-DTIME(7:2).
DISPLAY WK-DTIME.
DISPLAY '</FONT>'.
DISPLAY '<BR><BR>'.
X300-999.
EXIT.
|
| Open COBOL コンパイル方法 |
| cobc -c -static -main chat01.cob cobc -c -static decode.cob cobc -o chat01 chat01.o decode.o |