#!/usr/bin/perl

#-----------------------------------------------------------
# 選択クイズCGI (ntaku.cgi)ver1.00
#                          フリーソフト(転載自由、改造自由、許可不要)
#                                              Create date:1999/04/10
#                  Copyright (C) 1999 by Isao.H  All Rights Reserved.
#                                          E-Mail: qz@ca.sakura.ne.jp
#                                URL: http://www.ca.sakura.ne.jp/~qz/
#
#                                      layout designed by marita
#                                          E-Mail: marita_m@geocities.co.jp
#                                          URL: http://aquafish.net/marita/
#------------------------------------------------------------
#------------------------------------------------------------
#_各種設定
#------------------------------------------------------------
#----------------------------------------------#
#__基本設定
#----------------------------------------------#
$RetURL = "http://contest.thinkquest.gr.jp/tqj2001/40631/frame.htm";	#戻り先ＵＲＬ：適当に変更してね
$MeCgi = "ntaku.cgi";		#このＣＧＩ名
$Method = "POST";			#POST or GET 
$AdminPassWord = "kenrihi";	#管理者パスワード：適当に変更してね
$UserPassWord = "tasiro";	#ユーザパスワード：適当に変更してね
$MakeMode = 0;			#問題作成　0:管理者のみ 1:ユーザパスワード取得者のみ 2:全ユーザ
$MaxSelectCount = 3;		#最大問題選択数(余り大きな数にしないほうが良い)
$MailCheck = 0;				#E-Mailのチェック 0:しない 1:する
$GameOver = 3;				#ゲームオーバーにする不正解の回数
$Ranking = 10;				#ランキングに登録する人数
$DelPageCnt = 30;			#削除時に表示される行数(0:無制限)
$KanaChange = 1;			#半角カナ全角カナ置換(0:しない 1:する)
$RetNG = 1;					#戻るボタンによるズル 　0:ＯＫ 1:ＮＧ
					#↑このチェックにJavaScriptを利用しています。
					#JavaScriptの利用できないブラウザでは、チェックできません。
$HeadTitle = "E.C.U.C.Pクイズ";	#HEADタグのタイトル：適当に変更してね
$MainTitle= <<__EOF__;		#メインのタイトル：以下は適当に変更してね
<center><table width=300 height=50 bgcolor="123456"><tr><td align=center><Font Size=+2><b>
E.C.U.C.Pクイズ</b></Font></td></tr></table>
__EOF__
#----------------------------------------------#
#__制限時間設定
#----------------------------------------------#
#注）制限時間のチェックは、JavaScriptで行っています。
#　　JavaScriptの利用できないブラウザでは、制限時間は無制限になります。
$Timer = 10;			#制限時間(秒) 0:無制限
$TimeImgMode = 0;		#残り時間画像 0:非表示 1:表示
$TimeImgOn = "on.gif";	#残り時間画像 経過時間
$TimeImgOff = "off.gif";#残り時間画像 残り時間
#----------------------------------------------#
#__登録ファイル設定
#----------------------------------------------#
$ScoreFile = "score.txt";	#スコアデータ
$QueFile = "que.txt";		#問題データ
#----------------------------------------------#
#__カラー設定
#----------------------------------------------#
$BackGround = "";					# 背景画像
$BackColor  = "#FFF4E8";			# 背景色を指定
$TextColor  = "#787878";			# 文字色を指定
$LinkColor  = "#8A98F4";			# リンク色を指定（未リンク）
$VLinkColor = "#73CE91";			# リンク色を指定（既リンク）
$ALinkColor = "#ff0000";			# リンク色を指定（リンク中）

#----------------------------------------------#
#__付設カウンター
#----------------------------------------------#
###当掲示板右上部に設置してあるカウンターは、当掲示板の付属品ではありません。カウンターはKENTさんのものですので、そちらでDLして設定して下さい。
###右上のdayカウンターを使用するかしないかの設定
###ただし、カウンターのスクリプト類はKENTさんの所から別途DLの必要があります。KENTさんのカウンターのURL：http://www.lemon.ne.jp/~kent/count/index.html

$daycounter =1;         #(no=0, yes=1)


#----------------------------------------------#
#__日本語関連
#----------------------------------------------#
$JcodeLib = './jcode.pl';	#漢字ライブラリ jcode.pl のファイル名
$kanjicode = 'sjis';		#漢字コード（'sjis' 'euc' 'jis'）

#----------------------------------------------#
#__ロック関連
#----------------------------------------------#
$LockFile = "./ntaku.lock";	#ロックファイル名
$LockMode = 1;				#0-ロックしない 1-ロックする

#-------------------------------------------------------------
#_処理開始
#-------------------------------------------------------------

&InitProc;

if($FORM{'MODE'} eq "IN"){
	&INProc;
}elsif($FORM{'MODE'} eq "DUMMY"){
	&DummyProc;
}elsif($FORM{'MODE'} eq "MAKE"){
	&MakeQuestionProc;
}elsif($FORM{'MODE'} eq "ADMIN"){
	&AdminProc;
}elsif($FORM{'MODE'} eq "QUESTION"){
	&QuestionProc;
}elsif($FORM{'MODE'} eq "RANKING"){
	&RankingProc;
}
&PrintMessage;

exit(0);

