#!/usr/local/bin/perl
use vars qw(%set %in);
use TH7Replay;
require "th95spells.pl";
require "th10def.pl";
#use strict;
#
##############################################################################
# SN Uploader / シューティング板「東方シリーズ攻略スレッド」仕様
$thver = "threp v1.16 2007-05-24";
##############################################################################
#

####################
# 基本設定
####################

# HTMLのタイトルを指定します。
$set{'page_title'} = "東方リプろだ";

# 管理者ログインIDを指定します。この値は必ず変更してください。
$set{'admin_name'} = 'admin'; 

# 管理者パスワードを指定します。この値は必ず変更してください。
$set{'admin_pass'} = '1234';

# 履歴の保持件数を指定します。
$set{'max_log'} = 500; 

# 1ページに表示するファイル数を指定します。
$set{'pagelog'} = 50; 

# [HOME]のリンク先 相対パス又は http://から始まる絶対パス
$set{'home_url'} = ''; 

# リプレイの保存ディレクトリを指定します。
# この値は相対指定が可能です。
$set{'src_dir'} = './src/'; 





####################
# その他設定
####################
# フッタの追加文字列を指定します。
$set{'modify_info'} = ' / シューティング板「東方シリーズ攻略スレッド」仕様';
$set{'html_all'} = 1; #[ALL]を出す=1
$set{'log_file'} = './log.cgi'; #ログファイル名
$set{'max_size'} = 1*256; #最大投稿容量(KB)
$set{'min_flag'} = 0; #最小容量制限を使用する=1
$set{'min_size'} = 100; #最小投稿容量(KB)
$set{'max_all_flag'} = 0; #総容量制限を使用する=1
$set{'max_all_size'} = 20*1024; #総制限容量(KB)
$set{'file_pre'} = 'ud'; #ファイル接頭辞
$set{'base_cgi'} = './upload.cgi'; #このスクリプト名
$set{'base_html'} = './upload.html'; #1ページ目のファイル名
$set{'interval'} = 0; #同一IP投稿間隔秒数
$set{'deny_host'} = ''; #投稿禁止IP/HOST ,で区切る ex.(bbtec.net,219.119.66,ac.jp)
$set{'up_ext'} = 'rpy'; #アップロードできる基本拡張子 半角英数小文字 ,で区切る
$set{'up_all'} = 0; #登録以外のものもUPさせられるようにする=1
$set{'ext_org'} = 0; #$set{'up_all'}が1の時オリジナルの拡張子にする=1
$set{'deny_ext'} = 'php,php3,phtml,rb,sh,bat,dll';	#投稿禁止の拡張子 半角英数小文字 ,で区切る
$set{'change_ext'} = 'cgi->txt,pl->txt,log->txt,jpeg->jpg,mpeg->mpg'; #拡張子変換 前->後 半角英数小文字 ,で区切る
$set{'dummy_html'} = 0; #ファイル個別HTMLを作成する=1
$set{'find_crypt'} = 1; #暗号化ZIP/RAR/GCAを検出する=1
$set{'binary_compare'} = 1; #既存ファイルとバイナリ比較する=1
$set{'post_flag'} = 0; #PostKeyを使用する=1
$set{'post_key'} = 'postkey'; #PostKey ,で区切ると複数指定 ex.(postkey1,postkey2)
$set{'disp_error'} = 1; #ユーザーにエラーを表示する=1
$set{'error_level'} = 1; #エラーログを記録する=1
$set{'log_error'} = './error.cgi'; #エラーログファイル名
$set{'zero_clear'} = 1; #ファイルが見つからない場合ログから削除する=1

$set{'disp_comment'} = 1;  #コメントを表示する=1
$set{'disp_date'} = 1; #日付を表示する=1
$set{'disp_size'} = 1; #サイズを表示する=1
$set{'disp_mime'} = 0; #MIMETYPEを表示する=1
$set{'disp_orgname'} = 1; #オリジナルファイル名を表示する=1

$set{'per_upfile'} = 0666; #アップロードファイルのパーミッション suexec=0604,other=0666
$set{'per_dir'} = 0777; #ソースアップディレクトリのパーミッション suexec=0701,other=0777
$set{'per_logfile'} = 0666; #ログファイルのパーミッション　suexec=0600,other=0666
$set{'http_src_path'} = ''; #設定する場合PATHは/で終わる事
$set{'charset'} = 'Shift_JIS'; #HTMLMETA-Charset
$set{'link_target'} = ''; #target属性

$set{'replay'} = 1; #リプ用




