#=======================================================================================
#	perl-lib.pl Version2003.07		Perl5 Only
#						Try The HomePage http://www.tryhp.net
#								Terra(info@tryhp.net)
#	--------------------------------------------------------------------------------
#	[,????] = PossibilityOmission
#
#	age(BirthdayString)
#		BirthdayString Format = 2001/05/09
#	ascscramble(String,flag[,key])
#		flag = 0:Decoding / 1:Encryption 
#		key =  0 => 3600 Japanese Correspondence 
#	calendar(Year, Month, Timelag, Flag)
#		[7 Days]
#		@CALENDAR = calendar('2001', '09', 9, 0);
#		Flag    = 0:日,月,火,水,木,金,土
#			  1:Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday
#			  2:Sun,Mon,Tue,Wed,Thu,Fri,Sat
#	calendar2(Year, Month, Timelag, Flag)
#		@CALENDAR = calendar('2001', '09', 9, 0);
#		Flag    = 0:日,月,火,水,木,金,土
#			  1:Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday
#			  2:Sun,Mon,Tue,Wed,Thu,Fri,Sat
#	changecsv(src, des, keys)
#	comma(number)
#	cookie_read(cookiename)
#	cookie_regist(cookiename,cookielist)
#	data_read(data_path)
#	data_save(data_path, WRITE_DATA)
#	dateserial(DateString, TimeLag)
#		$serial = dateserial("2001/05/10 11:55:57", 0);
#		$serial = 989463357
#	domain([flag])
#		flag = 0:Full Host Domain / 1:Domain
#	fcopy(src, des, permission)
#		src = srcfile
#		des = desfile
#	fields(fields[,Separator])
#		Not Separator = "\t"
#	html_head(bgcolor,text,link,vlink,alink[,background,topmargin,leftmargin,title])
#	hexstr(string,flag)
#		string = change string
#		flag =	0:16 To Chr
#			1:Chr To 16
#	ichr(string,flag)
#		string = change string
#		flag =	0:delete
#			1:image
#	imagesize(imagefile)
#		imagefile = image file path
#		[Sample]
#		($width, $height) = imagesize('img/test.jpg');
#	img_head([flag])
#		flag = gif / jpeg / png
#	inline_link(String[,Replacement])
#	jst_time(SerialTime[,flag])
#		flag = 	0:2001年5月25日(金) 10:54:15
#			1:2001年5月25日(金)
#			2:2001年5月25日
#			3:2001/5/25(Friday) 10:54:15
#			4:2001/5/25(Friday)
#			5:2001/05/25
#	kaconv(String)
#	progpass()
#	readparts([Variable, Tag, Jcode])
#		Variable = VariableName
#		Tag =	Ineffective Tag List
#		Jcode = Omission : Untransformation
#			jis, sjis, euc
#	rgb(Color)
#		(R,G,B) = rgb('#FF0AB6');
#	scramble(String,flag[,key])
#		flag = 0:Decoding / 1:Encryption 
#		key = Ank 0 => 128, Japanese -16 => -16
#	send_email(sendmailpath,uuencodepath,subject,from,to,cc,bcc,body[,files,encoding])
#		[UNIX/Linux]
#		sendmailpath = '/usr/lib/sendmail' ?
#		uuencodepath = '/usr/bin/uuencode' ?
#		[Windows]
#		sendmailpath = 'c:\usr\lib/blatj.exe' ?
#		send_email(sendmailpath,'',subject,from,to,'','',body)
#	sumnail(imagefile, maxsize[, flag])
#		imagefile = image file path
#		maxsize = Max image size
#		[Sample]
#		($width, $height) = sumnail('img/test.jpg', 128);
#		($width, $height) = sumnail('img/test.jpg', 128, 1);
#	sumnailcopy(srcfile, desfile, newwidth)
#		srcfile = Sauce image file path(GIF Onry)
#		desfile = Copy filename
#		newwidth = New image width
#		[Sample]
#		($err) = sumnailcopy('img/test.gif', 'img/test2.gif', 80);
#	tag_change(string)
#	tag_check(string, FREETAGS)
#		FREETAGS = Permission TagList	('a','p','font','u','i','b')
#	upload(autoname,filetype,format,dir,max,permission,mode[,variable])
#		[Example 1]
#		Indispensable cgi-lib.pl ReadParse(*QUERY)
#			UploadFileList = @QUERY
#			[Sample]
#			&ReadParse(*QUERY);
#			while (($key, $value) = each %QUERY) {
#				$key =~ /upload/i && next;
#				$value =~ s/\n//g;
#				$value =~ s/</&lt;/g;
#				$value =~ s/>/&gt;/g;
#				&jcode'convert(*value,'sjis');
#				$QUERY{$key} = $value;
#			}
#		[Example 2]
#			[Sample]
#			readparts ('QUERY', '<>=', 'sjis');
#		autoname = 0:Original Filename / 1:Auto Filename
#		filetype = Mimetype
#		format = ImageType
#		dir = Save Directory
#		max = Max FileSize
#		permission = permission
#		mode = text:Windows TextFile -> UnixFile
#		variable = VariableName
#	user_agent()
#	whois(domain)
#		UNIX onry
#=======================================================================================
use Socket;
use Cwd;
use File::Copy;
use Net::Ping;
use Time::Local;
$CR = "\015\012";