#------------------------------------------------------------
#__各種サブルーチン
#------------------------------------------------------------
#---------------------------------#
#___メニュー表示処理
#---------------------------------#
sub PrintMenu{
	local($Type) = $_[0];

	if($Type eq "A"){
		print "<Center>\n";
		print "<HR>\n";
		print "<font size=-+1>|<A Href=\"$RetURL\"> ＨＯＭＥ </A>";
		print "|<A Href=\"$MeCgi?MODE=RANKING\" Target=_top> ランキング </A>";
		if($MakeMode){
			print "|<A Href=\"$MeCgi?MODE=MAKE&ACTION=PASS\" Target=_top> 問題作成 </A>";
		}
		print "|<A Href=\"$MeCgi?MODE=ADMIN&ACTION=PASS\" Target=_top> 管理用 </A>|</font>";
		print "<HR>\n";
		print "</Center>\n";

	}elsif($Type eq "B"){
		print "<Center>\n";
		print "<HR>\n";
		print "<font size=-1>|<A Href=\"$RetURL\" Target=_top> ＨＯＭＥ </A>";
		print "|<A Href=\"$MeCgi\" Target=_top> 挑戦 </A>";
		print "|<A Href=\"$MeCgi?MODE=RANKING\" Target=_top> ランキング </A>";
		if($MakeMode){
			print "|<A Href=\"$MeCgi?MODE=MAKE&ACTION=PASS\" Target=_top> 問題作成 </A>";
		}
		print "|<A Href=\"$MeCgi?MODE=ADMIN&ACTION=PASS\" Target=_top> 管理用 </A>|</font>";
		print "<HR>\n";
		print "</Center>\n";

	}elsif($Type eq "C"){
		print "<Center>\n";
		print "<HR>\n";
		print "<font size=-1>|<A Href=\"$RetURL\" Target=_top> ＨＯＭＥ </A>";
		print "|<A Href=\"$MeCgi\" Target=_top> 挑戦 </A>";
		print "|<A Href=\"$MeCgi?MODE=RANKING\" Target=_top> ランキング </A></font>";
		print "<HR>\n";
		print "</Center>\n";

	}elsif($Type eq "D"){
		print "<Center>\n";
		print "<HR>\n";
		print "<font size=-1>|<A Href=\"$RetURL\" ＨＯＭＥ </A>";
		print "|<A Href=\"$MeCgi\" Target=_top> 挑戦 </A>";
		if($MakeMode){
			print "|<A Href=\"$MeCgi?MODE=MAKE&ACTION=PASS\" Target=_top> 問題作成 </A>";
		}
		print "|<A Href=\"$MeCgi?MODE=ADMIN&ACTION=PASS\" Target=_top>  管理用 </A>|</font>";
		print "<HR>\n";
		print "</Center>\n";
	}
}
#---------------------------------#
#___入室フォーム表示
#---------------------------------#
sub PrintMessage{
	local($Mode, $Guide);

	$Guide = "<OL>\n";
	$Guide = $Guide . "<LI>なまえとメールアドレスを入力して、挑戦ボタンを押してください。\n";
	$Guide = $Guide . "<LI>選択肢の中から正解だと思われるものをチェックして、OKボタンを押してください。\n";
	$Guide = $Guide . "<LI>$GameOver問間違うとゲームオーバーです。\n";
	if($Timer){
		$Guide = $Guide . "<LI>$Timer秒以内に答えてください。\n";
	}
	$Guide = $Guide . "<LI>$Ranking位以内に入ると、記録更新者として登録されます。\n";
	if($RetNG){
		$Guide = $Guide . "<LI>JavaScrit Errorが発生したら、再度、挑戦してください。\n";
	}
	$Guide = $Guide . "</OL>\n";

	if($RetNG){
		$Mode = "IN";
		$S =  $JScriptNavCheck;
	}else{
		$Mode = "QUESTION";
	}

	&PrintContentType;
	&PrintHeader;
	&PrintMenu("A");
	print "<Center>\n";
	print "<Table border=2><TR><TD bgcolor=eeeeee>\n$Guide\n</TD></TR></Table>\n<HR>";
	print "<Form  Method=\"$Method\" Action=\"$MeCgi\">\n";
	print "<Input Type=Hidden Name=MODE Value=$Mode>\n";
	print "<table border=2><tr><td align=right>お名前</td><td>\n";
	print "<Input Type=Text Name=NAME SIZE=30  Value=" . $COOKIE{'name'} . "></td></tr><tr>\n";
	print "<td align=right>E-mail</td>\n";
	print "<td><Input Type=Text Name=MAIL SIZE=30 Value=" . $COOKIE{'mail'} . "></td></tr>\n";
	print $S . "\n";
	print "<tr><td></td><td align=center><Input Type=Submit Value=\"--挑戦--\"></td></tr></table>\n";
	print "</Center></Form>\n";

	&PrintFooter;
}
#---------------------------------#
#___フレームトップ作成
#---------------------------------#
sub INProc{
	if($FORM{'NAV'} ne "OK"){&QuestionProc;}

	if($FORM{'NAME'} eq ""){ &CGIError("なまえを入力してください"); }
	if($MailCheck){
		if($FORM{'MAIL'} eq ""){ &CGIError("E_MAILを入力してください"); }
	}

	&PrintContentType;

	print "<Html><Head><Title>$HeadTitle</Title></Head>\n";
	print "<FrameSet Rows=\"0,*\" Border=0 FrameBorder=0 FrameSpacing=0>\n";
	print "<Frame Src = \"$MeCgi?MODE=DUMMY\" Name=\"DUMMY\"" 
		. " MargeInWidth=0 Scrolling=NO NoResize>\n";
	print "<Frame Src = \"$MeCgi?MODE=QUESTION&NAV=OK&NAME=" 
		. $FORM{'NAME'} . "&MAIL=" . $FORM{'MAIL'} . "\" Name=\"MAIN\" MargeInWidth=0>\n";
	print "</FrameSet>\n</Html>";
	exit(0);
}
#---------------------------------#
#___Dummy
#---------------------------------#
sub DummyProc{
	&PrintContentType;
	&PrintHeader;

	print "<Html><Body>\n<Form>\n";
	print "<Input Type=Hidden Name=QPOS Value=1>";
	print "</Form>\n";
	print $TimeIMG . "\n" . "</Body></Html>";

	exit(0);
}
#---------------------------------#
#___問題データ切り分け
#---------------------------------#
sub SplitQue{
	local(@ARR, $Name, $Value);

	@ARR = split(/\t/, $_[0]);

	foreach(@ARR){
		($Name, $Value) = split(/=/, $_);
		$QUE{$Name} = $Value;
	}
}