#------
$set{'ver'} = "10:26 2003/12/06 + $thver";
$set{'del_name'} = 'D';
$in{'time'} = time(); $in{'date'} = conv_date($in{'time'});
$in{'addr'} = $ENV{'REMOTE_ADDR'};
$in{'host'} = gethostbyaddr(pack('c4',split(/\./, $in{'addr'})), 2) || $ENV{'REMOTE_HOST'} || '(none)';
if($in{'addr'} eq $in{'host'}){ $in{'host'} = '(none)'; }
unless(-e $set{'log_file'}){ &init; }
unless(-e $set{'base_html'}){ &makehtml; }
{ #デコード
	my $readbuffsize = 1024*8;
	if ($ENV{'CONTENT_LENGTH'} > ($set{'max_size'} * 1024 + 1024)){ if($ENV{'SERVER_SOFTWARE'} =~ /IIS/){ while(read(STDIN,my $buff,$readbuffsize)){} } &error(106,$ENV{'CONTENT_LENGTH'});}
	my %ck; foreach(split(/;/,$ENV{'HTTP_COOKIE'})){ my($key,$val) = split(/=/); $key =~ s/\s//g; $ck{$key} = $val;}
	my @ck = split(/<>/,$ck{'SN_USER'});
	if(length($ck[0]) < 5){ 
		my @salt = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/'); srand;
		my $salt = $salt[int(rand(@salt))] . $salt[int(rand(@salt))];
		$in{'user'} = crypt($in{'addr'}.$in{'time'}, $salt);
	}else{ $in{'user'} = $ck[0]; }

	if($ENV{'REQUEST_METHOD'} eq "POST" && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/i){
		my %FORM;	my $subbuff; my $filename;	my $valuename;
		my $upflag;	my $valueflag; my $bound;	my $mime;
		
		my $random = int(rand(900000)) + 100000;
		binmode(STDIN);
		while(<STDIN>){	if(/(--.*)\r\n$/){ $bound = $1; last; }}
		if(-e "$set{'src_dir'}$random.temporary"){ $random++; }
		if(-e "$set{'src_dir'}$random.temporary"){ $random++; }
		if(-e "$set{'src_dir'}$random.temporary"){ &error(204); }

		open(OUT,">$set{'src_dir'}$random.temporary");
		binmode(OUT);
		my $formbuff;
		my $readlength = 0;
		while(my $buff = <STDIN>){
			$readlength += length($buff);
			if($upflag == 1){ if($buff =~ /Content-Type:\s(.*)\r\n$/i){ $mime = $1; } $upflag++; next;}
			if($upflag == 2){
				while(read(STDIN,my $filebuff,$readbuffsize)){
					$readlength += length($filebuff);
					if($ENV{'CONTENT_LENGTH'} - $readlength < $readbuffsize){ read(STDIN,my $subbuff,$readbuffsize); $filebuff .= $subbuff; }
					my $offset = index($filebuff,$bound);
					if($offset >= 0){
						$buff = substr($filebuff,0,$offset-2); my $subbuff = substr($filebuff,$offset);
						print OUT $buff; $upflag = 0; $formbuff .= $subbuff; last;
					}else{ print OUT $filebuff;	}
				}
				next;
			}
			if($buff =~ /^Content-Disposition:\sform-data;\sname=\"upfile\";\sfilename=\"(.*)\"\r\n$/i){
				$filename = $1;	$upflag = 1; next;
			}
			$formbuff .= $buff;
		}
		close(OUT);
		chmod($set{'per_upfile'},"$set{'src_dir'}$random.temporary");
		{ my $value;
			foreach my $buff(split(/\r\n/,$formbuff)){
				$buff .= "\r\n";
				if($buff =~ /^$bound\-\-/){ $FORM{$value} =~ s/\r\n$//; $valueflag = 0; last;}
				if($buff =~ /^$bound/){ $FORM{$value} =~ s/\r\n$//; $valueflag = 0; next;}
				if($valueflag == 1){ $valueflag++; next; }
				if($valueflag == 2){ $FORM{$value} .= $buff; }
				if($buff =~ /^Content-Disposition: form-data; name=\"(.+)\"\r\n$/){ $value = $1; $valueflag++; }
			}
		}
		if($upflag || $valueflag){ unlink("$set{'src_dir'}$random.temporary"); &error(108);}

		$in{'org_pass'} = $in{'pass'} = $FORM{'pass'};
		$in{'comment'} = $FORM{'comment'};
		$in{'jcode'} = $FORM{'jcode'};
		$in{'postkey'} = $FORM{'postkey'};
		
		$in{'addcomment'}=$FORM{'addcomment'};
		$in{'th10char'}=$FORM{'th10char'};
		$in{'th10level'}=$FORM{'th10level'};
		
		$in{'upfile'} = $filename;
		$in{'type'} = $mime;
		$in{'tmpfile'} = "$set{'src_dir'}$random.temporary";
		$in{'orgname'} = $in{'upfile'};
		if(-s "$in{'tmpfile'}" == 0){ unlink("$in{'tmpfile'}"); &error(99) }
		if($set{'min_flag'} && ((-s "$in{'tmpfile'}") < $set{'min_size'} * 1024)){ &error(107,(-s "$in{'tmpfile'}"));}
		if((-s "$in{'tmpfile'}") > $set{'max_size'} * 1024){ &error(106,(-s "$in{'tmpfile'}"));}
		if($set{'post_flag'} && !check_postkey($in{'postkey'})){ &error(109); }
	}else{
		my ($buffer,%FORM,@admin_delno);
		if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});}
		else { $buffer = $ENV{'QUERY_STRING'}; }
		my @pairs = split(/&/,$buffer);
		foreach my $pair (@pairs) {
			my ($name, $value) = split(/=/, $pair);
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			if($name eq 'admin_delno'){
				push(@admin_delno,$value);
			}else{
				$FORM{$name} = $value;
			}
		}
		$in{'delpass'} = $FORM{'delpass'};
		$in{'delno'} = $FORM{'delno'};
		$in{'mode'} = $FORM{'mode'};
		$in{'checkmode'} = $FORM{'checkmode'};
		$in{'admin_delno'} = join(',',@admin_delno);
		if($in{'delno'} eq $set{'admin_name'} && $in{'delpass'} eq $set{'admin_pass'}){ &admin_mode(); }
		if(!$in{'delno'} && $in{'delpass'} eq $set{'admin_pass'}){ &makehtml; &quit; }
	}

	my @denyhost = split(/,/,$set{'deny_host'});
	foreach my $value (@denyhost){
		if ($in{'addr'} =~ /$value/ || $in{'host'} =~ /$value/){ &error(101);}
	}

	if (length($in{'comment'}) > 128) { $in{'comment'} = substr($in{'comment'},0,128).'...'; }
	my @form = ($in{'comment'},$in{'orgname'},$in{'type'});
	foreach my $value (@form) {
#		$value =~ s/&/&amp;/g;
		$value =~ s/"/&quot;/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\r//g;
		$value =~ s/\n//g;
	}
	($in{'comment'},$in{'orgname'},$in{'type'}) = @form;
}


if($in{'mode'} eq 'delete'){ &delete; &quit; } #削除
if(!$in{'upfile'}){ &error(99); }

{#メイン処理

	open(IN,$set{'log_file'})||&error(303);
	my @log = <IN>;
	close(IN);
	my ($no,$lastip,$lasttime) = split(/<>/,$log[0]);

	if($set{'interval'} && $in{'time'} <= ($lasttime + $set{'interval'}) && $in{'addr'} eq $lastip){ &error(203);}
	$in{'ext'} = extfind($in{'orgname'}); if(!$in{'ext'}){ &error(202); }

	my $orgname;
	if(split(/\//,$in{'orgname'}) > split(/\\/,$in{'orgname'})){	my @name = split(/\//,$in{'orgname'}); $orgname = $name[$#name]; }
	else{ my @name = split(/\\/,$in{'orgname'}); $orgname = $name[$#name];}
	
	my @salt = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
	srand;
	my $salt = $salt[int(rand(@salt))] . $salt[int(rand(@salt))];
	$in{'pass'} = crypt($in{'pass'}, $salt);

	if($set{'binary_compare'}){
		my @files = globfile("$set{'src_dir'}",".*");
		foreach my $value (@files){
			next if($value =~ /\.temporary$/);
			if(binarycmp($in{'tmpfile'},$value)){ unlink($in{'tmpfile'}); &error(205,$value);}
		}
	}

	if($set{'find_crypt'}){
		open(FILE,$in{'tmpfile'}); binmode(FILE); seek(FILE,0,0); read(FILE,my $buff,4); my $crypt_flag = 0;
		if($buff =~ /^\x50\x4b\x03\x04$/){ seek(FILE,6,0); read(FILE,my $buff,1); $crypt_flag = 1 if(($buff & "\x01") eq "\x01");
		}elsif($buff =~ /^\x47\x43\x41\x58$/){ 
			seek(FILE,8,0); read(FILE,my $length,8);	seek(FILE,hex(unpack("H*",reverse $length)) + 4,0);
			read(FILE,my $buff,1); $crypt_flag = 1 if(($buff & "\x20") eq "\x20");
		}elsif($buff =~ /^\x52\x61\x72\x21$/){
			my ($crc,$headno,$flag,$headsize,$packsize,$unpacksize);
			seek(FILE,7,0);
			while(read(FILE,$crc,2)){
				read(FILE,$headno,1);read(FILE,$flag,1); seek(FILE,1,1); read(FILE,$headsize,2); $headsize = hex(unpack("H*",reverse $headsize));
				if(($flag & "\x80") ne "\x00"){
					read(FILE,$packsize,4);	$packsize = hex(unpack("H*",reverse $packsize));
					read(FILE,$unpacksize,4); $unpacksize = hex(unpack("H*",reverse $unpacksize));
					$packsize -= 8;
				}
				if($headno eq "\x74"){
					if(($flag & "\x04") eq "\x04"){	$crypt_flag = 1; last; }
					elsif($unpacksize != 0){ last; }
				}elsif(($headno & "\x70") ne "\x70"){
					$in{'comment'} = '<font color="#FFA500">*</font>'.$in{'comment'}; last;
				}
				seek(FILE,$headsize + $packsize - 7 ,1);
			}
		}
		close(FILE);
		$in{'comment'} = '<font color="#FF0000">*</font>'.$in{'comment'} if($crypt_flag);
	}
	
	####################################
	#リプ処理
	####################################
	
	# 6:紅魔郷 7:妖々夢 8:永夜抄 9:花映塚 95:文花帖 10:風神録 x:不明
	my $gameId = "x"; 
	
	# 0:game 1:name 2:time 3:girls 4:score 5:difficulty 6:stage/spellno 
	# 7:miss 8:bomb 9:slow 10:human 11:version 12:comment
	my @rep_info; 
	
	if($set{'replay'}){

		open(FILE,"+<",$in{'tmpfile'}); 
		binmode(FILE); 
		seek(FILE,0,0); 
		read(FILE,my $buff,4);
		$rep_info='その他のファイル';
		
		####################################
		# 紅魔郷
		####################################
		if ($buff eq "T6RP"){
			$rep_info[0]='紅魔郷';
			$gameId = "6";
	
			eval {
				seek FILE, 0, 0;
				my $read = read FILE, my $head, 0x30;
				die "壊れたリプレイファイル"if $read < 0x30;
				my @bites = unpack 'C*', $head;
				
				# Decryption
				my $key = $bites[ 0x0e ];
				for ( my $i = 0x0f; $i < 0x30; $i++ ) {
					$bites[ $i ] = ( $bites[ $i ] + 0x100 - $key ) & 0xff;
					$key = ( $key + 0x07 ) & 0xff;
				}
				
				die "壊れたリプレイファイル"if $bites[ 0x06 ] >= 0x04;
				die "壊れたリプレイファイル"if $bites[ 0x07 ] >= 0x05;
				
				
				$rep_info[1] = pack 'C*', @bites[ 0x19 .. 0x20 ]; # name
				$rep_info[2] = pack 'C*', @bites[ 0x10 .. 0x17 ]; # time
				$rep_info[3] = ( 
					'博麗 霊夢（霊符）', 
					'博麗 霊夢（夢符）', 
					'霧雨 魔理沙（魔符）', 
					'霧雨 魔理沙（恋符）' 
				)[ $bites[ 0x06 ] ]; 
				$rep_info[4] = unpack 'V', pack 'C*', @bites[ 0x24 .. 0x27 ]; #score
				$rep_info[5] = ( 'Easy' , 'Normal' , 'Hard', 'Lunatic', 'Extra' )[ $bites[ 0x07 ] ];
				$rep_info[6] = ''; # stage
				$rep_info[7] = ''; # miss
				$rep_info[8] = ''; # bomb
				$rep_info[9] = sprintf "%3.6f%", unpack 'f', pack 'C*', @bites[ 0x2c .. 0x2f ]; #slow 
				$rep_info[10] = ''; # human
				$rep_info[11] = ''; # version
			};
			if ( $@ ) {
				# ここにくるときは多分リプレイファイルが壊れている
				$rep_info[12] = 
					"（リプレイファイルの情報を読み取れませんでした）";
			}
		}
		
		####################################
		# 妖々夢
		####################################
		if ($buff eq "T7RP"){
			$rep_info[0]='妖々夢';
			$gameId = "7";
			
			#[date, player, char, score, rank, version. drop]
			@th7info = TH7Replay_getReplayFileInfo($in{'tmpfile'});
			%girls_def = (
				"ReimuA" => "博麗 霊夢（霊符）",
				"ReimuB" => "博麗 霊夢（夢符）",
				"MarisaA" => "霧雨 魔理沙（魔符）",
				"MarisaB" => "霧雨 魔理沙（恋符）",
				# 十六夜 咲夜（幻符）
				"SakuyaA" => "\x8f\\六夜 咲夜（幻符）",
				# 十六夜 咲夜（時符）
				"SakuyaB" => "\x8f\\六夜 咲夜（時符）"
			);
			
			if(length($th7info[0]) > 0){
				$rep_info[1] = $th7info[1]; # name
				$rep_info[2] = $th7info[0]; # time
				$rep_info[3] = $girls_def{$th7info[2]}; # girls
				$rep_info[4] = $th7info[3]; # score
				$rep_info[5] = $th7info[4]; # difficulty
				$rep_info[6] = ""; # stage
				$rep_info[7] = ""; # miss
				$rep_info[8] = ""; # bomb
				$rep_info[9] = $th7info[6] . "%"; # slow
				$rep_info[10] = ""; # human
				$rep_info[11] = $th7info[5]; #version
				#$rep_info[12] = ''; # comment
			}
			else{
				$rep_info[12] = 
					"（リプレイファイルの情報を読み取れませんでした）";
			}
		}
		
		####################################
		# 永夜抄
		####################################
		if ($buff eq "T8RP"){
			$rep_info[0]='永夜抄';
			$gameId = "8";
			
			my $offset, $length, $info;
			
			seek (FILE, 12, 0);
			read (FILE, $offset, 4);
			$offset = unpack ("L", $offset);

			$length = (stat (FILE))[7] - $offset;
			seek (FILE, $offset, 0);
			read (FILE, $info, $length);
			
			if ($info =~ /
\Qプレイヤー名\E\t(.+)\r\n
\Qプレイ時刻\E\t(.+)\r\n
\Qキャラ名\E\t(.+)\r\n
\Qスコア\E\t\t(.+)\r\n
\Q難易度\E\t\t(.+)\r\n
(\Q最終ステージ\E|\Qカード名\E)\t(.+)\r\n
\Qミス回数\E\t(.+)\r\n
\Qボム回数\E\t(.+)\r\n
\Q処理落ち率\E\t(.+)\r\n
\Q人間率\E\t\t(.+)\r\n
\Qゲームのバージョン\E\t(.+)\r\n
\0*(USER.{8}([\s\S]*)\0+)?
/x)
			{
				my $real_comment_length = length ($13);
				
				$rep_info[1]=$1; # name
				$rep_info[2]=$2; # time
				$rep_info[3]=$3; # girls
				$rep_info[4]=$4; # score
				$rep_info[5]=$5; # difficulty
				$rep_info[6]=$7; # stage
				$rep_info[7]=$8; # miss
				$rep_info[8]=$9; # bomb
				$rep_info[9]=$10; # slow
				$rep_info[10]=$11; # human
				$rep_info[11]=$12; #version
				$rep_info[12]=$14; # comment
				
				if ($in{'addcomment'} eq 'add' && $in{'comment'} ne ""){
					my $new, $comment_text;
					
					$comment_text = $rep_info[12]
					  . ($rep_info[12] ne "" ? "\r\n" : "")
					  . $in{'comment'};
					
					$new = "USER"
					  . pack ("L", length ($comment_text) + 13)
					  . "\x01\x00\x10\x01" . $comment_text . "\0";
					seek (FILE, -$real_comment_length, 2);
					print FILE $new;
					truncate (FILE, tell (FILE));
				}
				$rep_info[12] =~ s{\r\n}{  }g;
			}
			else{
				$rep_info[12] = '（リプレイファイルの情報を読み取れませんでした）';
			}
		}
		
		####################################
		# 花映塚
		####################################
		if ($buff eq "T9RP"){
			my $offset, $length, $info;
			$rep_info[0] = "花映塚";
			$gameId = "9";
			seek (FILE, 12, 0);
			read (FILE, $offset, 4);
			$offset = unpack ("L", $offset);

			$length = (stat (FILE))[7] - $offset;
			seek (FILE, $offset, 0);
			read (FILE, $info, $length);

			if ($info =~ /
\Qプレイヤー名\E\t(.*)\r\n
\Qプレイ時刻\E\t(.+)\r\n
\Q難易度\E\t\t(.+)\r\n
\Qモード\E\t\t(.+)\r\n
(使用|対戦)キャラ\t\t(.+)\r\n
(\Q初期体力\E\t\t(.+)\r\n)?
\Qゲームのバージョン\E\t(.+)\r\n
\0+(.{12}([\s\S]*)\0+)?
/x)
			  {
				my $real_comment_length = length ($10);

				$rep_info[1] = $1; # name
				$rep_info[2] = $2; # time
				$rep_info[3] = $6; # girls
				$rep_info[4] = ""; # score
				$rep_info[5] = $3; # difficulty
				$rep_info[6] = $4; #stage
				$rep_info[7] = ""; # miss
				$rep_info[8] = ""; # bomb
				$rep_info[9] = ""; # slow
				$rep_info[10] = "$8"; # human
				$rep_info[11] = $9; # version
				$rep_info[12] = $11; # comment

				$rep_info[11] =~ s/東方花映塚 ver //;

				if ($in{'addcomment'} eq 'add' && $in{'comment'} ne ""){
					my $new, $comment_text;

					$comment_text = $rep_info[12]
					  . ($rep_info[12] ne "" ? "\r\n" : "")
					  . $in{'comment'};
					$new = "USER"
					  . pack ("L", length ($comment_text) + 13)
					  . "\x01\x00\x12\x00" . $comment_text . "\0";
					seek (FILE, -$real_comment_length, 2);
					print FILE $new;
					truncate (FILE, tell (FILE));
				}
				$rep_info[12] =~ s{\r\n}{  }g;
			}
			else{
				$rep_info[12] = '（リプレイファイルの情報を読み取れませんでした）';
			}
		}
		
		####################################
		# 文花帖
		####################################
		
		if ($buff eq "t95r"){
			my $offset, $length, $info;
			$rep_info[0] = "文花帖";
			$gameId = "95";
			seek (FILE, 12, 0);
			read (FILE, $offset, 4);
			$offset = unpack ("L", $offset);

			$length = (stat (FILE))[7] - $offset;
			seek (FILE, $offset, 0);
			read (FILE, $info, $length);

			if ($info =~ /
\QVersion \E(.+)\r+\n
\QName \E(.+)\r+\n
\QLevel \E(.+)\r+\n
\QScene \E(.+)\r+\n
\QDate \E(.+)\r+\n
\QScore \E(.+)\r+\n
\QSlow Rate \E(.+)\r+\n
\0+(USER.{8}([^\0]*)\0+)?
/x)

			  {
				my $real_comment_length = length ($8);
				my $spell_name = $SPELLS{"$3-$4"};
				my $girl_name = $GIRLS{"$3-$4"};
				
				$rep_info[1] = $2; # name
				$rep_info[2] = $5; # time
				$rep_info[3] = "射命丸 文"; # girls
				$rep_info[4] = $6; # score
				$rep_info[5] = "$3-$4"; # difficulty
				$rep_info[6] = "$spell_name<br>（$girl_name）"; #stage
				$rep_info[7] = ""; # miss
				$rep_info[8] = ""; # bomb
				$rep_info[9] = "$7%"; # slow
				$rep_info[10] = ""; # human
				$rep_info[11] = $1; # version
				$rep_info[12] = $9; # comment
				
				# コメントが初期値のままの場合は削除
				if($rep_info[12] eq "コメントを書けます"){
					$rep_info[12] = "";
				}

				if ($in{'addcomment'} eq 'add' && $in{'comment'} ne ""){
					my $new, $comment_text;

					$comment_text = $rep_info[12]
					  . ($rep_info[12] ne "" ? "\r\n" : "")
					  . $in{'comment'};
					$new = "USER"
					  . pack ("L", length ($comment_text) + 13)
					  . "\x01\x00\x00\x00" . $comment_text . "\0";
					seek (FILE, -$real_comment_length, 2);
					print FILE $new;
					truncate (FILE, tell (FILE));
				}
				$rep_info[12] =~ s{\r\n}{  }g;
			}
			else{
				$rep_info[12] = '（リプレイファイルの情報を読み取れませんでした）';
			}
		}
		
		####################################
		# 風神録
		####################################
		
		if ($buff eq "t10r"){
			my $offset, $length, $info;
			$rep_info[0] = "風神録";
			$gameId = "10";
			seek (FILE, 12, 0);
			read (FILE, $offset, 4);
			$offset = unpack ("L", $offset);

			$length = (stat (FILE))[7] - $offset;
			seek (FILE, $offset, 0);
			read (FILE, $info, $length);

			if ($info =~ /
\Q東方風神録 リプレイファイル情報\E\r+\n
\QVersion \E(.+)\r+\n
\QName \E(.+)\r+\n
(\QLevel \E(.+)\r+\n|)
(\QScene \E(.+)\r+\n|)
\QDate \E(.+)\r+\n
\QScore \E(.+)\r+\n
\QSlow Rate \E(.+)\r+\n
\0+(USER.{8}([^\0]*)\0+)?
/x)

			  {
				my $real_comment_length = length ($10);
				
				$rep_info[1] = $2; # name
				$rep_info[2] = $7; # time
				$rep_info[3] = &getTh10CharValue($in{'th10char'}); # girls
				$rep_info[4] = $8 . "0"; # score 末尾1桁落ちてるっぽい
				$rep_info[5] = &getTh10LevelValue($in{'th10level'}); # difficulty
				$rep_info[6] = ""; #stage
				$rep_info[7] = ""; # miss
				$rep_info[8] = ""; # bomb
				$rep_info[9] = "$9%"; # slow
				$rep_info[10] = ""; # human
				$rep_info[11] = $1; # version
				$rep_info[12] = $11; # comment
				
				# コメントが初期値のままの場合は削除
				if($rep_info[12] eq "コメントを書けます"){
					$rep_info[12] = "";
				}

				if ($in{'addcomment'} eq 'add' && $in{'comment'} ne ""){
					my $new, $comment_text;

					$comment_text = $rep_info[12]
					  . ($rep_info[12] ne "" ? "\r\n" : "")
					  . $in{'comment'};
					$new = "USER"
					  . pack ("L", length ($comment_text) + 13)
					  . "\x01\x00\x00\x00" . $comment_text . "\0";
					seek (FILE, -$real_comment_length, 2);
					print FILE $new;
					truncate (FILE, tell (FILE));
				}
				$rep_info[12] =~ s{\r\n}{  }g;
			}
			else{
				$rep_info[12] = '（リプレイファイルの情報を読み取れませんでした）';
			}
		}

		$in{'comment'} .= "</>";
		$in{'comment'} .= join("</>" => @rep_info);
		close(FILE);
		
	}
	$set{'file_pre'} = "th" . $gameId . "_" . $set{'file_pre'};

	open(IN,$set{'log_file'})||&error(303);
	@log = <IN>;
	close(IN);
	($no,$lastip,$lasttime) = split(/<>/,$log[0]);
	shift(@log);
	$no++;
	my $tmpno = sprintf("%04d",$no);

	rename("$in{'tmpfile'}","$set{'src_dir'}$set{'file_pre'}$tmpno.$in{'ext'}");
	if (length($orgname) > 128) { $orgname = substr($orgname,0,128).'...'; }

	my @note;
	if($set{'post_flag'} && $set{'post_key'}){
		push(@note,'PostKey:'.$in{'postkey'});
	}
	if($ENV{'SERVER_SOFTWARE'} =~ /Apache|IIS/){
		my $disptime;
		my $time = time() - $in{'time'};
		my @str = ('Upload:','秒');
		my $disptime = $time.$str[1];
		push(@note,$str[0].$disptime);
	}
	my $note = join(',',@note);
	my $usersalt = substr($in{'user'},0,2);
	my $userid = crypt($in{'user'},$usersalt);
	$in{'time'} = time();
#	$in{'date'} = conv_date(time());
	my @new;
	$new[0] = "$no<>$in{'addr'}<>$in{'time'}<>1\n";
	$new[1] = "$no<>$in{'ext'}<>$in{'date'}<>$in{'comment'}<>$in{'type'}<>$orgname<>$in{'addr'}<>$in{'host'}<>$in{'pass'},$userid<>$set{'file_pre'}<>$note<>1\n";

	my $i = 2;
	my $allsize = (-s "$set{'src_dir'}$set{'file_pre'}$tmpno.$in{'ext'}");
	foreach my $value (@log){
		my ($no,$ext,$date,$comment,$mime,$orgname,$addr,$host,$pass,$filepre,$note,$dummy) = split(/<>/,$value);
		if(!$dummy){ $filepre = $set{'file_pre'};}
		$no = sprintf("%04d",$no);
		$allsize += (-s "$set{'src_dir'}$filepre$no.$ext");
		if($i <= $set{'max_log'} && !($set{'max_all_flag'} && $set{'max_all_size'}*1024 < $allsize)){ 
			if((-e "$set{'src_dir'}$filepre$no.$ext")||!$set{'zero_clear'}){ push(@new,$value); $i++; }
		}else{
			if(unlink("$set{'src_dir'}$filepre$no.$ext")){
				unlink("$set{'src_dir'}$filepre$no.$ext.html");
			}elsif(unlink("$set{'src_dir'}$filepre$no.$ext")){
				unlink("$set{'src_dir'}$filepre$no.$ext.html");
			}elsif(-e "$set{'src_dir'}$filepre$no.$ext"){
				push(@new,$value);
			}else{
				unlink("$set{'src_dir'}$filepre$no.$ext.html");
			}
		}
	}
	logwrite(@new);
	if($set{'dummy_html'}){ &makedummyhtml("$set{'file_pre'}$tmpno.$in{'ext'}"); }
	&makehtml(); &quit();
}

sub makehtml{

	my ($buff,$init,$postval);
	my $page = 0; my $i = 1;
	
	open(IN,$set{'log_file'})||&error(303);
	my $log = my @log = <IN>;
	close(IN);
	
	if($log == 1){ $log++; $init++;}
	my $lastpage = int(($log - 2)/$set{'pagelog'}) + 1;
	$postval = ' obj.postkey.value =  unescape(p[1]);' if($set{'post_flag'});
	my $header =<<"EOM";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
<META http-equiv="Content-type" content="text/html; charset=$set{'charset'}">
<META http-equiv="Content-Script-Type" content="text/javascript">
<script type="text/javascript">
<!--
function getCookie(obj,cookiename){
	var i,str;
	c = new Array(); 
	p = new Array("",""); 
	str = document.cookie;
	c = str.split(";");
	for (i = 0; i < c.length; i++) { 
		if (c[i].indexOf(cookiename+"=") >= 0) { 
			p = (c[i].substr(c[i].indexOf("=")+1)).split("<>");
			break; 
		}
	}
	if(cookiename == "SN_UPLOAD"){ 
		obj.pass.value =  unescape(p[0]);$postval 
	}
	else if(cookiename == "SN_DEL"){ 
		obj.delpass.value =  unescape(p[0]);
	}
	return true;
}
function delnoin(no){
	document.Del.delno.value = no;
	document.Del.del.focus();
}
//-->
</script>
<meta http-equiv="Content-Style-Type" content="text/css">
<link rel="stylesheet" type="text/css" href="./threp.css" media="screen,print" title="threp">
<TITLE>$set{'page_title'}</TITLE>
</HEAD>

<body onload="getCookie(document.Form,'SN_UPLOAD');getCookie(document.Del,'SN_DEL');">

<div id="container">

<div class="header">
<h1>$set{'page_title'}</h1>
</div>


EOM
	my $maxsize = 'Max '.dispsize($set{'max_size'}*1024);
	my ($minsize,$total);
	if($set{'min_flag'}){ $minsize = 'Min '.dispsize($set{'min_size'}*1024).' - '; }
	if($set{'max_all_flag'}){ $total .= ' Total '.dispsize($set{'max_all_size'}*1024);}
	
	$header .= "\n<div class=\"uploadForm\">\n";
	$header .= qq|<FORM METHOD="POST" ENCTYPE="multipart/form-data" ACTION="$set{'base_cgi'}" name="Form">FILE $minsize$maxsize (*$set{'max_log'}Files$total)|;
	
	my $th10LevelsSelect = &makeTh10LevelsSelect();
	my $th10CharsSelect = &makeTh10CharsSelect();
	$header .= <<EOF;
	<br>
	<INPUT TYPE=file  SIZE="40" NAME="upfile"> 
	DelKey: <INPUT TYPE="password" SIZE="10" NAME="pass" maxlength="10">
	<br>
	COMMENT <INPUT TYPE="checkbox" NAME="addcomment" VALUE="add">コメントをリプレイのコメントに付加する（紅魔郷、妖々夢は対象外）
	<br>
	<INPUT TYPE="text" SIZE="45" NAME="comment" value="">
	<INPUT TYPE="hidden" NAME="jcode" VALUE="漢字">
	<INPUT TYPE="submit" VALUE="Upload">
	<INPUT TYPE="reset" VALUE="Cancel">
	<br><br>
	（ 風神録の場合にのみ選択：
$th10LevelsSelect
$th10CharsSelect ）

EOF
	if($set{'post_flag'}){ 
		$header .= 'PostKey<br><INPUT TYPE="password" SIZE="10" NAME="postkey" maxlength="10">'; 
	}
	$header .= "</FORM>\n";
	$header .= "</div>\n";

	my $allsize = 0;
	my @files = globfile("$set{'src_dir'}",".*");
	foreach my $value (@files){ $allsize += (-s "$value"); }

	$allsize = dispsize($allsize);

	my $footer = <<EOF;
</table>
</div>

<div class="sizeInfo">
Used ${allsize}
</div>

EOF
	
	$footer .= "<div class=\"extensionInfo\">\n";
	if($set{'up_all'} && !$set{'ext_org'}){ 
		$footer .= $set{'up_ext'}.' +'; 
	}
	elsif(!$set{'up_all'}){ 
		$footer .= $set{'up_ext'}; 
	}
	$footer .= "</div>\n";
	
	$footer .= <<EOF;

<div class="delform">
	<FORM METHOD=POST ACTION=\"$set{'base_cgi'}\" name=\"Del\">
			<input type="hidden" name="mode" value="delete">
			No.<input type="text" size=4 name="delno" value=""> 
			key<input type="password" size="4" name="delpass" value=""> 
			<input type="submit" value="del" name="del">
	</form>
</div>
<div class="footer">
	<address>
	<!-- $set{'ver'} -->
	<a href="http://sugachan.dip.jp/download/">Sn Uploader</a>
	$set{'modify_info'}
	</address>
</div>

</div><!-- /container -->
</body>
</html>
EOF
	
	my $info_title = <<EOF;

<div class="tableInfo">
<table class="fileList" summary="tableInfo">
	<tr>
		<!--
		<td>
			D
		</td>
		<td>
			thx_udnnnn.rpy
		</td>
		-->
		<td>
			<div class="thx">
			<table class="replayInfo" summary="replayInfo">
				<tr>
					<th rowspan="2">ゲーム</th>
					<td colspan="2">名前</td>
					<td>使用キャラ</td>
					<td>記録日時</td>
					<td class="fileInfo">size</td>
				</tr>
				<tr>
					<td colspan=2>難易度</td>
					<td>進行度／カード名</td>
					<td>スコア</td>
					<td class="fileInfo">アップロード日時</td>
				</tr>
				<tr>
					<td>バージョン</td>
					<td>ミス回数</td>
					<td>ボム回数</td>
					<td>処理落ち率</td>
					<td>人間率（永）・初期体力（花）</td>
					<td  class="fileInfo">元ファイル名</td>
				</tr>
				<tr>
					<td colspan="6">リプレイコメント</td>
				</tr>
				<tr>
					<td colspan="6">アップロードコメント</td>
				</tr>
			</table>
			</div>
		</td>
	</tr>
</table>

</div>

<div class="contents">
<table class="fileList" summary="fileList">
EOF

	# 設定されている場合はHOMEのリンク生成
	if($set{'home_url'}){ 
		$set{'home_url'} = qq|<a href="$set{'home_url'}">[HOME]</a> |;
	}
	# ALLのHTML生成
	if($set{'html_all'}){
		my $buff; 
		my $no = 1; 
		my $time = time; 
		my $subheader;
		$subheader .= "<div class=\"index\">\n";
		$subheader .= $set{'home_url'};
		foreach my $value (@log){
			my (
				$no,
				$ext,
				$date,
				$comment,
				$mime,
				$orgname,
				$addr,
				$host,
				$pass,
				$dummy
			) = split(/<>/,$value);
			if(!$dummy){ 
				next; 
			}
			$buff .= makeitem($value);
		}
		$subheader .= "[ALL] ";
		while($no <= $lastpage){
			if($no == $page) { 
				$subheader .= "\[$no\] ";
			}
			else{
				if($no == 1){ 
					$subheader .= 
						"<a href=\"$set{'base_html'}?$time\">\[$no\]</a> "
				}
				else{
					$subheader .= 
						"<a href=\"./$no.html?$time\">\[$no\]</a> ";
				}
			}
			$no++;
		}
		$subheader .= "</div>\n";
		open(OUT,">./all.html")||&error(306,"./all.html");
		print OUT <<EOF;
$header
$subheader
$info_title
$buff
$footer
EOF
		close(OUT);
		chmod($set{'per_upfile'},"./all.html");
	}
	else{ 
		unlink("./all.html"); 
	}
	
	# 個別のHTML生成
	while($log > $i){
		$buff .= makeitem($log[$i]) unless($init);
		if(($i % $set{'pagelog'}) == 0||$i == $log -1){
			$page++; 
			my $subheader;
			$subheader .= "<div class=\"index\">\n";
			$subheader .= $set{'home_url'};
			my $no = 1;
			my $time = time;
			if($set{'html_all'}){ 
				$subheader .= "<a href=\"./all.html?$time\">[ALL]</a> "; 
			}
			while($no <= $lastpage){
				if($no == $page) { 
					$subheader .= "\[$no\] ";
				}
				else{
					if($no == 1){ 
						$subheader .= 
							"<a href=\"$set{'base_html'}?$time\">\[$no\]</a> "
					}
					else{
						$subheader .= 
							"<a href=\"./$no.html?$time\">\[$no\]</a> ";
					}
				}
				$no++;
			}
			my $loghtml;
			if($page == 1){
				$loghtml = $set{'base_html'}; 
			}
			else{ 
				$loghtml = "./$page.html"; 
			}
			$subheader .= "</div>\n";
			open(OUT,">$loghtml") || &error(306,"$loghtml");
			print OUT <<EOF;
$header
$subheader
$info_title
$buff
$footer
EOF
			close(OUT);
			chmod($set{'per_upfile'},$loghtml);
			undef $buff;
		}
		$i++;
	}

	while($page < 1000){
		$page ++;
		if(-e "$page.html"){ 
			unlink("$page.html"); 
		}
		else{ 
			last; 
		}
	}
}

sub delete{
	my $mode = $_[0];
	my @delno = split(/,/,$_[1]);
	my $delno; my $flag = 0; my $tmpaddr;

	if($in{'delno'} =~ /(\d+)/){ $delno = $1; }
	if($mode ne 'admin' && !$in{'delno'}){ return; }
	elsif($mode ne 'admin' && !$delno){ &error(401,$in{'delno'}); }

	open(IN,$set{'log_file'})|| &error(303);
	my @log = <IN>;
	close(IN);

	if($in{'addr'} =~ /(\d+).(\d+).(\d+).(\d+)/){ $tmpaddr = "$1.$2.$3."; }
	my $findflag = 0;
	foreach my $value (@log){
		my ($no,$ext,$date,$comment,$mime,$orgname,$addr,$host,$pass,$filepre,$note,$dummy) = split(/<>/,$value);
		my $delflag = 0;
		if(!$addr){ next; }
		if($mode eq 'admin'){
			foreach my $delno (@delno){ if($no == $delno){ $delflag = 1; last; } }
		}elsif($no == $delno){
			$findflag = 1;
			unless ($addr =~ /^$tmpaddr/){
				my ($pass,$id) = split(/,/,$pass);
				my $delpass = $in{'delpass'} || $in{'addr'}.time();
				my $salt = substr($pass, 0, 2);	$delpass = crypt($delpass,$salt);
				my $usersalt = substr($in{'user'},0,2); my $userid = crypt($in{'user'},$usersalt);
				if ($in{'delpass'} ne $set{'admin_pass'} && $delpass ne $pass && $userid ne $id){ 
					if($mode ne 'admin'){ if(!$dummy){ $filepre = $set{'file_pre'};} $no = sprintf("%04d",$no); &error(404,"$filepre$no.$ext");}
				}
			}
			$delflag = 1;
		}
		if($delflag){
			$flag = 1;
			if(!$dummy){ $filepre = $set{'file_pre'};}
			$no = sprintf("%04d",$no);
			if(unlink("$set{'src_dir'}$filepre$no.$ext")){
				unlink("$set{'src_dir'}$filepre$no.$ext.html"); undef $value;
			}elsif(unlink("$set{'src_dir'}$filepre$no.$ext")){
				unlink("$set{'src_dir'}$filepre$no.$ext.html"); undef $value;
			}elsif(!(-e "$set{'src_dir'}$filepre$no.$ext")){
				unlink("$set{'src_dir'}$filepre$no.$ext.html"); undef $value;
			}else{
				if($mode ne 'admin'){ &error(403,"$filepre$no.$ext");}
			}
		}
	}
	if($mode ne 'admin' && !$findflag){ &error(402,$delno); }
	if($flag){
		logwrite(@log);
		&makehtml();
	}
}


sub quit{
	my ($cookiename,$buff);
	my $flag = 0;
	my @tmpfiles = globfile("$set{'src_dir'}","\.temporary");
	foreach my $value (@tmpfiles){ if((stat($value))[10] < time - 60*60){ unlink("$value"); $flag++; } }
	&makehtml() if($flag);
	$buff =<<"EOM";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang=ja><head>
<META HTTP-EQUIV="Content-type" CONTENT="text/html">
<META http-equiv="Pragma" content="no-cache">
<META http-equiv="Cache-Control" content="no-cache">
<META http-equiv="Expires" content="0">
<META HTTP-EQUIV="Refresh" CONTENT="0;URL=$set{'base_html'}">
EOM
	if($in{'jcode'} || $in{'mode'} eq 'delete'){
		$buff .=<<"EOM";
<META HTTP-EQUIV="Set-Cookie" content="SN_USER=$in{'user'}&lt;&gt;1; expires=Fri, 31-Dec-2030 23:59:59 GMT">
<META HTTP-EQUIV="CONTENT-SCRIPT-TYPE" CONTENT="text/javascript">
<script type="text/javascript">
<!--
setCookie();
function setCookie() {
	var key1,key2;
	var tmp = "expires=Fri, 31-Dec-2030 23:59:59; ";
EOM
		if($in{'jcode'}){
			my %ck; foreach(split(/;/,$ENV{'HTTP_COOKIE'})){ my($key,$val) = split(/=/); $key =~ s/\s//g; $ck{$key} = $val;}
			my @ck = split(/<>/,$ck{'SN_DEL'});
			if(!$ck[0] && $in{'org_pass'}){	$buff .= qq|\tdocument.cookie = "SN_DEL="+escape('$in{'org_pass'}')+"<>;"+ tmp;\n|;}
			$cookiename = 'SN_UPLOAD'; $buff .= "\tkey1 = escape('$in{'org_pass'}'); key2 = escape('$in{'postkey'}');\n";}
		else{ $cookiename = 'SN_DEL'; $buff .= "\tkey1 = escape('$in{'delpass'}'); key2 = '';\n"; }
		$buff .= qq|\tdocument.cookie = "$cookiename="+key1+"<>"+key2+"; "+ tmp;\n}\n//-->\n</script>\n|;
	}
	$buff .=<<"EOM";
<title>Uploader</title></head><body>
<br><br><div align=center><font size="+1"><br><br>
<a href="$set{'base_html'}?$in{'time'}">click here!</a></font><br>
</div>
</body></html>
EOM
	print "Content-type: text/html\n\n";
	print $buff;
	exit;
}

sub admin_mode{
	&errorclear() if($in{'mode'} eq 'errorclear');
	&delete('admin',$in{'admin_delno'}) if($in{'mode'} eq 'delete');

	open(IN,$set{'log_file'})||error(303);
	my @log = <IN>;
	close(IN);

	my ($header,$buff,$footer,$value);
	$buff =<<"EOM";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
<META name="robots" content="noindex,nofollow">
<META name="ROBOTS" content="NOINDEX,NOFOLLOW">
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=$set{'charset'}">
<META http-equiv="Pragma" content="no-cache">
<META http-equiv="Cache-Control" content="no-cache">
<META http-equiv="Expires" content="0">
<TITLE>Sn Uploader Support Script</TITLE>
<META http-equiv="Content-Style-Type" content="text/css">
<STYLE type="text/css"><!--
input,td{ font-size: 10pt;font-family:Chicago,Verdana,Arial,sans-serif,"ＭＳ Ｐゴシック"; }
a:hover { background-color:#EECCCC; }
input,textarea{	font-size:10pt;}
-->
</STYLE>
</HEAD>
<body bgcolor="#ffffff" text="#000000" LINK="#6060FF" VLINK="#6060FF" ALINK="#6060FF">
EOM

	$buff .= leaddisp(0,1,1).'<a name="up"></a><table summary="title" width="100%"><tr><td bgcolor="#caccff"><strong><font size="4" color="#3366cc">Upload Info</font></strong></td></tr></table>';
	$buff .= qq|<table summary="check"><tr><td><form action="$set{'base_cgi'}" method="POST"><input type=hidden name="checkmode" value="allcheck"><input type=hidden name=delno value="$in{'delno'}"><input type=hidden name=delpass value="$in{'delpass'}"><input type=submit value="すべてチェック"></form></td><td><form action="$set{'base_cgi'}" method="POST"><input type=hidden name="checkmode" value="nocheck"><input type=hidden name=delno value="$in{'delno'}"><input type=hidden name=delpass value="$in{'delpass'}"><input type=submit value="すべて外す"></form></td><td><form action="$set{'base_cgi'}" method="POST"><input type=hidden name=delpass value="$set{'admin_pass'}"><input type=submit value="HTMLを更新する/ログアウト"></form></td></tr></table>\n<form action="$set{'base_cgi'}" method="POST"><input type=hidden name="mode" value="delete"><input type=hidden name=delno value="$in{'delno'}"><input type=hidden name=delpass value="$in{'delpass'}"><input type=submit value="チェックしたものを削除"><br>\n|."<table summary=\"upinfo\" width=\"100%\">\n<tr><td>DEL</td><td>NAME</td><td>COMMENT</td><td>SIZE</td><td>ADDR</td><td>HOST</td><td>DATE</td><td>NOTE</td><td>MIME</td><td>ORIG</td></tr>\n";
	shift(@log);
	foreach (@log){	$buff .= makeitem($_,'admin'); }
	$buff .= '</table></form><br><br>';

	if($set{'error_level'}){
		$buff .= leaddisp(-1,0,1).'<a name="error"></a><table summary="errortitle" width="100%"><tr><td bgcolor="#caccff"><strong><font size="4" color="#3366cc">Error Info</font></strong></td></tr></table>';
		$buff .= qq|<form action="$set{'base_cgi'}" method="POST"><input type=hidden name=mode value="errorclear"><input type=hidden name=delno value="$in{'delno'}"><input type=hidden name=delpass value="$in{'delpass'}"><input type=submit value="エラーログクリア"></form>|;
		$buff .= "<table summary=\"errorinfo\" width=\"100%\">\n<tr><td>DATE</td><td>ADDR</td><td>HOST</td><td>NOTE</td></tr>\n";
		if(open(IN,$set{'log_error'})){	@log = reverse(<IN>); close(IN); foreach (@log){ my ($date,$no,$note,$addr,$host) = split(/<>/); $buff .= "<tr><td>$date</td><td>$addr</td><td>$host</td><td>$note</td></tr>\n"; }}
		$buff .= "</table><br><br>\n";
	}

	$buff .= leaddisp(-1,-1,0);
	$buff .= '<a name="set"></a><table summary="settitle" width="100%"><tr><td bgcolor="#caccff"><strong><font size="4" color="#3366cc">Setting Info</font></strong></td></tr></table>'."\n<table summary=\"setting\">\n";
	$buff .= tablestr('スクリプトVer',$set{'ver'});
	$buff .= tablestr('メインログファイル',$set{'log_file'});
	if($set{'error_level'}){$buff .= tablestr('エラーログファイル',$set{'log_error'}); }else{ $buff .= tablestr('エラーログ記録','無'); }
	$buff .= tablestr('保持件数',$set{'max_log'});
	$buff .= tablestr('最大投稿容量',dispsize($set{'max_size'}*1024).' '.($set{'max_size'}*1024).'Bytes');

	if($set{'min_flag'}){ $buff .= tablestr('最小制限容量',dispsize($set{'min_size'}*1024).' '.($set{'min_size'}*1024).'Bytes'); }
	else{ $buff .= tablestr('最小制限容量',"無"); }
	if($set{'max_all_flag'}){ $buff .= tablestr('総容量制限',dispsize($set{'max_all_size'}*1024).' '.($set{'max_all_size'}*1024).'Bytes'); }
	else{ $buff .= tablestr('総容量制限',"無"); }

	$buff .= tablestr("ファイル接頭辞",$set{'file_pre'});
	$buff .= tablestr("保存ディレクトリ",$set{'src_dir'});
	$buff .= tablestr('1ページに表示するファイル数',$set{'pagelog'});
	if($set{'interval'} > 0){ $value = $set{'interval'}.'秒'; }else{ $value = '無'; }
	$buff .= tablestr('同一IP投稿間隔秒数制限',$value);
	if($set{'up_ext'}){	$set{'up_ext'} =~ s/,/ /g; $buff .= tablestr('投稿可能基本拡張子',$set{'up_ext'}); }
	if($set{'deny_ext'}){ $set{'deny_ext'} =~ s/,/ /g; $buff .= tablestr('投稿禁止拡張子',$set{'deny_ext'}); }
	if($set{'change_ext'}){	$set{'change_ext'} =~ s/,/ /g; $set{'change_ext'} =~ s/>/&gt;/g; $buff .= tablestr('拡張子変換',$set{'change_ext'});	}

	if($set{'up_all'}){	$buff .= tablestr('指定外拡張子アップロード許可','有'); if($set{'ext_org'}){ $buff .= tablestr('指定外ファイル拡張子','オリジナル'); }else{ $buff .= tablestr('指定外ファイル拡張子','bin'); }}
	else{$buff .= tablestr('指定外拡張子アップロード許可','無');}

	if($set{'find_crypt'}){ $value = '有'; }else{ $value = '無';}
	$buff .= tablestr('暗号化アーカイブ検出(ZIP/RAR/GCA)',$value);
	if($set{'binary_compare'}){ $value = '有'; }else{ $value = '無';}
	$buff .= tablestr('バイナリ比較',$value);
	if($set{'post_flag'}){ $value = '有'; }else{ $value = '無';}
	$buff .= tablestr('PostKey投稿制限',$value);
	if($set{'disp_error'}){ $value = '有'; }else{ $value = '無';}
	$buff .= tablestr('ユーザエラー表示',$value);
	if($set{'zero_clear'}){ $value = '有'; }else{ $value = '無';}
	$buff .= tablestr('削除済ファイルリスト自動消去',$value);
	if($set{'home_url'}){ $buff .= "<tr><td>HOMEURL</td><td>$set{'home_url'}</td></tr>\n";}
	if($set{'http_src_path'}){ $buff .= "<tr><td>HTTP_SRC_PATH</td><td>$set{'http_src_path'}</td></tr>\n";}
	$buff .= '</table></body></html>';

	print "Content-type: text/html\n\n";
	print $buff;
	exit;
}

sub extfind{
	my $orgname = @_[0];
	my @filename = split(/\./,$orgname);
	my $ext = $filename[$#filename];
	$ext =~ tr/[A-Z]/[a-z]/;
	foreach my $value (split(/,/,$set{'change_ext'})){ my ($src,$dst) = split(/->/,$value); if($ext eq $src){ $ext = $dst; last; }}
	foreach my $value (split(/,/,$set{'deny_ext'})){ if($ext eq $value){ &error(206,$ext); }}
	foreach my $value (split(/,/,$set{'up_ext'})){ if ($ext eq $value) { return $value; } }
	if(length($ext) >= 5 || length($ext) == 0){ $ext = 'bin'; }
	unless ($ext =~ /^[A-Za-z0-9]+$/){ $ext = 'bin'; }
	if($set{'up_all'} && $set{'ext_org'}){ return $ext;}
	elsif($set{'up_all'}){ return 'bin'; }
	return 0;
}


sub conv_date{
	my @date = gmtime($_[0] + 9*60*60);
	$date[5] -= 100; $date[4]++;
	if ($date[5] < 10) { $date[5] = "0$date[5]" ; }	if ($date[4] < 10) { $date[4] = "0$date[4]" ; }
	if ($date[3] < 10) { $date[3] = "0$date[3]" ; }	if ($date[2] < 10) { $date[2] = "0$date[2]" ; }
	if ($date[1] < 10) { $date[1] = "0$date[1]" ; }	if ($date[0] < 10) { $date[0] = "0$date[0]" ; }
	my @w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	return ("$date[5]/$date[4]/$date[3]($w[$date[6]]),$date[2]:$date[1]:$date[0]");
}

sub dispsize{
	my $size = $_[0];
	if($size >= 1024*1024*1024*100){ $size = int($size/1024/1024/1024).'GB';}
	elsif($size >= 1024*1024*1024*10){ $size = sprintf("%.1fGB",$size/1024/1024/1024);}
	elsif($size > 1024*1024*1024){ $size = sprintf("%.2fGB",$size/1024/1024/1024);}
	elsif($size >= 1024*1024*100){ $size = int($size/1024/1024).'MB'; }
	elsif($size > 1024*1024){ $size =  sprintf("%.1fMB",$size/1024/1024); }
	elsif($size > 1024){ $size = int($size/1024).'KB'; }
	else{ $size = int($size).'B';}
	return $size;
}

sub put_comma {
	my $num = $_[0];
	$num = reverse $num;
	$num =~ s/(\d{3})(?=\d)(?!\d*\.)/$1,/g;
	$num = reverse $num;
	return $num
}


sub replaceEmpty(){
	my (
		$s
	) = @_;
	
	if(length($s) == 0){
		$s = "&nbsp;";
	}
	if($s =~ /^\s*$/){
		$s = "&nbsp;";
	}
	return $s;
}

sub makeitem{
	my (
		$src,
		$mode
	) = @_; my ($buff,$check,$target);
	my (
		$no,
		$ext,
		$date,
		$comment,
		$mime,
		$orgname,
		$addr,
		$host,
		$pass,
		$filepre,
		$note,
		$dummy
	) = split(/<>/,$src);
	
	if(!$dummy){ 
		$filepre = $set{'file_pre'}; 
	}
	
	# IE用に空白の値を&nbsp;で置換
	my @bufAr = split(/<\/>/,$comment);
	while($#bufAr < 13){
		push(@bufAr, "&nbsp;");
	}
	for(my $i=0; $i<=$#bufAr; $i++){
		$bufAr[$i] = &replaceEmpty($bufAr[$i]);
	}
	
	my (
		$purecomment,
		$rpy_game,
		$rpy_name,
		$rpy_time,
		$rpy_girls,
		$rpy_score,
		$rpy_difficulty,
		$rpy_stagespellno,
		$rpy_miss,
		$rpy_bomb,
		$rpy_slow,
		$rpy_human,
		$rpy_version,
		$rpy_comment
	) = @bufAr;
	
	# コメントは空白でもかまわない
	if($rpy_comment eq "&nbsp;"){
		$rpy_comment = "";
	}
	#if($purecomment eq "&nbsp;"){
	#	$purecomment = "";
	#}
	
	# add comma
	$rpy_score = &put_comma($rpy_score);
	
	my $orgno = $no;
	$no = sprintf("%04d",$no);
	my $size = dispsize(-s "$set{'src_dir'}$filepre$no.$ext");
	my $path = $set{'http_src_path'} || $set{'src_dir'};
	if($set{'link_target'}){ 
		$target = qq| target="$set{'link_target'}"|; 
	}
	
	# adminモードの場合
	if($mode eq 'admin'){
		if($addr eq $host){ 
			undef $host; 
		}
		if($in{'checkmode'} eq 'allcheck'){
			$check = ' checked';
		}
		my $html_ext = "";
		# html付きの場合
		if(-e "$set{'src_dir'}$filepre$no.$ext.html"){
			$html_ext = ".html";
		}
		$buff = <<EOF;
<tr>
	<td><INPUT TYPE="checkbox" NAME="admin_delno" VALUE="$no" $check></td>
	<td><a href="$path$filepre$no.$ext$html_ext" $target>$filepre$no.$ext</a></td>
	<td>$comment</td>
	<td>$size</td>
	<td>$addr</td>
	<td>$host</td>
	<td>$date</td>
	<td>$note</td>
	<td>$mime</td>
	<td>$orgname</td>
</tr>
EOF
	}
	# 通常閲覧モードの場合
	else{
		my $html_ext = "";
		# html付きの場合
		if(-e "$set{'src_dir'}$filepre$no.$ext.html"){
			$html_ext = ".html";
		}
		
		# ゲーム毎のCSSクラス名
		my $game_class = "thx";
		#if(index($filepre, "_") > 0){
		#	$game_class = substr($filepre, 0, index($filepre, "_"));
		#}
		if($rpy_game eq "紅魔郷"){
			$game_class = "th6";
		}
		elsif($rpy_game eq "妖々夢"){
			$game_class = "th7";
		}
		elsif($rpy_game eq "永夜抄"){
			$game_class = "th8";
		}
		elsif($rpy_game eq "花映塚"){
			$game_class = "th9";
		}
		elsif($rpy_game eq "文花帖"){
			$game_class = "th95";
		}
		elsif($rpy_game eq "風神録"){
			$game_class = "th10";
		}
		
		$buff = <<EOF;
	<tr>
		<td>
			<div class="$game_class">
			<SCRIPT type="text/javascript" Language="JavaScript">
			<!--
			document.write('<a href="javascript:delnoin($orgno)">$set{"del_name"}<' + '/a>');
			// -->
			</SCRIPT>
			</div>
		</td>
		<td>
			<div class="$game_class">
			<a href="$path$filepre$no.$ext$html_ext" $target>$filepre$no.$ext</a>
			</div>
		</td>
		<td>
			<div class="$game_class">
			<table class="replayInfo" summary="replayInfo">
				<tr>
					<th rowspan="2">$rpy_game</th>
					<td colspan="2">$rpy_name</td>
					<td>$rpy_girls</td>
					<td>$rpy_time</td>
					<td class="fileInfo">$size</td>
				</tr>
				<tr>
					<td colspan="2">$rpy_difficulty</td>
					<td>$rpy_stagespellno</td>
					<td>$rpy_score</td>
					<td class="fileInfo">$date</td>
				</tr>
				<tr>
					<td>$rpy_version</td>
					<td>$rpy_miss</td>
					<td>$rpy_bomb</td>
					<td>$rpy_slow</td>
					<td>$rpy_human</td>
					<td class="fileInfo">$orgname</td>
				</tr>
				<tr>
					<td colspan="6">$rpy_comment</td>
				</tr>
				<tr>
					<td colspan="6">$purecomment</td>
				</tr>
			</table>
			</div>
		</td>
	</tr>
EOF
	}
	return $buff;
}


sub makedummyhtml{
	my $filename = $_[0];
	my $buff = "<html><head><title>$filename</title></head><body>";
	$buff .= qq|Download <a href="./$filename">$filename</a>|;
	$buff .= '</body></html>';
	open(OUT,">$set{'src_dir'}$filename.html")||&error(307,"$set{'src_dir'}$filename.html");
	print OUT $buff;
	close(OUT);
	chmod($set{'per_upfile'},"$set{'src_dir'}$filename.html");
	return 1;
}

sub logwrite{
	my @log = @_;
	open(OUT,"+>$set{'log_file'}")||&error(304);
	eval{ flock(OUT, 2);};
	eval{ truncate(OUT, 0);};
	seek(OUT, 0, 0);
	print OUT @log;
	eval{ flock(OUT, 8);};
	close(OUT);
	chmod($set{'per_upfile'},$set{'log_file'});
	return 1;
}

sub binarycmp{
	my ($src,$dst) = @_;
	return 0 if (-s $src != -s $dst);
	open(SRC,$src)||return 0; open(DST,$dst)||return 0;
	my ($buff,$buff2);
	binmode(SRC); binmode(DST); seek(SRC,0,0); seek(DST,0,0); 
	while(read(SRC,$buff,8192)){ read(DST,$buff2,8192); if($buff ne $buff2){ close(SRC); close(DST); return 0; } }
	close(SRC); close(DST);
	return 1;
}

sub init{
	my $buff;
	if(open(OUT,">$set{'log_file'}")){
		print OUT "0<>0<>0<>1\n";
		close(OUT);
		chmod($set{'per_logfile'},$set{'log_file'});
	}else{
		$buff = "<tr><td>メインログの作成に失敗しました</td></tr>";
	}
	
	unless (-d "$set{'src_dir'}"){
		if(mkdir("$set{'src_dir'}",$set{'per_dir'})){
			chmod($set{'per_dir'},"$set{'src_dir'}");
			open(OUT,">$set{'src_dir'}index.html");
			close(OUT);
			chmod($set{'per_upfile'},"$set{'src_dir'}index.html");
		}else{
			$buff .= "<tr><td>Source保存ディレクトリの作成に失敗しました</td></tr>";
		}
	}
	if($buff){
		$buff .= "<tr><td>ディレクトリに書き込み権限があるか確認してください</td></tr>";
		&error_disp($buff,'init');
	}
}

sub check_postkey{
	my $inputkey = @_[0];
	my @key = split(/,/,$set{'post_key'});
	foreach my $key (@key){ if($inputkey eq $key){ return 1; } }
	return 0;
}

sub leaddisp{
	my @src = @_;
	my ($str,$count);
	foreach my $value (@src){
		my ($mark,$name,$link); $count++;
		if($count == 1){ $name = 'Upload Info'; $link = 'up'; }
		elsif($count == 2){ $name = 'Error Info'; $link = 'error'; next if(!$set{'error_level'}); }
		elsif($count == 3){ $name = 'Setting Info'; $link = 'set'; }
		if($value){ if($value > 0){ $mark = '▼'; }else{ $mark = '▲'; } $str .= qq|<a href="#$link">${mark}${name}</a> |; }
		else{ $str .= qq|[$name] |; }
	}
	return $str;
}

sub errorclear{
	open(OUT,">$set{'log_error'}")||return 0;
	eval{ flock(OUT, 2);}; eval{ truncate(OUT, 0);}; seek(OUT, 0, 0); eval{ flock(OUT, 8);}; close(OUT);
	chmod($set{'per_upfile'},$set{'log_file'});
	return 1;
}

sub tablestr{
	my ($value1,$value2) = @_;
	return ("<tr><td>$value1</td><td>$value2</td></tr>\n");
}

sub globfile{
	my ($src_dir,$filename) = @_;
	opendir(DIR,$src_dir)||return 0; my @dir = readdir(DIR); closedir(DIR);
	my @new = (); foreach my $value (@dir){ push(@new,"$src_dir$value") if($value =~ /$filename/ && !(-d "$src_dir$value")); }
	return @new;
}

sub error_disp{
	my ($message,$mode) = @_;
	my $url;
	if($mode eq 'init'){ $url = qq|<a href="$set{'base_cgi'}">[リロード]</a>|; }else{ $url = qq|<a href="$set{'base_html'}">[戻る]</a>|; }
	my $buff =<<"EOM";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
<META name="robots" content="noindex,nofollow">
<META name="ROBOTS" content="NOINDEX,NOFOLLOW">
<META http-equiv="Content-type" content="text/html; charset=$set{'charset'}">
<META http-equiv="Pragma" content="no-cache">
<META http-equiv="Cache-Control" content="no-cache">
<META http-equiv="Expires" content="0">
<TITLE>Uploader</TITLE>
<META http-equiv="Content-Style-Type" content="text/css">
<STYLE type="text/css"><!--
input,td{ font-size: 10pt;font-family:Chicago,Verdana,Arial,sans-serif,"ＭＳ Ｐゴシック"; }
a:hover { background-color:#EECCCC; }
input,textarea{	border-top : 1px solid ; border-bottom : 1px solid ; border-left : 1px solid ; border-right : 1px solid ;font-size:10pt;background-color:#FFFFFF; }
-->
</STYLE>
</HEAD>
<body bgcolor="#ffffff" text="#000000" LINK="#6060FF" VLINK="#6060FF" ALINK="#6060FF">
<div align="center">
<table summary="error">
$message
<tr><td></td></tr>
<tr><td><div align="center">$url</div></td></tr>
</table>
<br><br>
<table summary="info">
<tr>
<td>DATE</td><td>$in{'date'}</td></tr>
<tr><td>ADDR</td><td>$in{'addr'}</td></tr>
<tr><td>HOST</td><td>$in{'host'}</td></tr>
<!-- <tr><td>USERAGENT</td><td>$ENV{'HTTP_USER_AGENT'}</td></tr> -->
</table>
</div>
</body></html>
EOM
	print "Content-type: text/html\n\n";
	print $buff;
	exit;
}

sub error{
	my ($no,$note) = @_;
	if (length($note) > 64) { $note = substr($note,0,64).'...'; }
	$note =~ s/&/&amp;/g; $note =~ s/\"/&quot;/g; $note =~ s/</&lt;/g; $note =~ s/>/&gt;/g; $note =~ s/\r//g; $note =~ s/\n//g;
	my ($message,$dispmsg,$flag);
	if($no == 99){ $message = "UpFileなし"; }
	elsif($no == 101){ $message = "投稿禁止HOST"; }
	elsif($no == 106){ $flag = 1; $message = "POSTサイズ超過"; $note = dispsize($note); $dispmsg= '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>アップロードファイル('.$note.')は 最大容量設定('.dispsize($set{'max_size'}*1024).')を越えています</td></tr>';}
	elsif($no == 107){ $flag = 1; $message = "POSTサイズ過小"; $note = dispsize($note); $dispmsg= '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>アップロードファイル('.$note.')は 最小容量設定('.dispsize($set{'min_size'}*1024).')未満です</td></tr>';}
	elsif($no == 108){ $flag = 1; $message = "POSTデータ不完全"; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>POSTデータが不完全です</td></tr>';}
	elsif($no == 109){ $flag = 1; $message = "POSTKey不一致"; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>POSTKeyが一致しません</td></tr>';}
	elsif($no == 202){ $flag = 1; $message = "拡張子合わず"; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>投稿できる拡張子は'.$set{'up_ext'}.'です</td></tr>';}
	elsif($no == 203){ $flag = 1; $message = "投稿早すぎ"; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>同一IPアドレスから'.$set{'interval'}.'秒以内に再投稿できません</td></tr>';}
	elsif($no == 204){ $flag = 1; $message = "一時ファイル書き込めず"; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>一時ファイルの作成に失敗しました</td></tr>';}
	elsif($no == 205){ $flag = 1; $message = "同一ファイル存在"; $note =~ /([^\/]+)$/; my $filename = $1; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>同一ファイルが '.$filename.' に存在します</td></tr>';}
	elsif($no == 206){ $flag = 1; $message = "禁止拡張子"; $dispmsg = '<tr><td>ファイルをアップロードできませんでした</td></tr><tr><td>拡張子 '.$note.' はアップロードできません</td></tr>';}
	elsif($no == 303){ $flag = 1; $message = "ログファイルに読み込めず"; $dispmsg = '<tr><td>メインログの読み込みに失敗しました</td></tr>';}
	elsif($no == 304){ $flag = 1; $message = "ログファイルに書き込めず"; $dispmsg = '<tr><td>メインログの書き込みに失敗しました</td></tr>';}
	elsif($no == 306){ $message = "ファイルリストHTML書き込めず";}
	elsif($no == 307){ $message = "ファイルHTMLファイル書き込めず";}
	elsif($no == 401){ $flag = 1; $message = "削除No.検出できず"; $dispmsg = '<tr><td>ファイルを削除できませんでした</td></tr><tr><td>'.$note.' から削除No.を検出できませんでした</td></tr><tr><td>'.$set{'file_pre'}.'0774.zipの場合 No.には 774 を入力します</td></tr>';}
	elsif($no == 402){ $flag = 1; $note = sprintf("%04d",int($note)); $message = "削除No.存在せず"; $dispmsg = '<tr><td>ファイルを削除できませんでした</td></tr><tr><td>'.$set{'file_pre'}.$note.'.*** はメインログに存在しません</td></tr>';}
	elsif($no == 403){ $flag = 1; $message = "削除アクセス拒否"; $dispmsg = '<tr><td>ファイルを削除できませんでした</td></tr><tr><td>ファイル削除条件は満たしていますが '.$note.' のファイルの削除が拒否されました</td></tr><tr><td>アクセスが過剰な場合等は時間を置いて再操作すると削除できることがあります</td></tr>';}
	elsif($no == 404){ $flag = 1; $message = "削除Key不一致"; $dispmsg = '<tr><td>ファイルを削除できませんでした</td></tr><tr><td>'.$note.' 削除Keyが一致しませんでした</td></tr>';}
	unlink($in{'tmpfile'});
	if($note){ $message .= ' ';}
	if($set{'error_level'} && $no > 100){
		unless(-e $set{'log_error'}){
			open(OUT,">$set{'log_error'}");
			close(OUT);
			chmod($set{'per_logfile'},$set{'log_error'});
		}
		open(OUT,">>$set{'log_error'}");
		print OUT "$in{'date'}<>$no<>$message$note<>$in{'addr'}<>$in{'host'}<>1\n";
		close(OUT);
	}
	&error_disp($dispmsg) if($flag && $set{'disp_error'});
	&quit();
}