sub html_head {
	my($bgcolor, $text, $link, $vlink, $alink, $background, $topmargin, $leftmargin, $title, $fontsize, $border) = @_;
	if ($bgcolor eq '')	 { $bgcolor = '#FFFFFF'; }
	if ($text eq '')	 { $text = '#000000'; }
	if ($link eq '')	 { $link = '#0000FF'; }
	if ($vlink eq '')	 { $vlink = '#FF0000'; }
	if ($alink eq '')	 { $alink = '#00FF00'; }
	if ($topmargin eq '')	 { $topmargin = 10; }
	if ($leftmargin eq '')	 { $leftmargin = 10; }
	if ($fontsize eq '')	{ $fontsize = 10; }
	my($inpfont) = $fontsize - 1;
	$fontsize .= 'pt';
	$inpfont .= 'pt';
	print "Content-type: text/html\n\n";
	print "<html><head>\n";
	print "<title>$title</title>\n";
	print "<meta http-equiv=\"Content-Language\" content=\"ja\">\n";
	print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=shift_jis\">\n";
	print "</head>\n";
	print "<style TYPE=text/css>\n";
		print "\t<!--\n";
		print "\t\tA:link { text-decoration:none; color:$link }\n";
		print "\t\tA:visited {text-decoration:none; color:$vlink }\n";
		print "\t\tA:active { text-decoration:none; color:$vlink }\n";
		print "\t\tA:hover{ text-decoration:none; color:$alink }\n";
		print "\t\tbody { font-size: $fontsize; }\n";
		print "\t\ttd { font-size: $fontsize; }\n";
		if ($border) {
			print "\t\tinput { font-size: $inpfont; border: 1 solid #008080 }\n";
			print "\t\tselect { font-size: $inpfont; border: 1 solid #008080 }\n";
			print "\t\ttextarea { font-size: $inpfont; border: 1 solid #008080 }\n";
		}
		print "\t-->\n";
	print "</style>\n";
	print "<body topmargin=$topmargin leftmargin=$leftmargin bgcolor=$bgcolor text=$text link=$link vlink=$vlink background=$background>\n";
}
#=======================================================================================
sub img_head{
	my($flag) = @_;
	!$flag && ($flag = 'gif');
	print "Content-type: image/$flag\n\n";
}
#=======================================================================================
sub imodehead {
	my($title) = @_;
	print "Content-type: text/html\n\n";
	print "<html><head>\n";
	print "<title>$title</title>\n";
	print "<meta http-equiv=\"Content-Language\" content=\"ja\">\n";
	print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=shift_jis\">\n";
	print "</head>\n";
	print "<body>\n";
}
#=======================================================================================
sub comma {
	local($_) = $_[0];
	1 while s/(.*\d)(\d\d\d)/$1,$2/;
	$_;
}
#=======================================================================================
sub send_email {
	my($sendmailpath, $uuencodepath, $subject, $from, $to, $cc, $bcc, $body, $files, $encoding, $separator) = @_;
	my($mimeid, $err, $name, $status, $message) = '';
	my(@ATTACH_FILES, @ENCODING, @ENCODE_DATA) = ();
	my(@TO) = split(/\,/, $to);
	my(@CC) = split(/\,/, $cc);
	my(@BCC) = split(/\,/,$bcc);
	my(@attach_files) = split(/\,/, $files);
	my(@encoding) = split(/\,/, $encoding);
	my($i, $filename, $tmpfile);
	!$separator && ($separator = ',');
	my($mailto) = '';
	foreach (@TO) {
		if (/([\w\-\.]+\@[\w\-\.]+)/) {
			if ($mailto) { $mailto .= "$separator$1"; }
			else { $mailto = $1; }
		}
	}
	if ($mailto eq '') { return(); }
	$cc = '';
	foreach (@CC) {
		if (/([\w\-\.]+\@[\w\-\.]+)/) {
			if ($cc) { $cc .= "$separator$1"; }
			else { $cc = $1; }
		}
	}
	$bcc = '';
	foreach (@BCC) {
		if (/([\w\-\.]+\@[\w\-\.]+)/) {
			if ($bcc) { $bcc .= "$separator$1"; }
			else { $bcc = $1; }
		}
	}
	if (!$mailto) { return('Err NotMailAddress'); }
	if ($sendmailpath =~ /blatj/i) {
		$tmpfile = "$$\.tmp";
		if (open(TMP,">$tmpfile")) {
			print TMP $body;
			close(TMP);
		} else { return('bad New TemporaryFile'); }
		if ($cc) { $cc = " -c $cc"; }
		if ($bcc) { $bcc = " -b $bcc"; }
		$files =~ s/\//\\/g;
		if (-f $files && $encoding eq 'text') {		$attach = " -attacht $files"; }
		if (-f $files && $encoding eq 'base64') {	$attach = " -base64 -attach $files"; }
		if (-f $files && $encoding eq 'uuencode') {	$attach = " -uuencode -attach $files"; }
		if (-f $files && $encoding eq 'mime') {		$attach = " -mime -attach \"$files\""; }
		if (open(MAIL,"| $sendmailpath $tmpfile -s \"$subject\" -f $from -t $mailto$cc$bcc$attach -q")) {
			close(MAIL);
		} else { $err = 'Error Open sendmail Failure'; }
		unlink $tmpfile;
	} else {
		for ($i = 0; $i < @attach_files; ++$i) {
			if (!(-e $attach_files[$i])) {
				$err = "$attach_files[$i] does not exist.";
				return($err);
			}
			push(@ATTACH_FILES, $attach_files[$i]);
			push(@ENCODING, $encoding[$i]);
		}
		if ($encoding =~ /mime/i) {
			$mimeid = 'perl-lib_pl_send_email_-' . time;
		}
		if (open(MAIL,"| $sendmailpath -t -n")) {
			binmode MAIL;
			print MAIL "From: $from$CR";
			print MAIL "To: $mailto$CR";
			print MAIL "Cc: $cc$CR" if $cc;
			print MAIL "Bcc: $bcc$CR" if $bcc;
			print MAIL "Subject: $subject$CR";
			if ($mimeid) {
				print MAIL "x-sender: $from$CR";
				print MAIL "x-mailer: perl-lib$CR";
				print MAIL "Mime-Version: 1.0$CR";
				print MAIL "Content-Type: multipart/mixed; boundary=\"$mimeid\"$CR";
				print MAIL "--$mimeid$CR";
				print MAIL "Content-Type: text/plain; charset=\"iso-2022-jp\"$CR$CR";
				#print MAIL "Content-transfer-encoding: quoted-printable$CR$CR";
			} else { print MAIL $CR; }
			print MAIL $body;
			print MAIL $CR;
			for ($i = 0; $i < @ATTACH_FILES; ++$i) {
				$attach_file = $ATTACH_FILES[$i];
				$encoding = $ENCODING[$i];
				$attach_file =~ /[\\\/:]([^\\\/:]+)$/g;
				$filename = $1;
				if (-e $attach_file) {
					if ($encoding eq 'uuencode') {
						print MAIL "Attachment:\t$filename$CR";
						print MAIL "Encoding:\tUUEncoded$CR";
						if ($uuencodepath && -e $uuencodepath) {
							if (open(FIL,"$uuencodepath $attach_file $filename |")) {
								@ENCODE_DATA = <FIL>;
								close(FIL);
								print MAIL @ENCODE_DATA;
							} else { $err = 'Error Not Open uuencode'; }
						} else {
							$encode_data = &changeuuencode($attach_file);
							print MAIL "begin 644 $filename\n";
							print MAIL $encode_data;
							print MAIL "`\nend\n\n";
						}
					} elsif ($encoding eq 'mime') {
						print MAIL "--$mimeid$CR";
						if (-T $attach_file) {
							print MAIL "Content-type: text/plain; charset=iso-2022-jp; name=\"$filename\"$CR";
						} else {
							if ($filename =~ /\.jpg/i || $filename =~ /\.jpeg/i) {
								print MAIL "Content-type: image/jpeg; name=\"$filename\"$CR";
							} elsif ($filename =~ /\.gif/i) {
								print MAIL "Content-type: image/gif; name=\"$filename\"$CR";
							} elsif ($filename =~ /\.png/i) {
								print MAIL "Content-type: image/png; name=\"$filename\"$CR";
							} else {
								print MAIL "Content-type: application/octet-stream; name=\"$filename\"$CR";
							}
						}
						print MAIL "Content-transfer-encoding: base64$CR$CR";
						$encode_data = &changebase64($attach_file);
						print MAIL "$encode_data$CR";
					} else {
						if (open(TEXT, $attach_file)) {
							print MAIL "Attachment:\t$filename$CR";
							print MAIL "Encoding:\tNone$CR$CR";
							while (<TEXT>) { s/^\.([\n\r\f]+)/..$1/; print MAIL }
							close(TEXT);
							print MAIL "\n\n";
						}
					}
				}
			}
			if ($mimeid) { print MAIL "--$mimeid--$CR" }
			print MAIL "$CR.$CR";
			close(MAIL);
		} else { $err = 'Error Open sendmail Failure'; }
	}
	$err;
}
#=======================================================================================
sub changeuuencode {
	my($file, $flag) = @_;
	my($encode, $line);
	if ($flag) {
		if (open(FIL, $file)) {
			while (<FIL>) {
				$encode .= unpack("u", $_);
			}
			close(FIL);
		}
	} else {
		if (open(FIL, $file)) {
			while (read(FIL, $line, 45)) {
				$encode .= pack("u", $line);
			}
			close(FIL);
		}
	}
	$encode;
}
#=======================================================================================
sub changebase64 {
	my($file) = $_[0];
	my($encode, $line) = '';
	my($len, $bytes, $pad) = 0;
	if (open (FIL, "<$file")) {
		while ($bytes = read(FIL, $line, 45)) {
			$len += $bytes;
			$encode .= substr(pack('u', $line), 1);
			chop($encode);
		}
		close(FIL);
		$encode =~ tr| -_`|A-Za-z0-9+/A|;
		$pad = (3 - ($len % 3)) % 3;
		substr($encode, -$pad, $pad) = '=' x $pad;
		$encode =~ s/(.{76})/$1\n/g;
	}
	$encode;
}
#=======================================================================================
sub data_read {
	my($data_path) = @_;
	my(@READ_DATA);
	if (open(DB,"$data_path")) {
		@READ_DATA = <DB>;
		close(DB);
	}
	@READ_DATA;
}
#=======================================================================================
sub data_save {
	my($data_path, @WRITE_DATA) = @_;
	my($err) = '';
	my($os) = &os();
	my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks);
	$data_path =~ /(.+)\..+$/;
	my($filename) = $1;
	my($date) = time + $timelag * 3600;
	if ($filename !~ /.+/) { $err = 'bad Filename(Not Extension?)'; }
	if (!$err) {
		my($tmpfile) = "$filename.tmp";
		my($tmpflag) = 0;
		foreach (1 .. 10) {
			unless (-f $tmpfile) { $tmpflag = 1; last; }
			($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($tmpfile);
			if ($date - $mtime > 600) { unlink $tmpfile; $tmpflag = 1; last; }
			$tmpflag = 0;
			sleep(1);
		}
		if ($tmpflag) {
			$tmp_dummy = "$$\.tmp";
			if (!open(TMP,">$tmp_dummy")) { $err = 'bad New TemporaryFile'; }
			if (!$err) {
				close(TMP);
				chmod 0666,$tmp_dummy;
				if (!open(TMP,">$tmp_dummy")) { $err = 'bad New TemporaryFile'; }
				if (!$err) {
					binmode TMP;
					print TMP @WRITE_DATA;
					close(TMP);
					foreach (1 .. 10) {
						unless (-f $tmpfile) {
							if (!open(TMP,">$tmpfile")) {
								$err = 'bad LockFile System';
								last;
							}
							if (!$err) {
								close(TMP);
								$os =~ /windows/i && unlink $data_path;
								rename($tmp_dummy, $data_path);
								unlink $tmpfile;
								last;
							}
						}
						sleep(1);
					}
				}
			}
		}
	}
	$err;
}
#=======================================================================================
sub upload {
	my($autoname, $ftype, $fmt, $dir, $max, $permission, $mode, $japanese, $variable) = @_;
	!$variable && ($variable = 'QUERY');
	my(@UPLOADFILES);
	my(@UPLOAD) = grep(/filename=\"(.+)\"\s*Content\-Type:/, @$variable);
	my($name, $localpath, $filename, $fname, $filepath, $ext, $filetype, $format, $writeflag, $err);
	if ($permission < 604) { $permission = 644; }
	$permission = sprintf("%04d", $permission);
	if ($dir && $dir !~ /\/$/) { $dir .= "/"; }
	my($uploadfiles) = 0;
	foreach (@UPLOAD) {
		$writeflag = 0; $err = '';
		if ($japanese) {
			#	日本語ファイル名使用可能
			/name=\"(.*)\";\sfilename=\"((.*\\|)(.+))\"\s*Content\-Type:\s*(.*)\/(.*)/i;
			$name = $1; $localpath = $2; $filename = $4; $filetype = $5; $format = $6;
		} else {
			#	日本語ファイル名使用不可
			/name=\"(.*)\";\sfilename=\"((.*\\|)([\w-\.]*))\"\s*Content\-Type:\s*(.*)\/(.*)/i;
			$name = $1; $localpath = $2; $filename = $4; $filetype = $5; $format = $6;
		}
		if ($filename =~ /(.*)\.(.*)/) {
			$fname= $1;
			$ext = $2;
		} else {
			$fname = $filename;
			$format =~ s/pjpeg/jpg/;
			$ext = $format;
			$filename .= "\.$ext";
		}
		$filename =~ s/\ /\_/g;
		if ($filename eq '') {
			$err = 'Bad FileName';
		}
		if ($ftype) {
			if ($ftype =~ /$filetype/i) {
				if ($fmt) {
					if ($format =~ /$fmt/i) {
						$writeflag = 1;
					} else {
						$writeflag = 0;
						$err = 'bad ImageType(jpeg,gif,png)';
					}
				} else {
					$writeflag = 1;
				}
			}else {
				$writeflag = 0;
				$err = 'bad FileType';
			}
		} else {
			$writeflag = 1;
		}
		if ($max) {
			if (length($$variable{$name}) > $max) {
				$writeflag = 0;
				$err = 'bad Max FileSize';
			}
		}
		if ($writeflag && !$err) {
			if ($autoname) {
				$sys = abs($$) + $uploadfiles;
				$filename = time . "$sys\.$ext";
			}
			$filepath = "$dir$filename";
			if (-f $filepath) { chmod(0666, $filepath); }
			if ($mode =~ /text/i) { $$variable{$name} =~ s/\r\n/\n/g; }
			if (open(FIL, ">$filepath")) {
				binmode FIL;
				print FIL $$variable{$name};
				close FIL;
				chmod(eval($permission), $filepath);
			}
		}
		push(@UPLOADFILES, "name=$name\tlocal=$localpath\tfilename=$filename\tfiletype=$filetype\tformat=$format\terr=$err");
		$uploadfiles++;
	}
	if (@UPLOADFILES < 1) { push(@UPLOADFILES, "name=\tlocal=\tfilename=\tfiletype=\tformat=\terr=UploadFile Not Select"); }
	@UPLOADFILES;
}
#=======================================================================================
sub getimagetype {
	my($img) = @_;
	my($type) = substr($img, 0, 24);
	if ($type =~ /jfif/i || $type =~ /exif/i) { $type = 'JPG'; }
	elsif ($type =~ /gif/i) { $type = 'GIF'; }
	elsif ($type =~ /BM/) { $type = 'BMP'; }
	elsif ($type =~ /PNG/) { $type = 'PNG'; }
	else { $type = ''; }
	$type;
}
#=======================================================================================
sub imagesize {
	my($img) = @_;
	my($width, $height, $buffer, @DUMMY, $flag);
	if (open(IMG, "$img")) {
		binmode IMG;
		read(IMG, $type, 16);
		seek(IMG, 0, 0);
		if ($type =~ /jfif/i || $type =~ /exif/i) {
			$type = 'JPG';
			seek(IMG, 2, 0);
			while (!eof(IMG)) {
				read(IMG, $buffer, 4);
				@DUMMY = unpack("aan", $buffer);
				if (ord($DUMMY[0]) != 255) {
					$width = 0;
					$height = 0;
					last;
				} elsif (ord($DUMMY[1]) >= 192 && ord($DUMMY[1]) <= 195) {
					read(IMG, $buffer, 5);
					($height, $width) = unpack("xnn", $buffer);
					last;
				} else { read(IMG, $buffer, ($DUMMY[2] - 2)); }
			}
		} elsif ($type =~ /gif/i) {
			$type = 'GIF';
			seek(IMG, 6, 0);
			read(IMG, $buffer, 4);
			@DUMMY = unpack("C"x 4, $buffer);
			$width = $DUMMY[1] * 256 + $DUMMY[0];
			$height = $DUMMY[3] * 256 + $DUMMY[2];
		} elsif ($type =~ /^BM/) {
			$type = 'BMP';
			seek( IMG, 18, 0 );
			read( IMG, $buffer, 8 );
			($width, $height) = unpack("LL", $buffer);
		} elsif ($type =~ /PNG/) {
			$type = 'PNG';
			seek(IMG, 0, 0);
			read(IMG, $buffer, 24);
			($width, $height) = unpack("x16 NN", $buffer);
			if (!$width && !$height) {
				seek(IMG, 8, 0);
				while(1){
					read(IMG, $buffer, 8 );
					($offset, $flag) = unpack("NA4", $buffer);
					if($flag eq 'IHDR'){
						read(IMG, $buffer, 8);
						($width, $height) = unpack("NN", $buffer);
						last;
					} elsif ($flag eq 'IEND' ){
						$type= '';
						$width = 0;
						$height = 0;
						last;
					} else { seek(IMG, $offset + 4, 1); }
				}
			}
		} else { return(0, 0); }
		close(IMG);
		return($width, $height, $type);
	} else { return(0, 0); }
}
#=======================================================================================
sub sumnail {
	my($img, $maxsize, $flag) = @_;
	my($width, $height) = &imagesize($img);
	if ($width == 0 || $height == 0) { return(0, 0); }
	my($new_width, $new_height, $rate);
	if ($flag && $width <= $maxsize && $height <= $maxsize) {
		$new_width = $width;
		$new_height = $height;
	} else {
		if ($width >= $height) {
			$rate = $height / $width;
			$new_width = $maxsize;
			$new_height = int($maxsize * $rate);
		} else {
			$rate = $width / $height;
			$new_width = int($maxsize * $rate);
			$new_height = $maxsize;
		}
	}
	return($new_width, $new_height, $width, $height);
}
#=======================================================================================
sub sumnailcopy {
	my($FLY, $srcfile, $desfile, $newwidth) = @_;
	if ($FLY && (-e $FLY || -e "$FLY.exe")) {
		if ($srcfile && -f $srcfile && $desfile && $newwidth) {
			my($width, $height) = imagesize($srcfile);
			if ($width == 0 && $height == 0) { return('404 file not fund'); }
			my($newheight) = int($height / ($width / $newwidth) + 0.5);
			my($infile) = "$$.tmp";
			open(FLY,"> $infile");
				print FLY "new\n";
				print FLY "size $newwidth, $newheight\n";
				print FLY "copyresized -1,-1,-1,-1,0,0,$newwidth,$newheight,$srcfile\n";
			close(FLY);
			open(IMG,"| $FLY -o $desfile -i $infile -q");
			close(IMG);
			open(IMG,"$outfile");
				binmode(IMG);
				binmode(STDOUT);
				print $_ while (<IMG>);
			close(IMG);
			unlink($infile);
			return();
		} else { return('Abnormal Parameter'); }
	} else { return("Graphic Utility not [On The Fly] $FLY"); }
}
#=======================================================================================
sub tag_change {
	$_ = $_[0];
	s/&eq;/=/g;
	1 while s/(.*)(&lt;(img([!-:A-~\s\=]+))&gt;)/$1<img$4>/i;
	1 while s/(.*)(&lt;(b)&gt;(.*)&lt;\/b&gt;)/$1<b>$4<\/b>/i;
	1 while s/(.*)(&lt;(u)&gt;(.*)&lt;\/u&gt;)/$1<u>$4<\/u>/i;
	1 while s/(.*)(&lt;(i)&gt;(.*)&lt;\/i&gt;)/$1<i>$4<\/i>/i;
	1 while s/(.*)(&lt;(font[\s\w\=\#\"\']+)\&gt;(.*)\&lt;\/font\&gt;)/$1<$3>$4<\/font>/i;
	s/=/&eq;/g;
	$_;
}
#=======================================================================================
sub tag_check {
	local($_, @FREETAGS) = @_;
	my(%SINGLETAGS) = ('input',1,'br',1,'hr',1,'img',1,'meta',1);
	my(@TAGS, @REVTAGS, @OPENTAGS, @CLOSETAGS);
	my($tagname, $match, $word, $i, $string, $opentags, $closetags);
	s/&lt;/</g; s/&gt;/>/g; s/&eq;/=/g;
#	s/<meta [\w\"\-\=\;\ \/]*>\r//ig;
	s/<!\-\-.*\-\->//g;
	if (/\</) {
		@TAGS = split(/\</,$_);
		@REVTAGS = reverse(@TAGS);
		foreach (@REVTAGS) {
			if (/(\/(\w+)\>)/i) {
				$tagname = $2;
				$tagname=~ tr/[A-Z]/[a-z]/;
				if (grep(/$tagname/, @FREETAGS)) { push(@CLOSETAGS, "</$tagname>"); }
			}
		}
		!$TAGS[0] && shift(@TAGS);
		foreach (@TAGS) {
			if (/>/) {
				$_ = "<$_";
				$match = 0;
				if (/<(\w+)/i) {
					$word = $1;
					$word =~ tr/[A-Z]/[a-z]/;
					push(@OPENTAGS,"<$word\>");
					foreach $tag (@FREETAGS) {
						if ($word eq $tag) {
							if ($SINGLETAGS{$word}) { $match = 1; }
							else {
								$i = 0;
								foreach $closetag (@CLOSETAGS) {
									if ($closetag eq "<\/$word>") {
										$match = 1;
										last;
									}
									$i++;
								}
								if ($match) { splice(@CLOSETAGS, $i, 1); }
							}
						}
					}
				} else {
					if (/<\/(\w+)>/i) {
						$word = $1;
						$word =~ tr/[A-Z]/[a-z]/;
						if (!grep(/$word/, @FREETAGS)) {
							 s/<\/$word>//g;
							 $match = 1;
						} else {
							$i = 0;
							foreach $opentag (@OPENTAGS) {
								if ($opentag eq "<$word>") {
									$match = 1;
									last;
								}
								$i++;
							}
							if ($match) { splice(@OPENTAGS, $i, 1); }
						}
					} else { $match = 1; }
				}
			} else { s/[!-:A-~\s\=]+//; $match = 1; }
			#if (!$match) { s/[<>!-:A-~\s\=\"\;]+//; }
			if (!$match) { s/<.*>//; }
			$string .= $_;
		}
	} else { $string = $_; }
	$string =~ s/\t//g;
	$string =~ s/\n\n//g;
	$string =~ s/\r\r//g;
	$string;
}
#=======================================================================================
sub inline_link { 
	local($_, $string) = @_;
	if ($string) {
		s/([^=^\"]|^)((http|ftp):[!#-9A-~?=]+)/$1<a href=$2 target=_top>$string<\/a>/g; 
	} else {
		s/([^=^\"]|^)((http|ftp):[!#-9A-~?=]+)/$1<a href=$2 target=_top>$2<\/a>/g; 
	}
	s/([\w\-\_\.]+\@[\w\-\_\.]+)/<a href=mailto:$1>$1<\/a>/g;
	$_; 
}
#=======================================================================================
sub domain {
	local($flag) = @_;
	local($addr) = $ENV{'REMOTE_ADDR'};
	local($_) = gethostbyaddr(pack("C4",split(/\./,$addr)),2);
	if ($_ eq '') { $_ = $addr; }
	else {
		if ($flag) {
			if (/.+\.(.+)\.(.+)\.(.+)$/) { $_ = "\*\.$1\.$2\.$3"; }
			elsif (/.+\.(.+)\.(.+)$/) { $_ = "\*\.$1\.$2"; }
			elsif (/.+\.(.+)$/) { $_ = "\*\.$1"; }
			else { $_ = "on the internet"; }
		}
	}
	$_;
}
#=======================================================================================
sub user_agent {
	$_ = $ENV{'HTTP_USER_AGENT'};
	s/,/./g;
	s/</&lt;/g;
	s/>/&gt;/g;
	$_;
}
#=======================================================================================
sub jst_time {
	my($serialtime, $flag) = @_;
	my(@DATE) = localtime($serialtime);
	$DATE[5] += 1900;
	$DATE[4]++;
	if ($flag == 0 || $flag == 1 || $flag == 2) {
		$DATE[6] = ('日','月','火','水','木','金','土') [$DATE[6]];
		if ($flag == 0) {
			$_ = "$DATE[5]年$DATE[4]月$DATE[3]日($DATE[6]) $DATE[2]:$DATE[1]:$DATE[0]";
		} elsif ($flag == 1) {
			$_ = "$DATE[5]年$DATE[4]月$DATE[3]日($DATE[6])";
		} else {
			$_ = "$DATE[5]年$DATE[4]月$DATE[3]日";
		}
	} else {
		$DATE[6] = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$DATE[6]];
		if ($flag == 3) {
			$_ = "$DATE[5]/$DATE[4]/$DATE[3]($DATE[6]) $DATE[2]:$DATE[1]:$DATE[0]";
		} elsif ($flag == 4) {
			$_ = "$DATE[5]/$DATE[4]/$DATE[3]($DATE[6])";
		} elsif ($flag == 5) {
			$_ = sprintf("%04d/%02d/%02d", $DATE[5], $DATE[4], $DATE[3]);
		} elsif ($flag == 6) {
			$_ = "$DATE[5]/$DATE[4]/$DATE[3] $DATE[2]:$DATE[1]";
		} elsif ($flag == 7) {
			$_ = "$DATE[5]/$DATE[4]/$DATE[3] $DATE[2]:$DATE[1]:$DATE[0]";
		} else {
			$_ = sprintf("%02d/%02d %02d:%02d", $DATE[4], $DATE[3], $DATE[2], $DATE[1]);
		}
	}
}
#=======================================================================================
sub gengo {
	my($serialtime, $flag) = @_;
	if ($flag) {
		my($year, $month, $day) = split(/\//, $serialtime);
		if ($flag =~ /h/i) { $year += 1988; }
		elsif ($flag =~ /s/i) { $year += 1925; }
		elsif ($flag =~ /t/i) { $year += 1911; }
		elsif ($flag =~ /m/i) { $year += 1867; }
		sprintf("%04d/%02d/%02d", $year, $month, $day);
	} else {
		my($jst) = &jst_time($serialtime, 5);
		my(@DATE) = localtime($serialtime);
		my($gengo, $year);
		$DATE[5] += 1900;
		$DATE[4]++;
		$DATE[6] = ('日','月','火','水','木','金','土') [$DATE[6]];
		if ($jst ge "1989/01/08") { $gengo = '平成'; $year = $DATE[5] - 1988; }
		elsif ($jst ge "1926/12/25") { $gengo = '昭和'; $year = $DATE[5] - 1925; }
		elsif ($jst ge "1912/07/30") { $gengo = '大正'; $year = $DATE[5] - 1911; }
		elsif ($jst ge "1868/09/08") { $gengo = '明治'; $year = $DATE[5] - 1867; }
		"$gengo$year年$DATE[4]月$DATE[3]日($DATE[6])";
	}
}
#=======================================================================================
sub dateserial {
	my($date, $timelag) = @_;
	my(@DATE, @TIME, $time, $year, $day);
	($date, $time) = split(/ /, $date);
	if ($date =~ /(\d+)\D+(\d+)\D+(\d+)/) {
		$DATE[0] = $1; $DATE[1] = $2; $DATE[2] = $3;
	} else { return(0); }
	if ($time =~ /(\d+)\D+(\d+)\D+(\d+)/) {
		$TIME[0] = $1; $TIME[1] = $2; $TIME[2] = $3;
	}
	$year = $DATE[0] - 1970;
	if ($year < 0) { return(0); }
	$DATE[1]--; $DATE[2]--;
	foreach (1 .. $DATE[1]) {
		if ($_ == 4 || $_ == 6 || $_ == 9 || $_ == 11) { $day += 30;
		} elsif ($_ == 2) {
			if ($DATE[0] % 4 == 0) { $day += 29; }
			else { $day += 28; }
		} else { $day += 31; }
	}
	$day = $day + $DATE[2] + int(($DATE[0] - 1972) / 4 + 0.9);
	$year * 31536000 + $day * 86400 + $TIME[0] * 3600 + $TIME[1] * 60 + $TIME[2];
}
#=======================================================================================
sub calendar {
	my($year, $month, $timelag, $flag) = @_;
	$year += 0; $month += 0;
	my($date) = "$year/$month/1";
	my(@DATE) = localtime(dateserial($date, $timelag));
	my(@CALENDAR, $days, $i, $j);
	if ($month == 4 || $month == 6 || $month == 9 || $month == 11) { $days = 30;
	} elsif ($month == 2) {
		if ($year % 4 == 0) { $days = 29; }
		else { $days = 28; }
	} else { $days = 31; }
	if ($flag == 1) {
		$CALENDAR[0] = 'Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday';
	} elsif ($flag == 2) {
		$CALENDAR[0] = 'Sun,Mon,Tue,Wed,Thu,Fri,Sat';
	} else {
		$CALENDAR[0] = '日,月,火,水,木,金,土';
	}
	$j = 0;
	foreach (0 .. $DATE[6] - 1) {
		if ($_ == 0) { $CALENDAR[1] = ' '; }
		else { $CALENDAR[1] .= ', '; }
	}
	$i = 1; $j = $DATE[6];
	foreach (1 .. $days) {
		if ($j == 0) { $CALENDAR[$i] = $_; }
		else { $CALENDAR[$i] .= ",$_"; }
		$j++;
		if ($j > 6) { $j = 0; $i++; }
	}
	if ($j > 0) { foreach ($j .. 6) { $CALENDAR[$i] .= ', '; } }
	@CALENDAR;
}
#=======================================================================================
sub calendar2 {
	my($year, $month, $timelag, $flag, $return) = @_;
	my($date) = "$year/$month/1";
	my(@DATE) = localtime(dateserial($date, $timelag));
	my(@CALENDAR, $days, $j, $y, $m, $d);
	if ($month == 4 || $month == 6 || $month == 9 || $month == 11) { $days = 30;
	} elsif ($month == 2) {
		if ($year % 4 == 0) { $days = 29; }
		else { $days = 28; }
	} else { $days = 31; }
	if ($return) { return $days; }
	if ($flag) {
		if ($flag == 2) { @WEEK = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); }
		else { @WEEK = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); }
		$y = '/'; $m = '/'; $d = '';
	} else {
		@WEEK = ('日','月','火','水','木','金','土');
		$y = '年'; $m = '月'; $d = '日';
	}
	$j = $DATE[6];
	$year = sprintf("%04d", $year);
	$month = sprintf("%02d", $month);
	foreach (1 .. $days) {
		$_ = sprintf("%02d", $_);
		$CALENDAR[$_] = "$year$y$month$m$_$d($WEEK[$j])";
		$j++;
		if ($j > 6) { $j = 0; }
	}
	@CALENDAR;
}
#=======================================================================================
sub progpass {
	my($flag) = $_[0];
	my($s, @st);
	srand(time|$$);
	if ($flag =~ /N/i) {
		for ($i = 0; $i < 8; $i++) {
			$s .= (int(rand(9)) + 1);
		}
	} else {
		for ($i = 0; $i <= 3; $i++) {
			$st[$i] = int(rand(26)) + 97;
		}
		$s = pack("c4",$st[0],$st[1],$st[2],$st[3]);
		srand;
		for ($i = 0; $i <= 3; $i++) {
			$s .= (int(rand(9)) + 1);
		}
	}
	$s;
}
#=======================================================================================
sub ascscramble {
	local($_, $flag, $key, $addr) = @_;
	my($index, $j, $u_class, $d_class, $code, $length, $str);
	my(@ASC) = ('-','a'..'m','5'..'9','A'..'M','_','n'..'z','0'..'4','N'..'Z');
	if (!$addr) {
		my(@ADDR) = split(/\./, $ENV{'SERVER_ADDR'});
		foreach (@ADDR) { $addr += $_; }
		!$addr && ($addr = 128);#127.0.0.1
	}
	$key += $addr;
	if ($_ && $key) {
		if ($flag) {
			$length = length($_);
			for($index = 0; $index < $length; $index++) {
				$j = substr($_, $index, 1);
				$code = unpack("C", $j) + $key;
				$u_class = int($code / 64);
				$d_class = $code % 64;
				$str .= "$ASC[$u_class]$ASC[$d_class]";
			}
			$_ = $str;
		} else {
			$fix = int($key / 64);
			s/(.{1})(.{1})/"\0". ((ascno($1, @ASC) - $fix) * 64 + (ascno($2, @ASC) - $key % 64))/eg;
			s/\0(\d+)/pack("C", $1)/eg;
		}
	}
	$_;
}
sub ascno {
	my($chr, @ASC) = @_;
	my($code);
	foreach (0 .. @ASC - 1) { if ($chr eq $ASC[$_]) { $code = $_; last; } }
	$code;
}
#=======================================================================================
sub scramble {
	local($_, $flag, $key, $noins) = @_;
	local($index, $j, $class, $u_class, $d_class, $code, $length, $str, $create, $match);
	if ($_) {
		my(@INSERT);
		if (!$noins) {
			if ($key =~ /\d+/) {
				$create = abs($key);
				$length = length($create);
				for($index = 0; $index < $length; $index++) {
					$code = substr($create, $index, 1);
					if (grep(/$code/, @INSERT) < 1) {
						push(@INSERT, $code);
					}
				}
				@INSERT = sort(@INSERT);
				if ($key > 8649) { $key = $key % 8649; }
			}
		}
		if ($flag) {
			$length = length($_);
			for($index = 0; $index < $length; $index++) {
				$j = substr($_, $index, 1);
				$code = unpack("C", $j) + $key;
				$u_class = int($code / 93) + 33;
				$d_class = $code % 93 + 33;
				$str .= "\0$u_class\0$d_class";
			}
			$str =~ s/\0(\d+)/pack("C", $1)/eg;
			$length = length($str);
			$_ = '';
			srand(time|$$);
			for ($index = 0; $index <= $length; $index++) {
				foreach $j (@INSERT) {
					if ($index == $j) {
						shift(@INSERT);
						$_ .= pack("C", int(rand(93)) + 33);
						last;
					}
				}
				$_ .= substr($str, $index, 1);
			}
			s/=/ /g;
		} else {
			s/ /=/g;
			$length = length($_);
			$index = 0; $str = '';
			foreach (@INSERT) { $_ += $index; $index++; }
			for ($index = 0; $index <= $length; $index++) {
				$match = 0;
				foreach $j (@INSERT) {
					if ($index == $j) {
						shift(@INSERT);
						$match = 1;
						last;
					}
				}
				if (!$match) { $str .= substr($_, $index, 1); }
			}
			$_ = $str;
			s/(.{1})(.{1})/"\0". ((unpack("C", $1) - 33) * 93 + (unpack("C", $2) - 33 - $key))/eg;
			s/\0(\d+)/pack("C", $1)/eg;
		}
	}
	$_;
}
#=======================================================================================
sub cookie_regist {
	my($cookiename, $cookielist, $date) = @_;
	!$date && ($date = 30);
	my(@COOKIELIST) = split(/\,/, $cookielist);
	my(%COOK);
	my(@DATE) = localtime(time + $date * 86400);
	$DATE[5] += 1900;
	$DATE[3] = sprintf("%02d",$DATE[3]);
	$DATE[2] = sprintf("%02d",$DATE[2]);
	$DATE[1] = sprintf("%02d",$DATE[1]);
	$DATE[0] = sprintf("%02d",$DATE[0]);
	my($wday) = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$DATE[6]];
	my($month) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') [$DATE[4]];
	my($date_gmt) = "$wday, $DATE[3]\-$month\-$DATE[5] $DATE[2]:$DATE[1]:$DATE[0] GMT";
	my($cookievalue, $key, $value);
	foreach (@COOKIELIST) {
		($key, $value) = split(/=/, $_);
		$key =~ s/\,/&comma/g;
		$key =~ s/:/&colon/g;
		$key =~ s/;/&semicolon/g;
		$value =~ s/\,/&comma/g;
		$value =~ s/:/&colon/g;
		$value =~ s/;/&semicolon/g;
		if ($cookievalue) {
			$cookievalue .= ",$key:$value";
		} else {
			$cookievalue = "$key:$value";
		}
		$COOK{$key} = $value;
	}
	print "Set-Cookie: $cookiename=$cookievalue; expires=$date_gmt\n";
	%COOK;
}
#=======================================================================================
sub cookie_read {
	my($cookiename) = @_;
	my($key, $value, %COOK);
	my($cookies) = $ENV{'HTTP_COOKIE'};
	my(@pairs) = split(/;/,$cookies);
	my(@DUMMY);
	foreach $pair (@pairs) {
		($key, $value) = split(/=/, $pair);
		$key =~ s/ //g;
		$DUMMY{$key} = $value;
	}
	@pairs = split(/\,/,$DUMMY{$cookiename});
	foreach $pair (@pairs) {
		($key, $value) = split(/:/, $pair);
		$key =~ s/&comma/\,/g;
		$key =~ s/&colon/\:/g;
		$key =~ s/&semicolon/\;/g;
		$value =~ s/&comma/\,/g;
		$value =~ s/&colon/\:/g;
		$value =~ s/&semicolon/\;/g;
		$COOK{$key} = $value;
	}
	%COOK;
}
#=======================================================================================
sub age {
	my($date, $timelag) = @_;
	my($year, $month, $day) = split(/\//, $date);
	my(@DATE) = localtime(time + $timelag * 3600);
	$DATE[5] += 1900; $DATE[4]++;
	my($age) = $DATE[5] - $year;
	if ($month > $DATE[4]) { $age--; }
	elsif ($month == $DATE[4]) {
		if ($day > $DATE[3]) { $age--; }
	}
	$age;
}
#=======================================================================================
sub kaconv {
	my($string) = @_;
	my($len) = klength($string);
	my($str) = '';
	for ($i=0;$i < $len;$i++) {
		$str .= kaconv2(ksubstr($string, $i, 1));
	}
	$str;
}
sub kaconv2 {
	my($string) = @_;
	my($i, $j, $unpack, $pack);
	my($length) = length($string);
	local($_);
	for($i = 0; $i < $length; $i++) {
		$j = substr($string, $i, 1);
		$_ .= "!". unpack("C", $j);
	}
	my(@ASCII) = ('64-32', '73-33', '104-34', '148-35', '144-36', '147-37', '149-38', '102-39',
			'105-40', '106-41', '150-42', '123-43', '67-44', '124-45', '68-46', '94-47',
			'70-58', '71-59', '131-60', '129-61', '132-62', '72-63', '151-64', '109-91',
			'143-92', '110-93', '79-94', '81-95', '111-123', '98-124', '112-125', '96-126'
		);
	foreach $ascii (@ASCII) {
		($unpack, $pack) = split(/\-/, $ascii);
		s/!129!$unpack/!$pack/g;
	}
	while (/(^|!(\d+))!130!(\d+)/) {
		if (($3 >= 63 && $3 <= 88)||($3 >= 96 && $3 <= 121)) {
			$st = $3 - 31;
			$_ =~ s/!130!(\d+)/!$st/;
		} elsif ($3 >= 129 && $3 <= 154 && $2 < 129) {
			$st = $3 - 32;
			$_ =~ s/!130\!(\d+)/!$st/;
		} else {
			$_ =~ s/!130!(\d+)/;130!$1/;
		}
	}
	s/;(\d+)/pack("C", $1)/eg;
	s/!(\d+)/pack("C", $1)/eg;
	$_;
}
#=======================================================================================
sub fields {
	my($fields, $separator) = @_;
	!$separator && ($separator = "\t");
	my(@FIELDS) = split(/$separator/, $fields);
	my(%FIELD);
	my($key, $value);
	foreach (@FIELDS) {
		($key, $value) = split(/=/, $_);
		$value =~ s/&eq;/=/g;
		$value =~ s/&colon;/:/g;
		$value =~ s/&apos;/!/g;
		$FIELD{$key} = $value;
	}
	%FIELD;
}
#=======================================================================================
sub fcopy {
	my($src, $des, $permission) = @_;
	my($err);
	!-e "$src" && return('File Not Found');
	!copy($src, $des) && return('Failure Copy');
	if ($permission) {
		chmod(eval($permission), $des);
	}
	0;
}
#=======================================================================================
sub readini {
	my($filename) = @_;
	my($section, $key, $value, $err);
	if (open(INI,"$filename")) {
		my(@LIST) = <INI>;
		close(INI);
		foreach (@LIST) {
			s/\n//g; s/(\;.*$)//; s/\r//g;
			if ($_ ne '' && $_ !~ /^#/) {
				if (/^\[(.+)\]/) {
					$section = $1;
					undef %$section;
					undef @$section;
				} else {
					if ($section) {
						if (/=/) {
							($key, $value) = split(/=/, $_);
							1 while $key =~ s/^ //; 1 while $key =~ s/ $//;
							1 while $value =~ s/^ //; 1 while $value =~ s/ $//;
							$$section{$key} = $value;
						} else { push(@$section, $_); }
					}
				}
			}
		}
	} else { $err = 'Not Read Initial setting File'; }
}
#=======================================================================================
sub saveini {
	my($filename, $inittext) = @_;
	my(@LIST) = split(/\r/, $inittext);
	my($err);
	if (open(INI,">$filename")) {
		my($i) = 0;
		foreach (@LIST) {
			s/&eq;/=/g; s/&lt;/</g; s/&gt;/>/g;
			if (/^\[.+\]/ && $i) { print INI "\n"; }
			if ($_) { print INI "$_\n"; }
			$i++;
		}
		close(INI);
	} else { $err = 'Not Open Initial setting File'; }
}
#=======================================================================================
sub readparts {
	my($variable, $changestr, $jcode) = @_;
	!$variable && ($variable = 'QUERY');
	undef @$variable; undef %$variable;
	my($QUERY_DATA, $boundary, @PAIRS, $name, $value, $filename, $contenttype, $content, $c);
	binmode(STDIN);
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $QUERY_DATA, $ENV{'CONTENT_LENGTH'});
	} else { $QUERY_DATA = $ENV{'QUERY_STRING'}; }
	if ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/i) {
		if ($ENV{'REQUEST_METHOD'} ne "POST") { return(not FormData Method POST); }
		$QUERY_DATA =~ /^(.+)(\r|\n)/; $boundary = $1;
		$QUERY_DATA =~ s/Content\-Disposition:\sform\-data;\s//g;
		@PAIRS = split(/$boundary/, $QUERY_DATA);
		$c = $boundary; $c =~ s/\r//g; $c =~ s/\n//g;
		shift(@PAIRS);
		foreach (@PAIRS) {
			if (/name=\".*\";\sfilename=\".*\"\s*Content\-Type/i) {
				s/(name=\"(.*)\";\sfilename=\"(.*)\"\s*(Content\-Type:\s*(.*)\/(.*))\s*)//;
				$name = $2; $filename = $3; $contenttype = $4;
				$content = "name=\"$name\"; filename=\"$filename\" $contenttype";
				s/^\n//;
				if ($contenttype =~ /text/) { s/\r\n$//; }
				if ($_) {
					s/\r\n$//;
					$$variable{$name} = $_;
					push (@$variable, $content);
				}
			} else {
				s/name="(.*)"\s*//; $name = $1;
				$value = $_;
				$value =~ s/$c\-\-//;
				$value =~ s/\r$//g;
				$name = &encoding($name, $changestr, $jcode);
				$value = &encoding($value, $changestr, $jcode);
				if ($$variable{$name} ne '') {
					$$variable{$name} .= "\0$value";
					foreach $line (@$variable) {
						if ($line =~ /name=\"$name\";/) {
							$line =~ s/value=\".*\"$/value=\"$$variable{$name}\"/;
							last;
						}
					}
				} else {
					$$variable{$name} = $value;
					$content = "name=\"$name\"; value=\"$value\"";
					push (@$variable, $content);
				}
			}
		}
	} else {
		@PAIRS = split(/&/,$QUERY_DATA);
		foreach (@PAIRS) {
			($name, $value) = split(/=/, $_);
			$name = &encoding($name, $changestr, $jcode);
			$value = &encoding($value, $changestr, $jcode);
			if ($$variable{$name} ne '') {
				$$variable{$name} .= "\0$value";
				foreach $line (@$variable) {
					if ($line =~ /name=\"$name\";/) {
						$line =~ s/value=\".*\"$/value=\"$$variable{$name}\"/;
						last;
					}
				}
			} else {
				$$variable{$name} = $value;
				$content = "name=\"$name\"; value=\"$value\"";
				push (@$variable, $content);
			}
		}
	}
	0;
}
#=======================================================================================
sub encoding {
	local($_, $changestr, $encode) = @_;
	tr/+/ /;
	s/%([a-fA-F0-9]{2})/pack("c", hex($1))/eg;
	1 while s/\r$//g;
	1 while s/\s$//;
	s/\n//g;
	s/\t/　　/g;
	if ($changestr) {
		$changestr =~ /</ && (s/</&lt;/g);
		$changestr =~ />/ && (s/>/&gt;/g);
		$changestr =~ /=/ && (s/=/&eq;/g);
		$changestr =~ /\"/ && (s/\"/&quot;/g);
		$changestr =~ /\!/ && (s/\"/&apos;/g);
		$changestr =~ /\:/ && (s/\:/&colon;/g);
	}
	if ($encode) { &jcode'convert(*_, $encode); }
	$_;
}
#=======================================================================================
sub changecsv {
	my($src, $des, $keys) = @_;
	my(@FIELDS, $key, $value, $line, $i, $keycount, $err);
	@KEYS = split(/\,/, $keys);
	$keycount = @KEYS - 1;
	if (open(SRC, "$src")) {
		if (open(DES, ">$des")) {
			while (<SRC>) {
				if ($keys) {
					$line = ''; $i = 0;
					@FIELDS = split(/\,/, $_);
					foreach $field (@FIELDS) {
						$fields =~ s/\n//g;
						$fields =~ s/=/&eq;/g;
						$fields =~ s/</&lt;/g;
						$fields =~ s/>/&gt;/g;
						if ($i > $keycount) { last; }
						if (!$line) { $line = "$KEYS[$i]=$field"; }
						else { $line .= "\t$KEYS[$i]=$field"; }
						$i++;
					}
					$line .= "\t\n";
					print DES $line;
				} else {
					$line = '';
					@FIELDS = split(/\t/, $_);
					foreach $field (@FIELDS) {
						($key, $value) = split(/=/, $field);
						$value =~ s/\r//g;
						$value =~ s/\n//g;
						$value =~ s/&eq;/=/g;
						$value =~ s/&lt;/</g;
						$value =~ s/&gt;/>/g;
						if (!$line) { $line = $value; }
						else { $line .= ",$value"; }
					}
					$line .= "\n";
					print DES $line;
				}
			}
			close(DES);
		} else { $err = "Not Writing $des";; }
		close(SRC);
	} else { $err = "$src Not Found"; }
	$err;
}
#=======================================================================================
sub hexstr {
	my($string, $flag) = @_;
	my($len, $i, $hexstr);
	$len = length($string);
	if ($flag) {
		for ($i = 0; $i < $len; $i++) {
			$hexstr .= unpack("H2", substr($string, $i, 1));
		}
		$hexstr;
	} else {
		$string =~ s/([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$string;
	}
}
#=======================================================================================
sub ichr {
	#------------------------------------
	# Installation i-Mode Image Directory
	#
	my($dir) = '/usr/lib/imode/';
	#------------------------------------
	local($_) = &hexstr($_[0], 1);
	my($flag) = $_[1];
	my($i, $code, $img);
	if ($flag == 2) { $img = '(^!^)'; } else { $img = ''; }
	for ($i = 63647; $i <= 63920; $i++) {
		$code = sprintf("%04X", $i);
		if ($flag == 1) { $img = &hexstr("<img src=$dir$code.gif>", 1); }
		s/$code/$img/ig;
	}
	$_ = &hexstr($_, 0);
	$_;
}
#=======================================================================================
sub graph {
	my($type, $border, $maxsize, $width, @GRAPH) = @_;
	my(@TITLE, @DATA, %DATA);
	my($title, $data, $max, $sum, $count, $color, $code, $size, $intro, $i, $j, $option);
	($type, $option) = split(/:/, $type);
	if ($type == 2) { $intro = shift(@GRAPH); }
	my($colorspan) = 54321;
	if ($option) {
		foreach (@GRAPH) {
			($title, $data) = split(/=/, $_);
			$i = sprintf("%04d", $data);
			$_ = "$i=$title=$data";
		}
		@GRAPH = sort(@GRAPH);
		if ($option == 2) { @GRAPH = reverse(@GRAPH); }
	}
	$i = 0;
	foreach (@GRAPH) {
		if ($option) { ($dummy, $title, $data) = split(/=/, $_); }
		else { ($title, $data) = split(/=/, $_); }
		if ($title) {
			push(@TITLE, $title);
			$count++;
			if ($type == 2) {
				@DATA = split(/\,/, $data);
				$j = 0;
				foreach $line (@DATA) {
					$DATA{$i, $j} = $line;
					$DATA{$i} += $line;
					$j++;
				}
				$sum += $DATA{$i};
				$i++;
			} else {
				push(@DATA, $data + 0);
				$max < $data && ($max = $data);
				$sum += $data;
			}
		}
	}
	!$sum && return(0);
	if ($type == 2) {
		undef @DATA;
		my(@INTRO) = split(/\,/, $intro);
		my($end) = $j - 1;
		for ($j = 0; $j <= $end; $j++) {
			for ($i = 0; $i < $count; $i++) {
				if ($DATA[$j] < $DATA{$i, $j}) { $DATA[$j] = $DATA{$i, $j}; }
			}
		}
		print "<table border=$border cellspacing=0><tr><td>\n";
			print "<table border=0 cellpadding=0><tr><td bgcolor=#000000>\n";
				print "<table border=0 cellspacing=1 cellpadding=2>\n";
					foreach (@INTRO) {
						$color += $colorspan;
						$code = sprintf("%06X", $color);
						print "<tr><td width=16 bgcolor=#$code></td><td bgcolor=#FFFFFF><font size=2>$_</font></td></tr>\n";
					}
				print "</table>\n";
			print "</td></tr></table>\n";
			print "</td>\n";
			foreach $i (0 .. @TITLE -1) {
				print "<td align=center valign=bottom>\n";
				print "<table border=1 cellspacing=0 cellpadding=0 width=$width bordercolorlight=#EEEEEE bordercolordark=#333333>\n";
				$color = 0;
				foreach $j (0 .. $end) {
					$color += $colorspan;
					$size = int($DATA{$i, $j} / $DATA[$j] * $maxsize + 0.5);
					if ($size) {
						$code = sprintf("%06X", $color);
						print "<tr><td height=$size bgcolor=#$code align=center valign=top bordercolorlight=#$code bordercolordark=#EEEEEE>";
						$fontcolor = sprintf("%06X",hex("FFFFFF") - $color);
						print "<font size=2 color=#$fontcolor>$DATA{$i, $j}</font></td></tr>\n";
					}
				}
				print "</table></td>\n";
			}
			print "</tr><tr>\n";
			print "<td>　</td>\n";
			foreach (0 .. @TITLE -1) {
				print "<td align=center><font size=2>$TITLE[$_]<br>($DATA{$_})</font></td>\n";
			}
		print "</tr></table>\n";
		
	} elsif ($type == 1) {
		print "<table border=$border cellspacing=0><tr>\n";
			foreach (0 .. @TITLE -1) {
				$rate = int($DATA[$_] / $sum * 1000 + 0.5) / 10;
				$size = int($DATA[$_] / $max * $maxsize);
				$color += $colorspan;
				$code = sprintf("%06X", $color);
				print "<td align=center valign=bottom>\n";
				print "<table border=1 cellspacing=0 cellpadding=0 width=$width height=$size bordercolorlight=#EEEEEE bordercolordark=#333333><tr>\n";
				$fontcolor = sprintf("%06X",hex("FFFFFF") - $color);
				print "<td bgcolor=#$code align=center valign=top bordercolorlight=#$code bordercolordark=#$code><font size=2 color=#$fontcolor>$rate%</font></td>\n";
				print "</tr></table></td>\n";
			}
			print "</tr><tr>\n";
			foreach (0 .. @TITLE -1) {
				print "<td align=center><font size=2>$TITLE[$_]<br>(", &comma($DATA[$_]), ")</font></td>\n";
			}
		print "</tr></table>\n";
	} else {
		print "<table border=$border cellspacing=0>\n";
			foreach (0 .. @TITLE -1) {
				$rate = int($DATA[$_] / $sum * 1000 + 0.5) / 10;
				$size = int($DATA[$_] / $max * $maxsize);
				$color += $colorspan;
				$code = sprintf("%06X", $color);
				print "<tr>\n";
					print "<td align=center><font size=2>$TITLE[$_](", &comma($DATA[$_]), ")</font></td>\n";
					print "<td>";
					if ($DATA[$_]) {
						print "<table border=1 cellspacing=0 cellpadding=0 width=$size bordercolorlight=#$code bordercolordark=#333333><tr>\n";
						print "<td align=right bgcolor=$code bordercolorlight=#$code bordercolordark=#$code><font size=2 color=#000000>$rate%</font></td></tr></table>\n";
					}
					print "</td>\n";
				print "</tr>\n";
			}
		print "</table>\n";
	}
}
#=======================================================================================
sub error_view {
	my($err) = @_;
	my($cgiurl) = "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";
	&html_head('#FFFFFF','#000000','#0000FF','#FF0000','#00FF00','',4,4,'Error');
	print "<p><font size=5><b>Error</b></font></p>\n";
	print "$cgiurl<br>\n";
	print "$err\n";
	print "<hr>\n";
	print "</body></html>\n";
	exit;
}
#=======================================================================================
sub get_url {
	local($_, $flag, $encode) = @_;
	my(%HTML, $hostname, $addr, $path, $name);
	my($SOCK_STREAM) = ($] > 5 ? SOCK_STREAM : 1);
	my($protocol) = (getprotobyname('tcp'))[2];
	s/^(.*):\/\///;
	if (/^([\w\.\-]+)(\/*.*)$/) {
		$hostname = $1;
		$path = $2;
		if ($path !~ /\/$/ && $path !~ /\./) { $path .= '/'; }
	} else {
		$HTML{'Err'} = '404 URL Syntax Error'; return(%HTML);
	}
	$addr = (gethostbyname($hostname))[4];
	if (!$addr) {
		$HTML{'Err'} = "404 Not Server Name:$hostname";
		return(%HTML);
	}
	$name = pack("S n a4 x8", 2, 80, $addr);
	socket(SOCK, 2, $SOCK_STREAM, $protocol);
	if (connect(SOCK, $name)) {
		binmode(SOCK);
		select(SOCK); $| = 1; select(STDOUT);
		print SOCK "GET $path HTTP/1.0$CR$CR";
		while (<SOCK>) {
			if ($_) {
				if ($encode) { &jcode'convert(*_, $encode); }
				s/\r\n/\n/g;
				if (/^HTTP\/([\d\.]+)\s(\d+)\s(.+)$/) {
					if ($2 != 200) {
						$HTML{'Err'} = "$2 $3";
						last;
					}
				} elsif (/^([\w\-]+):\s(.*)$/) {
					$HTML{$1} = $2;
					$1 =~ /Content\-Type/i && $flag && last;
				} elsif (/<title>(.*)<\/title>/i) {
					$HTML{'Title'} = $1;
					if ($HTML{'Title'} =~ /\d+\s\w+$/) {
						$HTML{'Err'} = $HTML{'Title'};
						last;
					}
					$HTML{'Body'} .= $_;
				} else {
					$HTML{'Body'} .= $_;
				}
			}
		}
		close(SOCK);
	} else { $HTML{'Err'} = 'Server Conection Error'; }
	%HTML;
}
#=======================================================================================
sub whois {
	my($domain) = @_;
	my(@DOMAIN, $domainname);
	if ($domain =~ /\.jp$/i) {
		@DOMAIN = `whois -h whois.nic.ad.jp \"$domain\"`;
	} elsif ($domain =~ /\.info$/i) {
		@DOMAIN = `whois -h whois.afilias.net $domain`;
	} elsif ($domain =~ /\.biz$/i) {
		@DOMAIN = `whois -h whois.neulevel.biz $domain`;
	} elsif ($domain =~ /\.org$/i) {
		@DOMAIN = `whois -h whois.pir.org $domain`;
	} else {
		@DOMAIN = `whois $domain`;
	}
	if (!grep(/Domain\sName[:\]]/i, @DOMAIN) &&
		!grep(/Domain\sInformation:/i, @DOMAIN) ||
		grep(/No\smatch/i, @DOMAIN)) { $domain = ''; }
	$domain;
}
#=======================================================================================
sub change_url {
	my($string, $change, $url) = @_;
	my(@URL) = split(/$change=/i, $string);
	my($new);
	my($top) = shift(@URL);
	foreach (@URL) {
		if (!/^([\"\']|^)http:/ && !/([\"\']|^)htp:/) {
			s/^([\"\']|^)(.*)/$change=$1$url$2/;
		} else { $_ = "$change=$_"; }
		$new .= $_;
	}
	$top . $new;
}
#=======================================================================================
sub left {
	my($str, $len) = @_;
	$str = kaconv($str);
	if (length($str) > $len) {
		$str = substr($str, 0, $len);
		my($chr) = substr($str, $len - 1, 1);
		my($code) = unpack("C", $chr);
		if ($code > 127) { chop($str); }
	}
	$str;
}
#=======================================================================================
sub week {
	my($date) = @_;
	my($year, $month, $day) = split(/\//, $date);
	my(@DATE) = localtime(dateserial($date));
	my($start) = $day - $DATE[6];
	my(@WEEK, $i);
	my($days) = &calendar2($year, $month, 0, 0, 1);
	if ($start < 1) {
		$month--;
		if ($month < 1) {
			$month = 12;
			$year--;
		}
		$days = &calendar2($year, $month, 0, 0, 1);
		$start = $days + $start;
	}
	$i = $start;
	foreach (1 .. 7) {
		if ($i > $days) {
			$i = 1;
			$month++;
			if ($month > 12) {
				$month = 1;
				$year++;
			}
		}
		$date = sprintf("%04d/%02d/%02d", $year, $month, $i);
		push(@WEEK, $date);
		$i++;
	}
	@WEEK;
}
#=======================================================================================
sub os {
	#
	#	UNIX	: SunOS / Unix
	#	Linux	: Linux
	#	Windows	: Windows
	#
	my($os) = `uname -a`;
	if (!$os) { $os = `ver`; }
}
#=======================================================================================
sub rgb {
	my($color) = @_;
	$color =~ s/#//g;
	my(@RGB, $i, $j, $str);
	for ($i = 0; $i < 6; $i+=2) {
		$str = substr($color, $i, 2);
		$RGB[$j] = hex($str);
		$j++;
	}
	@RGB;
}
#=======================================================================================
sub ksubstr {
	my($str, $st, $en) = @_;
	my($klen) = 0;
	my($len) = length($str);
	my($cn, $string, $i);
	my($ksubstring) = '';
	for ($i = 0; $i < $len; $i++) {
		$string = substr($str, $i, 1);
		$cn = unpack("C", $string);
		if ($cn >= 129 && $cn <= 159 || $cn >= 224 && $cn <= 252) {
			$i++;
			$string .= substr($str, $i, 1);
		}
		if ($klen >= $st && $klen < $st + $en) { $ksubstring .= $string; }
		$klen++;
	}
	$ksubstring;
}
#=======================================================================================
sub klength {
	my($str) = @_;
	my($klen) = 0;
	my($len) = length($str);
	my($cn, $i);
	for ($i = 0; $i < $len; $i++) {
		$cn = unpack("C", substr($str, $i, 1));
		if ($cn >= 129 && $cn <= 159 || $cn >= 224 && $cn <= 252) { $i++; }
		$klen++;
	}
	$klen;
}
#=======================================================================================
sub kindex {
	my($str, $find) = @_;
	my($kindex) = -1;
	my($index) = index($str, $find);
	if ($index == 0) {
		$kindex = 0;
	} elsif ($index > 0) {
		my($cn, $i);
		for ($i = 0; $i <= $index; $i++) {
			$cn = unpack("C", substr($str, $i, 1));
			if ($cn >= 129 && $cn <= 159 || $cn >= 224 && $cn <= 252) { $i++; }
			$kindex++;
		}
	}
	$kindex;
}
#=======================================================================================
sub kreplace {
	my($str, $old, $new) = @_;
	my($kindex, $strlen, $findlen);
	my($leftstr, $rightstr);
	my($oldlen) = klength($old);
	my($newlen) = klength($new);
	if ($str ne '' && $old ne '' && $new ne '') {
		if(kindex($str, $old) >= 0) {
			$strlen = klength($str);
			$kindex = kindex($str, $old);
			$leftstr = ksubstr($str, 0, $kindex);
			$rightstr = ksubstr($str, $kindex + $oldlen, $strlen - $kindex - $oldlen);
			$rightstr = kreplace($rightstr, $old, $new);
			$str = "$leftstr$new$rightstr";
		}
	}
	$str;
}
#=======================================================================================
sub weekday {
	my($date, $timelag, $flag) = @_;
	my($serial) = dateserial($date, $timelag);
	my(@DATE) = localtime($serial);
	$DATE[5] += 1900;
	$DATE[4]++;
	if ($flag) {
		$DATE[6] = ('日','月','火','水','木','金','土') [$DATE[6]];
	}
	$DATE[6];
}
#=======================================================================================
sub deletedir {
	my($dir) = @_;
	my(@FILES);
	if (opendir(FIL, $dir)) {
		@FILES = readdir(FIL);
		close FIL;
		foreach $line (@FILES) {
			if ($line ne '.' && $line ne '..') {
				if (-d "$dir/$line") {
					deletedir("$dir/$line");
				} else {
					unlink("$dir/$line");
				}
			}
		}
		rmdir($dir);
	}
}
#=======================================================================================
sub dump16 {
	my($src, $des) = @_;
	open(IN, "$src");
		binmode IN;
		$a = <IN>;
		open(OUT, ">$des");
			binmode OUT;
			$i = 1;
			seek(IN, 0, 0);
			while (!eof(IN)) {
				$byt = read(IN, $dat, 32);
				print OUT "\'";
				for ($j=0; $j < $byt; $j++){
					print OUT unpack("H2", substr($dat, $j, 1));
				}
				print OUT "\'\n";
			}
		close OUT;
	close IN;
}
#=======================================================================================
@TRYROGO = (
	'474946383961c0000d00800000000000ffffff21f90405140001002c00000000',
	'c0000d000002ff8c8160cbed0f635012b144edc45a6e3e790b7589e6959c6a17',
	'aa2e09c14779c059239fb6eee4ee43f2fd68c3a227b79b0171c5a408698c38a3',
	'ca586a76adb614165b179bd1042bc4d07754e67a3bd01a7b5343bdd1a3b3bbf5',
	'e14a697365705c2576830718939624e3e5c7c721c618b7c5471758e858b74797',
	'58521829b91848368987a63939f8e9890a889835da99898289aac582c84408aa',
	'd593d6d396dba8fbfaba0ae2aa7bea0722645b36ca0cabdacc2b4aed0c7d9b3a',
	'7c2ded8a2c0c391b465d9a0b877b0e8e6e8d3d2deced5e8efc4e692a5f579ba5',
	'e64b2ba7adee36654ab07584f2ed0268aa5e9f5e7aee1564b142d60f210743f1',
	'a08231e3108a1e13251ea9e67149448d244b12e1d851e40a884738b20c693226',
	'95560e0a00003b'
);
#=======================================================================================
sub uupackage {
	my($src, $des) = @_;
	my($filename, $Variable, $encode);
	my(@FILELIST);
	!-e "$src" && return('Not Found');
	if (-e "$des") {
		if (open(IN, "$des")) {
			while (<IN>) {
				if ($_ =~ /^\[(.+)\]$/) {
					$filename = $1;
					push(@FILELIST, $filename);
					$Variable = $filename;
					$Variable =~ s/\./-comma-/g;
				} else {
					push(@$Variable, $_);
				}
			}
			close IN;
		}
	}
	if (!grep(/^$src$/, @FILELIST)) { push(@FILELIST, $src); }
	open(OUT, ">$des");
		binmode OUT;
		foreach $file (@FILELIST) {
			print OUT "[$file]\n";
			if ($file eq $QUERY{'src'}) {
				$encode = &changeuuencode($src);
				print OUT $encode_data;
			} else {
				$Variable = $file;
				$Variable =~ s/\./-comma-/g;
				foreach (@$Variable) { print OUT $_; }
			}
		}
	close OUT;
	0;
}
#=======================================================================================
sub unuupackage {
	my($src, $dir, $dirmod) = @_;
	my($filename, $openflag);
	!$dirmod && ($dirmod = '0777');
	if (!-d "$dir") { mkdir($dir, eval($dirmod)); }
	if (open(IN, "$src")) {
		while (<IN>) {
			if ($_ =~ /^\[(.+)\]$/) {
				$openflag && close OUT;
				$filename = "$dir/$1";
				open(OUT, ">$filename");
				binmode OUT;
				$openflag = 1;
			} else {
				print OUT unpack("u", $_);
			}
		}
		$openflag && close OUT;
		close IN;
	}
	0;
}
#=====================================End of perl-lib.pl================================
1;