#---------------------------------#
#___問題出題
#---------------------------------#
sub QuestionProc{
	local(@lines, $NGCnt, $QNo, $NGCnt, $idx, $NGMsg, $Checkd,$RURL);
	sleep(1);
	if($FORM{'NAME'} eq ""){ &CGIError("なまえを入力してください"); }
	if($MailCheck){
		if($FORM{'MAIL'} eq ""){ &CGIError("E_MAILを入力してください"); }
	}
	if($FORM{'NAV'} ne "OK"){$RetNG = 0;}

	&SetCookie($FORM{'NAME'},$FORM{'MAIL'},$COOKIE{'userpass'},$COOKIE{'adminpass'});

	open(IN,"$QueFile") || &CGIError("Can't open $QueFile");
	@lines = <IN>;
	close(IN);
	shift(@lines);

	#--不正解チェック
	if($FORM{'QNO'} eq ""){
		$QNo = 1;
		$NGCnt = 0;
	}else{
		$NGCnt = $FORM{'NGCNT'};
		foreach(@lines){
			&SplitQue($_);
			if($FORM{'KEY'} eq $QUE{'KEY'}){
				if($FORM{'ANS'} ne $QUE{'ANS'}){
					$NGCnt++;
					if($GameOver <= $NGCnt){ &GameOver; }
				}
				last;
			}
		}
		$QNo = $FORM{'QNO'} + 1;
	}
	if($NGCnt){ $NGMsg = "(不正解数:$NGCnt)"; }

	#--問題出題
	srand();
	$idx = int(rand(@lines));
	&SplitQue($lines[$idx]);

	if($Timer){
		$RURL = "$MeCgi?MODE=QUESTION&KEY=" . $QUE{'KEY'} ."&QNO=$QNo"
				. "&NGCNT=$NGCnt&NAME=" . $FORM{'NAME'}
				. "&MAIL=" .  $FORM{'MAIL'};
		if($RetNG){ $RURL = $RURL . "&NAV=OK";}
		$META_TAG = "<META HTTP-EQUIV=REFRESH CONTENT=$Timer;URL=\"$RURL\">\n";
	}

	$S = "<Form  Method=\"$Method\" action=\"$MeCgi\">\n";
	$S = $S . "<Input Type=Hidden Name=MODE Value=QUESTION>\n";
	$S = $S . "<Input Type=Hidden Name=KEY Value=" . $QUE{'KEY'} . ">\n";
	$S = $S . "<Input Type=Hidden Name=QNO Value=$QNo>\n";
	$S = $S . "<Input Type=Hidden Name=NGCNT Value=$NGCnt>\n";
	$S = $S . "<Input Type=Hidden Name=NAME Value=" . $FORM{'NAME'} . ">\n";
	$S = $S . "<Input Type=Hidden Name=MAIL Value=" . $FORM{'MAIL'} . ">\n";
	if($RetNG){ $S = $S . "<Input Type=Hidden Name=NAV Value=OK>"; }
	$S = $S . "<Center>\n";
	$S = $S . "<font size=+1 color=lightblue>第$QNo問 $NGMsg</font>\n";
	$S = $S . "<HR>\n$QUE{'QUE'}<HR>\n";

	$S = $S . "<Table>\n";
	$Checkd = "Checked";
	foreach(1..$QUE{'ACNT'}){
		$S = $S . "<TR><TD><Input Type=Radio Name=ANS Value=A$_ $Checkd></TD>";
		$S = $S . "<TD>" . $QUE{"A" . $_} . "</TD></TR>\n";
		$Checkd = "";
	}
	$S = $S . "</Table>\n<HR>\n";

	$S = $S . "<input type=submit value=\"--OK--\">\n";
	$S = $S . "</Form><center>----- 残り時間 -----</center>\n";

 	$S = $S . $TimeIMG;
	$S = $S . "</Center>\n";

	&PrintContentType;
	&PrintHeader;
	&PrintMenu("B");
	if($RetNG){
		$S =~ s/\n//g;
		&JScrptQue($QNo, $S);
	}else{
		print $S;
	}

	&PrintFooter;
	exit(0);
}

#---------------------------------#
#___JavaScript付問題出題
#---------------------------------#
sub JScrptQue{
	local($QNo) = $_[0];
	print <<__EOF__;
<Script Language="JavaScript">
<!--JavaScript
	var Q = top.DUMMY.document.forms[0].elements[0].value;
	if(Q < $QNo) top.DUMMY.document.forms[0].elements[0].value = $QNo;
	if(top.DUMMY.document.forms[0].elements[0].value != $QNo){
		ZuruMsg();
	}else{
		document.write('$_[1]');
		animation();
	}
//-->
</Script>
__EOF__

}
#---------------------------------#
#___JavaScriptブラウザチェック
#---------------------------------#
sub JScriptNav{
	print <<__EOF__;
<Script Language="JavaScript">
<!--JavaScript
var Nav = (navigator.appVersion.charAt(0)>=3 
     && (navigator.appName =="Netscape" || navigator.appName =="Microsoft Internet Explorer"));

function ZuruMsg(){
	document.write('<Center><HR>ズル！！<HR><BR><Font Size=+3>戻るボタンの利用はズルです！！</Font><BR><HR><font size=-1>|<A Href="$RetURL" Target=_top> HOME </A>|<A Href="$MeCgi" Target=_top> やり直す </A>|</Center>');
}
//-->
</Script>
__EOF__
}
#---------------------------------#
#___JavaScriptタイマー
#---------------------------------#
sub JScriptTimer{
	local($Max);
	if(!$TimeImgMode){
		print <<__EOF__;
<Script Language="JavaScript">
<!--JavaScript
function animation(){
	return 0;
}
//-->
</Script>
__EOF__
		return;
	}
	print <<__EOF__;
<Script Language="JavaScript">
<!--JavaScript
a = 0;
timeID = $Timer;	//　割り込みタイマ用
function animation(){
	if (a<$Timer+1){
		clearTimeout(timeID);
		timeID = setTimeout('animation()',1000);
		if(a<$Timer) document.images[a].src="$TimeImgOn";
		a++;
	}else{
		a = 0;
	}
}
//-->
</Script>
__EOF__
}

#---------------------------------#
#___ゲームオーバー処理
#---------------------------------#
sub GameOver{
	local($S,$OK,$Ritu,@lines,@buf,$CompA,$ConpB,$New,$wFlag,$MSG);
	local($QNo) = $FORM{'QNO'} + 1;

	open(IN,"$ScoreFile") || &CGIError("Can't open $ScoreFile");
	@lines = <IN>;
	close(IN);

	$OK = $FORM{'QNO'} - $FORM{'NGCNT'} - 1;
	$Ritu = ($OK / $FORM{'QNO'}) * 100;
	$Ritu = sprintf("%3.2f", $Ritu);

	$wFlag = 0;$MSG="<font size=+2 color=yellow>記録更新ならず！！<BR>残念でした。<BR>次回がんばりましょう！</font>";
	$New = join("\t", $FORM{'QNO'}, $OK, $FORM{'NAME'}, $FORM{'MAIL'}, time, "\n");
	#Mondai,Seikai,Name,Email
	if(@lines >= $Ranking){
		@lines = sort{
			@buf = split(/\t/,$a);
			$CompA = $buf[0];
			@buf = split(/\t/,$b);
			$CompB = $buf[0];
			$CompA <=> $CompB;
		}@lines;

		@buf = split(/\t/, $lines[0]);
		if($FORM{'QNO'} > $buf[0]){
			$lines[0] = $New;
			$wFlag = 1;
		}
	}else{
		push(@lines, $New);
		$wFlag = 1;
	}

	if($wFlag){
		open(OUT,">$ScoreFile") || &CGIError("Can't open $ScoreFile");
		print OUT @lines;
		close(OUT);
		$MSG = "<font size=+2 color=lightgreen>おめでとうございます。<BR>ランキングインしました！！</font>";
	}

	if($RetNG){
		$S = "<Script Language=\"JavaScript\">\n";
		$S = $S . "<!--JavaScript\n";
		$S = $S . "top.DUMMY.document.forms[0].elements[0].value = $QNo;\n";
		$S = $S . "//-->\n</Script>\n";
	}
	&PrintContentType;
	&PrintHeader;
	&PrintMenu("B");
print <<__Eof__;
$S
<Center>
<HR>
<font size=+3 color=yellow><b>ゲームオーバー</b></font>
<HR>
<b><fonr size=+1 color=white>$FORM{'NAME'}さんの成績</font></b><BR>
<Table BORDER=2 CELLSPACING=2 CELLPADDING=2 >
<TR><TD>問題数：<TD Align=Right>$FORM{'QNO'}問</TD></TR>
<TR><TD>正解数：<TD Align=Right>$OK問</TD></TR>
<TR><TD>正解率：<TD Align=Right>$Ritu%</TD></TR>
</Table>
<HR>
$MSG
</Center>
__Eof__
	&PrintFooter;
	exit(0); #強制終了
}
#---------------------------------#
#___ランキング表示
#---------------------------------#
sub RankingProc{
	local($CompA,$CompB,@buf,$Name,$Ritu);
	$RetNG = 0;
	open(IN,"$ScoreFile") || &CGIError("Can't open $ScoreFile");
	local(@lines) = <IN>;
	close(IN);

	@lines = sort{
		@buf = split(/\t/,$a);
		$CompA = $buf[0];
		@buf = split(/\t/,$b);
		$CompB = $buf[0];
		$CompB <=> $CompA;
	}@lines;

	&PrintContentType;
	&PrintHeader;
	&PrintMenu("D");
	print "<Center>\n";
	print "ランキング<HR>";
	print "<Table BORDER=2 CELLSPACING=2 CELLPADDING=2 >\n";
	print "<TR>\n";
	print "<TD Align=Center>問題数</TD>\n";
	print "<TD Align=Center>正解数</TD>\n";
	print "<TD Align=Center>正解率</TD>\n";
	print "<TD Align=Center>なまえ</TD>\n";
	print "<TD Align=Center>解答年月日</TD>\n";
	print "</TR>\n";
	foreach(@lines){
		@buf = split(/\t/,$_);
		print "<TR>\n";
		print "<TD Align=Right>$buf[0]問</TD>\n";
		print "<TD Align=Right>$buf[1]問</TD>\n";

		$Ritu = ($buf[1] / $buf[0]) * 100;
		$Ritu = sprintf("%3.2f", $Ritu);
		print "<TD Align=Right>$Ritu%</TD>\n";

		if($buf[3] ne ""){
			$Name = "<A Href=\"mailto:$buf[3]\">$buf[2]</A>";
		}else{
			$Name = $buf[2];
		}
		print "<TD Align=Center>$Name</TD>\n";
		$Date = &FormatDateTime($buf[4]);
		print "<TD Align=Right>$Date</TD>\n";
		print "</TR>\n";
	}
	print "</Table>\n";
	print "</Center>\n";
	&PrintFooter;
	exit(0);
}

#---------------------------------#
#___問題データ作成
#---------------------------------#
sub MakeQuestionProc{
	$RetNG = 0;
	if($FORM{'ACTION'} eq "KAKUNIN"){
		&MakeQuestionKakunin;
	}elsif($FORM{'ACTION'} eq "WRITE"){
		&MakeQuestionWrite;
	}elsif($FORM{'ACTION'} eq "PASS"){
		if($MakeMode == 1){
			&MakeQuestionPassForm;
		}else{
			&MakeQuestionForm;
		}
	}else{
		&CheckUserPass;
		&MakeQuestionForm;
	}
	exit(0);
}
#--パスワード確認画面--#
sub MakeQuestionPassForm{
	&PrintContentType;
	&PrintHeader;
	print <<__EOF__;
<Center>
<HR><table width=300 border=0><tr><td bgcolor=313131>
<Font Size=+2>ユーザパスワード確認画面</Font>
<HR>
パスワードを入力してください。
<HR>
<Form  Method="$Method" Action="$MeCgi">
<Input Type=Hidden Name="MODE" value="MAKE">
<Input Type=PassWord Name="PASS" Value="$COOKIE{'userpass'}">
<Input Type=submit value=" OK ">
</Form></td></tr></table>
<HR>
</Center>
__EOF__
	&PrintFooter;
}
#--ユーザパスワード確認--#
sub CheckUserPass{
	if($MakeMode == 1){
		if($FORM{'PASS'} eq $UserPassWord){
			&SetCookie($COOKIE{'name'},$COOKIE{'mail'},
				$FORM{'PASS'},$COOKIE{'adminpass'});
		}else{
			&CGIError("パスワードが違います。");;
		}
	}
}
#--問題作成フォーム表示--#
sub MakeQuestionForm{
	&PrintContentType;
	&PrintHeader;

	print "<Form  Method=\"$Method\" Action=\"$MeCgi\">\n";
	print "<Input Type=Hidden Name=MODE Value=MAKE>\n";
	print "<Input Type=Hidden Name=ACTION Value=KAKUNIN>\n";
	&PrintMenu("C");
	print "<Center>\n";
	print "問題作成<HR>\n";
		print "<center><A Href=\"$MeCgi?MODE=ADMIN&ACTION=PASS\" Target=_top>管理メニューに戻る</A><hr></center>";

	print "なまえ <Input Type=Text Name=NAME Value=" . $COOKIE{'name'} . "><BR>\n";
	print "E_Mail <Input Type=Text Name=MAIL Value=" . $COOKIE{'mail'} . "><BR>\n";
	print "<HR>";
	print "-----問題-----<BR>\n";
	print "<TextArea Cols=40 Rows=5 Name=QUESTION></TextArea>\n<BR> <BR>\n";
	print "選択肢<BR>(2〜$MaxSelectCount個まで選択肢を作成してください)\n";
	print "<Table Border=1>\n";
	print "<TR><TD Align=Center>正解</TD><TD Align=Center>解答</TD></TR>\n";
	foreach(1..$MaxSelectCount){
		print "<TR>\n";
		print "<TD><Input Type=Radio Name=ROK Value=A$_></TD>\n";
		print "<TD><Input Type=Text Name=A$_></TD>\n";
		print "</TR>\n";
	}
	print "</Table>\n<BR>\n";
	print "<Input Type=Submit Value=\"-----書込----\">";
	print "</Center></Form>\n";

	&PrintFooter;
}
#--問題書込確認--#
sub MakeQuestionKakunin{
	local($n,@AnsSel,$AnsOK,$i,$j,$Buf1,$Buf2);
	#入力チェック
	if($FORM{'NAME'} eq ""){ &CGIError("なまえを入力してください"); }
	if($MailCheck){
		if($FORM{'MAIL'} eq ""){ &CGIError("E_MAILを入力してください"); }
	}
	if($FORM{'QUESTION'} eq ""){&CGIError("問題が未入力です。");}
	if($FORM{'ROK'} eq ""){&CGIError("正解の選択肢が存在しません。");}
	if($FORM{$FORM{'ROK'}} eq ""){&CGIError("正解の選択肢が存在しません。");}

	$i = 0;
	foreach(1..$MaxSelectCount){
		$n = "A" . $_;
		if($FORM{$n} ne ""){
			$FORM{'$n'} =~ s/</&lt;/g;
			$FORM{'$n'} =~ s/>/&gt;/g;
			push(@AnsSel, $FORM{$n});
			if($FORM{'ROK'} eq $n){ $AnsOK = $i;}
			$i++;
		}
	}
	if(@AnsSel < 2){&CGIError("選択肢は２個以上、入力してください。");}

	foreach $i(0..@AnsSel){
		foreach $j(0..@AnsSel){
			if($i != $j){
				$Buf1 = $AnsSel[$i];
				$Buf2 = $AnsSel[$j];
				$Buf1 =~ s/ //g;
				$Buf1 =~ s/　//g;
				$Buf2 =~ s/ //g;
				$Buf2 =~ s/　//g;
				if($Buf1 eq $Buf2){
					&CGIError("重複する選択肢があります。");
				}
			}
		}
	}
	$FORM{'QUESTION'} =~ s/</&lt;/g;
	$FORM{'QUESTION'} =~ s/>/&gt;/g;
	$FORM{'NAME'} =~ s/</&lt;/g;
	$FORM{'NAME'} =~ s/>/&gt;/g;
	$FORM{'MAIL'} =~ s/</&lt;/g;
	$FORM{'MAIL'} =~ s/>/&gt;/g;
	$FORM{'QUESTION'} =~ s/\r\n/\n/g;
	$FORM{'QUESTION'} =~ s/\r|\n/\n/g;

	&PrintContentType;
	&PrintHeader;
	print "<Form  Method=\"$Method\" Action=\"$MeCgi\">\n";
	print "<Input Type=Hidden Name=MODE Value=MAKE>\n";
	print "<Input Type=Hidden Name=ACTION Value=WRITE>\n";
	print "<Input Type=Hidden Name=NAME Value=$FORM{'NAME'}>\n";
	print "<Input Type=Hidden Name=MAIL Value=$FORM{'MAIL'}>\n";
	print "<Input Type=Hidden Name=QUESTION Value=\"$FORM{'QUESTION'}\">\n";
	print "<Center>\n";
	print "<HR>問題<HR> <BR>\n";

	$FORM{'QUESTION'} =~ s/\r\n/<BR>/g;
	$FORM{'QUESTION'} =~ s/\r|\n/<BR>/g;
	$FORM{'QUESTION'} =~ s/<BR><BR>/<BR> <BR>/g;

	print "$FORM{'QUESTION'}<BR><BR>\n";
	print "<HR>選択肢<HR>\n";
	$i=0;
	print "<Table>\n";
	foreach(@AnsSel){
		print "<TR><TD>$_</TD>";
		if($i == $AnsOK){ print "<TD>←正解</TD>"; }
		print "</TR>\n";
		$i++;
		print "<Input Type=Hidden Name=A$i Value=$_>\n";
	}
	print "</Table>\n<HR>\n";
	$AnsOK++;
	print "<Input Type=Hidden Name=ROK Value=A$AnsOK>\n";
	$i = @AnsSel;
	print "<Input Type=Hidden Name=ACNT Value=$i>\n";
	print "この問題を書きこんでよろしいですか？<BR>\n";
	print "書きなおす場合は、ブラウザの戻るボタンで戻って、修正してください。<BR> <BR>\n";
	print "<Input Type=Submit Value=\"-----書込実行----\">";
	print "</Center></Form>\n";

	&PrintFooter;
}
#--問題データ書込処理--#
sub MakeQuestionWrite{
	local(@lines, $n, @Data, @NewData, $Key, );


	&SetCookie($FORM{'NAME'},$FORM{'MAIL'},$COOKIE{'userpass'},$COOKIE{'adminpass'});

	&FileLock;

	open(IN,"$QueFile") || &CGIError("Can't open $QueFile");
	@lines = <IN>;
	close(IN);

	$FORM{'QUESTION'} =~ s/\r\n/<BR>/g;
	$FORM{'QUESTION'} =~ s/\r|\n/<BR>/g;
	$FORM{'QUESTION'} =~ s/<BR><BR>/<BR> <BR>/g;

	$Key = shift(@lines) + 1;
	push(@Data,"KEY=" . $Key);
	push(@Data,"DATE=" . time);
	push(@Data,"NAME=" . $FORM{'NAME'});
	push(@Data,"MAIL=" . $FORM{'MAIL'});
	push(@Data,"QUE=" . $FORM{'QUESTION'});
	push(@Data,"ACNT=" . $FORM{'ACNT'});
	push(@Data,"ANS=" . $FORM{'ROK'});
	foreach(1..$FORM{'ACNT'}){
		$n = "A" . $_;
		push(@Data, "$n=" . $FORM{$n});
	}

	push(@NewData, $Key . "\n");
	push(@NewData, join("\t", @Data, "\n"));
	push(@NewData, @lines);

	open(OUT,">$QueFile") || &CGIError("Can't open $QueFile");
	print OUT @NewData;
	close(OUT);

	&FileUnLock;

	$COOKIE{'name'} = $FORM{'NAME'};
	$COOKIE{'mail'} = $FORM{'MAIL'};

	&MakeQuestionForm;
}
#---------------------------------#
#___管理者モード
#---------------------------------#
sub AdminProc{
	$RetNG = 0;
	if($FORM{'ACTION'} eq "DELFORM"){
		&DeleteForm;
	}elsif($FORM{'ACTION'} eq "DELETE"){
		&DeleteExec;
	}elsif($FORM{'ACTION'} eq "PASS"){
		&AdminPassForm;
	}else{
		&CheckAdminPass;
		&AdminMenu;
	}
	exit(0);
}
#--パスワード確認画面--#
sub AdminPassForm{
	&PrintContentType;
	&PrintHeader;
	print <<__EOF__;
<Center>
<HR>
<Font Size=+2>管理者パスワード確認画面</Font>
<HR>
パスワードを入力してください。
<HR>
<Form  Method="$Method" Action="$MeCgi">
<Input Type=Hidden Name="MODE" value="ADMIN">
<Input Type=PassWord Name="PASS" Value="$COOKIE{'adminpass'}">
<Input Type=submit value=" OK ">
</Form>
<HR>
</Center>
__EOF__
	&PrintFooter;
}

#--管理者パスワード確認--#
sub CheckAdminPass{
	if($FORM{'PASS'} eq $AdminPassWord){
		&SetCookie($COOKIE{'name'},$COOKIE{'mail'}, $COOKIE{'userpass'}, $FORM{'PASS'});
	}else{
		&CGIError("パスワードが違います。");;
	}
}
#--管理者メニュー表示--#
sub AdminMenu{
	&PrintContentType;
	&PrintHeader;
	&PrintMenu("C");
print <<__Eof__;
<Center><font size=+1 color=000000><b>
管理者メニュー</b></font>
<HR>
<A Href="$MeCgi?MODE=MAKE&PASS=$UserPassWord">問題作成</A><BR> <BR>
<A Href="$MeCgi?MODE=ADMIN&ACTION=DELFORM&PAGE=1">問題削除</A>
<HR>
</Center>
__Eof__
	&PrintFooter;
	exit(0); #強制終了
}
#--削除フォーム表示--#
sub DeleteForm{
	local($Date, $Name, $n, $M, $Page, $Start, $End);

	open(IN,"$QueFile") || &CGIError("Can't open $QueFile");
	local(@lines) = <IN>;
	close(IN);
	shift(@lines);

	if($DelPageCnt){
		$Start = ($FORM{'PAGE'} - 1) * $DelPageCnt;
		$End = $Start + $DelPageCnt - 1;
		if($End >= @lines){$End = @lines - 1;}
	}else{
		$Start = 0;
		$End = @lines - 1;
	}

	&PrintContentType;
	&PrintHeader;
	&PrintMenu("C");

	print "<Center>\n";
	print "削除画面<HR>\n";
	print "<center><A Href=\"$MeCgi?MODE=ADMIN&ACTION=PASS\" Target=_top>管理メニューに戻る</A><hr></center>";

	print "<Form  Method=\"post\">\n";
    print "<INPUT TYPE=\"checkbox\">\n";
    print "をチェックして削除実行ボタンを押してください。<BR>\n";
	print "</Form>\n";

	print "<Form  Method=\"$Method\" Action=\"$MeCgi\">\n";
	print "<Input Type=Hidden Name=MODE Value=ADMIN>\n";
	print "<Input Type=Hidden Name=ACTION Value=DELETE>\n";
	print "<Table Border=1 Width=\"100%\">\n";
	print "<TR>\n";
	print "<TD Align=Center>□</TD>\n";
	print "<TD Align=Center>No</TD>\n";
	print "<TD Align=Center>登録年月日</TD>\n";
	print "<TD Align=Center>登録者</TD>\n";
	print "<TD Align=Center>問題</TD>\n";
	print "<TD Align=Center>解答</TD>\n";
	print "</TR>\n";
	foreach($Start..$End){
		print "<TR>\n";
		&SplitQue($lines[$_]);
		$Date = &FormatDateTime($QUE{'DATE'});
		if($QUE{'MAIL'} ne ""){
			$Name = "<A Href=\"mailto:". $QUE{'MAIL'} . "\">" . $QUE{'NAME'} . "</A>";
		}else{
			$Name = $QUE{'NAME'};
		}
		$Anser = "";
		foreach(1..$QUE{'ACNT'}){
			$n = "A" . $_;
			if($n eq $QUE{'ANS'}){$M = "Ｏ";}else{$M = "Ｘ";}
			$Anser = $Anser . $M . $QUE{$n} . "<BR>";
		}
		print "<TD Align=Center>";
		print "<Input Name=DELETEID Type=CheckBox Value=" . $QUE{'KEY'} . "></TD>";
		print "<TD Align=Right>" . $QUE{'KEY'} . "</TD>\n";
		print "<TD Align=Center>$Date</TD>\n";
		print "<TD Align=Center>$Name</TD>\n";
		print "<TD Align=Left>" . $QUE{'QUE'} . "</TD>\n";
		print "<TD Align=Left>$Anser</TD>\n";
		print "</TR>\n";
	}

	print "</Table>\n";
	print "<BR> <Input Type=Submit Value=\"-----削除実行----\">";
	print "</Form>\n";

	if($FORM{'PAGE'} > 1){
		$Page = $FORM{'PAGE'} - 1;
		print "<Form  Method=\"$Method\" Action=\"$MeCgi\">\n";
		print "<Input Type=Hidden Name=MODE Value=ADMIN>\n";
		print "<Input Type=Hidden Name=ACTION Value=DELFORM>\n";
		print "<Input Type=Hidden Name=PAGE Value=$Page>\n";
		print "<Input Type=Submit Value=\"前のページ\">";
		print "</Form>\n";
	}
	if($End < @lines - 1){
		$Page = $FORM{'PAGE'} + 1;
		print "<Form  Method=\"$Method\" Action=\"$MeCgi\">\n";
		print "<Input Type=Hidden Name=MODE Value=ADMIN>\n";
		print "<Input Type=Hidden Name=ACTION Value=DELFORM>\n";
		print "<Input Type=Hidden Name=PAGE Value=$Page>\n";
		print "<Input Type=Submit Value=\"次のページ\">";
		print "</Form>\n";
	}
	print "</Center>\n";
	&PrintFooter;
	exit(0); #強制終了
}
#--削除実行--#
sub DeleteExec{
	local($l, $DFlag,@NewLines);

	if(!@DeleteID){&DeleteForm;}

	&FileLock;

	open(IN,"$QueFile") || &CGIError("Can't open $QueFile");
	local(@lines) = <IN>;
	close(IN);
	push(@NewLines, shift(@lines));

	foreach $l(@lines){
		&SplitQue($l);
		$DFlag = 1;
		foreach(@DeleteID){
			if($QUE{'KEY'} eq $_){
				$DFlag = 0;
				last;
			}
		}
		if($DFlag){ push(@NewLines, $l);}
	}

	open(OUT,">$QueFile") || &CGIError("Can't open $QueFile");
	print OUT @NewLines;
	close(OUT);

	&FileUnLock;

	$FORM{'PAGE'} = 1;
	&DeleteForm;
}
#---------------------------------#
#___エラー表示
#---------------------------------#
sub CGIError{
	local($msg) = @_;
	&FileUnLock;
	&PrintContentType;
	&PrintHeader;
print <<__Eof__;
<Center>
<HR>
エラー発生
<HR>
<BR> <BR>
<Font Size=+1>$msg</Font>
<BR> <BR> <BR>
<HR>
ブラウザの戻る(Back)ボタンで前に戻ってください。
</Center>
__Eof__
	&PrintFooter;
	exit(0); #強制終了
}
#---------------------------------#
#___初期処理
#---------------------------------#
sub InitProc{
	local($i,$Max);
	require "$JcodeLib";

	&GetCookie;

	&InitFormNorm($kanjicode);

	$JScriptNavCheck = <<__EOF__;
<Script Language="JavaScript">
<!--JavaScript
if(Nav) document.write("<Input Type=Hidden Name=NAV Value=OK>");
//-->
</Script>
__EOF__

	$TimeIMG = "";
	if($TimeImgMode){
		foreach(1..$Timer){
			$TimeIMG = $TimeIMG . "<Img Src=\"$TimeImgOff\">";
		}
	}
}
#---------------------------------#
#___CGIヘッダ出力
#---------------------------------#
sub PrintContentType{
	print "Content-type: text/html\n\n";
}
#---------------------------------#
#___HTMLヘッダ出力
#---------------------------------#
sub PrintHeader{
	print "<HTML>\n<HEAD>\n$META_TAG\n";
	print "<TITLE>$HeadTitle</TITLE>\n";
	if($RetNG){ &JScriptNav; &JScriptTimer;}
	print "</HEAD>\n";

	if($BackGround eq ""){
		print "<Body BGColor=$BackColor Text=$TextColor Link=$LinkColor";
		print " VLink=$VLinkColor ALink=$ALinkColor>\n";
	}else{
		print "<Body BackGround=\"$BackGround\" BGColor=$BackColor";
		print " Text=$TextColor";
		print " Link=$LinkColor VLink=$VLinkColor ALink=$ALinkColor>\n";
	}
	print "<center><table width=700><tr><td width=150></td><td width=400><Center>$MainTitle</Center></td><td width=150 align=center>\n";
if ($daycounter == 1){
#-- #--- カウンタ設定 -----これは、掲示板付属品ではありません----# 
#-- #--- KENTさんの所のdayカウンタをUPすると表示されます。----# 
#-- #--- カウンタ設定終了 -------でもKENT(OIDON)さんのです---------#
#-- #--- カウンタ設定 -----これは、掲示板付属品ではありません----# 
 }
	print "</td></tr></table></center>\n";
}

#---------------------------------#
#___HTMLフッタ出力
#---------------------------------#
sub PrintFooter{
	print "\n<center><hr><font size=-1>---- script by <a href=\"http://www.ca.sakura.ne.jp/~qz/\">Qz </a>--- design by <a href=\"http://aquafish.net/marita/\">marita</a> -----<hr></center>";
	print "\n</BODY></HTML>";
}
#---------------------------------#
#___登録日時形式化
#---------------------------------#
sub FormatDateTime{
	local($sec, $min, $hour, $day, $mon, $year, $wday, $key);
	local(@weekname) = ("(Sun)","(Mon)","(Tue)","(Wed)","(Tur)","(Fri)","(Sut)");
	( $sec, $min, $hour, $day, $mon, $year, $wday ) = localtime($_[0]);
	$year += 1900;
	$mon++;
	# 必要なら０を付加する
	if ($mon < 10) {$mon = "0$mon";}
	if ($day < 10) {$day  = "0$day";}
	if ($hour < 10) {$hour = "0$hour";}
	if ($min < 10) {$min  = "0$min";}
	if ($sec < 10) {$sec  = "0$sec";}

	return "$year/$mon/$day $hour:$min$weekname[$wday]";
}
#---------------------------------#
#___クッキー発行
#---------------------------------#
sub SetCookie {
	local($name) = $_[0];
	local($mail) = $_[1];
	local($usrpass) = $_[2];
	local($admpass) = $_[3];
	local($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg)
					 = gmtime(time + 30*24*60*60);
	if ($yearg < 10) { $yearg = "0$yearg"; }
	if ($secg  < 10) { $secg  = "0$secg";  }
	if ($ming  < 10) { $ming  = "0$ming";  }
	if ($hourg < 10) { $hourg = "0$hourg"; }
	if ($mdayg < 10) { $mdayg = "0$mdayg"; }
	$month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct',
						'Nov','Dec')[$mong];
	$youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday',
						'Saturday')[$wdayg];
	$date_gmt = "$youbi, $mdayg\-$month\-$yearg $hourg:$ming:$secg GMT";

	$cook="name\:$name\,mail\:$mail\,userpass\:$usrpass\,adminpass\:$admpass";

	print "Set-Cookie: Ntaku=$cook; expires=$date_gmt\n";
}
#---------------------------------#
#___クッキー取得
#---------------------------------#
sub GetCookie { 
	@pairs = split(/;/,$ENV{'HTTP_COOKIE'});
	foreach $pair (@pairs) {
		local($name, $value) = split(/=/, $pair);
		$name =~ s/ //g;
		$DUMMY{$name} = $value;
	}
	@pairs = split(/,/,$DUMMY{'Ntaku'});
	foreach $pair (@pairs) {
		local($name, $value) = split(/:/, $pair);
		$COOKIE{$name} = $value;
	}
}

#----------------------------------------------#
#___ フォームからの情報を連想配列 %form に入れる
#                 使用例 &InitFormNorm('euc');
#----------------------------------------------#
sub InitFormNorm {
	local($query, @assocarray, $assoc, $property, $value, $charcode, $method);
	$charcode = $_[0];
	$method = $ENV{'REQUEST_METHOD'};
	$method =~ tr/A-Z/a-z/;
	if ($method eq 'post') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	} else {
		$query = $ENV{'QUERY_STRING'};
	}
	@assocarray = split(/&/, $query);
	foreach $assoc (@assocarray) {
		($property, $value) = split(/=/, $assoc);
		$value =~ tr/+/ /;
		$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
		&jcode'convert(*value, $charcode);
		if($KanaChange){ &jcode'h2z_sjis(*value); }
		$property =~ tr/a-z/A-Z/;
		if($property eq 'DELETEID'){
			push(@DeleteID,$value);
		}else{
			$FORM{$property} = $value;
		}
	}
}

#-----------------------------------------------------------
#___ロック
#-----------------------------------------------------------
sub FileLock{
	local($Retry) = 5;
	if(! $LockMode){ return; }
	foreach(1..$Retry){
		if(-e "$LockFile"){
			local($mtime) = (stat($LockFile))[9];
			if ($mtime < time() - 600) {
				unlink($LockFile);
			}else{
				sleep(1);
			}
		}else{
			open(LOCK,">$LockFile") || &cgi_error;
			close(LOCK);
			return;
		}
	}
	&cgi_error;
}
#--------------------------------------------------------------------
#___ロック解除
#--------------------------------------------------------------------
sub FileUnLock{
	if(-e "$LockFile"){
		unlink($LockFile);
	}
}

#-----------------------------------------------------------End of Script
#---更新履歴---
#1999/04/10          制作開始
#1999/04/12          1.00