page top

package k2;

;# -----------------------------------------------------------------------------
;# K2/LIB::PERL LIBRARY++                                                      .
;#                                                                             .
;#       Subroutine Library                                                    .
;#                                                                             .
;#                             All Right Reserved, CopyRight (C) 2008 by Dr.K  .
;# -----------------------------------------------------------------------------


;#//////////////////////////////////////////////////////////////////////////////
;# Perl Package Module Import
;#//////////////////////////////////////////////////////////////////////////////
 #use strict;
 use Switch;
 use Time::Local;
 use Net::FTP;
 use Net::POP3;
 use Net::SMTP;
 use MIME::Base64;
 use Encode;
 use Encode qw(from_to encode);
 #require 'K2_UTY.pl';
 #require 'K2_FIL.pl';
;#//////////////////////////////////////////////////////////////////////////////


;#//////////////////////////////////////////////////////////////////////////////
;# Prototype
;#//////////////////////////////////////////////////////////////////////////////
;# メール関数 x 4
;# JstTime()
;# SMTP($ppsv, $smsv, $acnt, $pass, $auth)
;# SmtpMail($mime, $name, $from, $to, $cc, $bcc, $subj, $body, $fl)
;# SendMail($mime, $name, $from, $to, $cc, $bcc, $subj, $body, $fl)

;# Http,Ftp関数 x 3
;# HttpDownload($url, $pth)
;# FtpDownload($host, $user, $pass, $remote, $local)
;# FtpUpload($host, $user, $pass, $local, $remote)

;# その他関数 x 4
;# Password($sw)
;# Seiza($ymd, $sw)
;# KenMatch($add)
;# Loan($c04, $c06, $c08, $c10)

;# 正規表現 x 8
;# isTagInc($s)
;# isTagOnly($s)
;# isMail($s, $f)
;# isCellular($s, $f)
;# isURL($s)
;# isTel$s)
;# isDay$s)
;# DelParen($s)

;# Total = 20
;#//////////////////////////////////////////////////////////////////////////////


;#//////////////////////////////////////////////////////////////////////////////
;# メール関数
;# 現在のところ、携帯へはPlainTextで添付ファイル無しでしか送信できない！！
;#//////////////////////////////////////////////////////////////////////////////


# Variable for Preset
my ($SUB_POPSV, $SUB_SMTSV, $SUB_ACUNT, $SUB_PASSW, $SUB_AUTHT);

# JST
sub JstTime{
	$ENV{'TZ'} = "JST-9";
	my($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
	my @w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	my @m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	my $d = sprintf("%s, %02d %s %04d %02d:%02d:%02d",
				$w[$wday],$mday,$m[$mon],$year+1900,$hour,$min,$sec).' +0900';
	return ($d);
}

# SMTP(Preset)
# ($ppsv) = POP Server
# ($smsv) = SMTP Server
# ($acnt) = アカウント
# ($pass) = パスワード
# ($auth) = 0: SMTP-AUTH
#         = 1: POP-before-SMTP
# Authenticate(SMTP-AUTH, POP before-SMTP)
sub SMTP{
	my ($ppsv, $smsv, $acnt, $pass, $auth) = @_;

	$SUB_POPSV = $ppsv;
	$SUB_SMTSV = $smsv;
	$SUB_ACUNT = $acnt;
	$SUB_PASSW = $pass;
	$SUB_AUTHT = MinMax($auth, 0, 1);

	return(0)unless($SUB_POPSV);
	return(0)unless($SUB_SMTSV);
	return(0)unless($SUB_ACUNT);
	return(0)unless($SUB_PASSW);
	return(1);
}

# SMTP Mail
# Automatic MIME-TYPE
# ($name) = 表示名
# ($from) = 差出人
# ($to)   = あて先
# ($cc)   = CC
# ($bcc)  = BCC
# ($subj) = 件名
# ($body) = 本文
# ($fl)   = 添付ファイル(1件のみ)
sub SmtpMail{
	my ($name, $from, $to, $cc, $bcc, $subj, $body, $fl) = @_;

	return(0)unless($SUB_POPSV);
	return(0)unless($SUB_SMTSV);
	return(0)unless($SUB_ACUNT);
	return(0)unless($SUB_PASSW);

	# POP-before-SMTP
	if($SUB_AUTHT){
		my $pop = Net::POP3->new($SUB_POPSV, Timeout=>60);
			return(0)unless($pop);
			$pop->login($SUB_ACUNT, $SUB_PASSW);
			return(0)unless($pop);
		$pop->quit();
	}

	my $smtp = Net::SMTP->new($SUB_SMTSV, Timeout=>60);
	return(0)unless($smtp);
		my ($date, $mime, $attach);
		my @cc_ = CutOff(',', $cc);
		my @bc_ = CutOff(',', $bcc);
		my $bound = '-*-*-'.Password(1).'-*-*-';

		# SMTP-AUTH
		$smtp->auth($SUB_ACUNT, $SUB_PASSW)unless($SUB_AUTHT);
		return(0)unless($smtp);

		# MIME-TYPE
		if(isTagInc($body)){
			$mime = 'text/html; charset="ISO-2022-JP"';
		}else{
			$mime = 'text/plain; charset="ISO-2022-JP"';
		}

		# Attach File
		$fl = ''unless(-e $fl);
		if($fl){
			open(FP, "$fl");
				$attach = join('', <FP>);
			close(FP);
			$attach = MIME::Base64::encode($attach, '');
		}

		# Encode jis(7bit)
		Encode::from_to($subj, 'shiftjis', 'ISO-2022-JP');
		Encode::from_to($body, 'shiftjis', 'ISO-2022-JP');

		$smtp->mail($from);
		$smtp->to($to)if($to);
		$smtp->cc(@cc_)if($cc);
		$smtp->bcc(@bc_)if($bcc);
		$smtp->data();
			if($fl){
				$smtp->datasend("MIME-Version: 1.0\n");
				$smtp->datasend("Content-Transfer-Encoding:Base64\n");
				$smtp->datasend("Content-Type: Multipart/Mixed; boundary=$bound\n");
			}

			$date = JstTime();
			$name = "$name<$from>";

			$smtp->datasend("Date:$date\n");
			$smtp->datasend("From: $name\n");
			$smtp->datasend("To: $to\n")if($to);
			$smtp->datasend("Cc: @cc_\n")if($cc);
			$smtp->datasend("Bcc: @bc_\n")if($bcc);
			$smtp->datasend("Subject: $subj\n");

			$smtp->datasend("--$bound\n")if($fl);
			$smtp->datasend("Content-Transfer-Encoding: 7bit\n");
			$smtp->datasend("Content-Type: $mime\n\n");
			$smtp->datasend("$body\n");

			if($fl){
				$smtp->datasend("--$bound\n");
				$smtp->datasend("Content-Type: application/octet-stream; name=$fl\n");
				$smtp->datasend("Content-Disposition: attachment; filename=$fl\n\n");
				$smtp->datasend("Content-Transfer-Encoding: base64\n");
				$smtp->datasend("$attach\n\n");
				$smtp->datasend("--$bound");
				$smtp->datasend("--\n");
			}
		$smtp->dataend();
	$smtp->quit();

	return(1);
}

# UNIXのsendmailコマンド(MTA)
# Automatic MIME-TYPE
# ($name) = 表示名
# ($from) = 差出人
# ($to)   = あて先
# ($cc)   = CC
# ($bcc)  = BCC
# ($subj) = 件名
# ($body) = 本文
# ($fl)   = 添付ファイル(1件のみ)
sub SendMail{
	my ($name, $from, $to, $cc, $bcc, $subj, $body, $fl) = @_;
	my @TO  = split(/\,/, $to);
	my @CC  = split(/\,/, $cc);
	my @BCC = split(/\,/,$bcc);

	# Make Mailto
	my ($i, $mailto);
	foreach my $s (@TO, @CC, @BCC){
		if($s =~ /([#-9A-~\-\_]+\@[#-9A-~\-\_\.]+)/){
			unless($i){$mailto = "$1"}
			else      {$mailto .= "\,$1"}
		}
		$i++;
	}
	return(0)unless($mailto);

	my $ret = open(MH, "|/usr/sbin/sendmail -t $mailto");
	return(0)unless($ret);
		my ($date, $mime, $bound, $attach);

		$date = JstTime();
		$bound = '-*-*-'.Password(1).'-*-*-';

		# Encode jis(7bit)
		Encode::from_to($subj, 'shiftjis', 'ISO-2022-JP');
		Encode::from_to($body, 'shiftjis', 'ISO-2022-JP');

		# B-Encode
		if($name){
			$name = MIME::Base64::encode($name, '');
			$name = '=?ISO-2022-JP?B?'.$name.'?=';
			$from = "$name<$from>";
		}

		# MIME-TYPE
		if(isTagInc($body)){
			$mime = 'text/html; charset="ISO-2022-JP"';
		}else{
			$mime = 'text/plain; charset="ISO-2022-JP"';
		}

		# Attach File
		$fl = ''unless(-e $fl);
		if($fl){
			open(FP, "$fl");
				$attach = join('', <FP>);
			close(FP);
			$attach = MIME::Base64::encode($attach, '');
		}

		if($fl){
			print MH "MIME-Version: 1.0\n";
			print MH "Content-Transfer-Encoding:Base64\n";
			print MH "Content-Type: Multipart/Mixed; boundary=$bound\n";
		}

		print MH "Date: $date\n";
		print MH "To: $to\n"unless($bcc);
		print MH "From: $from\n";
		print MH "CC: $cc\n" if($cc);
		print MH "BCC: $cc\n" if($bcc);
		print MH "Subject: $subj\n";

		print MH "--$bound\n"if($fl);
		print MH "Content-Transfer-Encoding: 7bit\n";
		print MH "Content-type: $mime\n\n";
		print MH "$body\n";

		if($fl){
			print MH "--$bound\n";
			print MH "Content-Type: application/octet-stream; name=$fl\n";
			print MH "Content-Disposition: attachment; filename=$fl\n\n";
			print MH "Content-Transfer-Encoding: base64\n";
			print MH "$attach\n\n";
			print MH "--$bound";
			print MH "--\n";
		}
	close(MH);

	return(1);
}


;#//////////////////////////////////////////////////////////////////////////////
;# Http,Ftp関数
;#//////////////////////////////////////////////////////////////////////////////


# URLの分離
# $url = URL(フルアドレス)
# return(サーバー, ファイルパス);
sub url2HostPath{
	my ($url) = @_;
	$url =~ s/http\:\/\///g;
	my ($host, $path) = split(/\//, $url, 2);
	return($host,'/'.$path);
}

# ダウンロード
# $url = URL(フルアドレス)
# $pth = ローカルファイル(拡張子は無視される)
# バイナリは$toflを指定しファイルから利用する(サイズが大きいので)
sub HttpDownload{
	my ($url, $pth) = @_;

	my $port = getservbyname('http', 'tcp');
	my ($host, $file) = url2HostPath($url);

	if($pth){
		my $dir = ExtractFilePath($pth);
		my $nam = ExtractFileName($pth);
		my $ext = ExtractFileExt($url);
		$pth = $dir.$nam.'.'.$ext;
	}

	# ソケット生成
	my $SH = IO::Socket::INET->new(
					Timeout	=> 5,
					Proto => 'tcp',
					PeerAddr => $host,
					PeerPort => $port,
	            	);

	# 正常接続
	if($SH){
		# 返り値
		my @ret = ();

		# バッファクリア
		$SH->autoflush(1);

		# リクエスト
		print $SH "GET $file HTTP/1.0\n";
		print $SH "User-Agent: Mozilla/4.0 BOT script\n";
		print $SH "Host: $host\n";
		print $SH "Referer: http://$host/\n";
		print $SH "Pragma: no-cache\n";
		print $SH "Cache-Control: no-cache\n";
		print $SH "\n";

		# ヘッダ除去
		while(<$SH>){
			m/^\r\n$/ && last;
		}

		# ファイル
		if($pth){
			open(FH, ">$pth");
				binmode(FH);
				while(<$SH>){print FH "$_"}
			close(FH);
			@ret = (1);

		# 配列
		}else{
			@ret = <$SH>;
		}

		# ソケット破棄
		$SH->close();

		return(@ret);
	}else{
		return(0);
	}
}

# FTPアップロード
# $host  = FTPサーバー
# $user  = アカウント
# $pass  = パスワード
# $remote= 転送元パス(0326.biz/public_html/k2/file.txt)
# $local = 受信元ファイル(file.txt, ./dat/file.txt, /dat/)
#
# (例)                                   ↓フルパス                           ↓フルパス、相対パス、ディレクトリ
# FtpDownload('server', 'user', 'pass', '0326.biz/public_html/dat/xxx.csv', '.0326.biz/public_html/00/yyy.dat');
# FtpDownload('server', 'user', 'pass', '0326.biz/public_html/dat/xxx.csv', './00/yyy.dat');
# FtpDownload('server', 'user', 'pass', '0326.biz/public_html/dat/xxx.csv', './00/');
sub FtpDownload{
	my ($host, $user, $pass, $remote, $local) = @_;

	my $ret = '0';
	unless(ExtractFileName($local)){
		$local = $local.ExtractFileOnly($remote);
	}

	my $ftp = Net::FTP->new($host);
	if($ftp){
		$ftp->login($user, $pass);
		if($ftp){
			$ftp->binary();
			$ftp->get($remote, $local);
			if($ftp){
				$ftp->quit();
				$ret = 1;
			}
		}
	}

	return($ret);
}

# FTPアップロード
# $host  = FTPサーバー
# $user  = アカウント
# $pass  = パスワード
# $local = 転送元ファイル(file.txt, ./dat/file.txt)
# $remote= 転送先パス(0326.biz/public_html/k2/ or 0326.biz/public_html/k2/file.txt)
#
# (例)                                 ↓フルパス、相対パス                ↓フルパス、相対パス、ディレクトリ
# FtpUpload('server', 'user', 'pass', '0326.biz/public_html/img/xxx.png', '0326.biz/public_html/00/yyy.png');
# FtpUpload('server', 'user', 'pass', './img/xxx.png',                    './00/yyy.png');
# FtpUpload('server', 'user', 'pass', './img/xxx.png',                    './00/');
sub FtpUpload{
	my ($host, $user, $pass, $local, $remote) = @_;

	my $ret = '0';
	my $path = ExtractFilePath($remote);
	my $file = ExtractFileOnly($remote);
	unless($file){$file = ExtractFileOnly($local)}

	my $ftp = Net::FTP->new($host);
	if($ftp){
		$ftp->login($user, $pass);
		if($ftp){
			$ftp->binary();
			$remote = $path.$file;
			$ftp->put($local, $remote);
			if($ftp){
				$ftp->quit();
				$ret = 1;
			}
		}
	}

	return($ret);
}


;#//////////////////////////////////////////////////////////////////////////////
;# その他関数
;#//////////////////////////////////////////////////////////////////////////////


# パスワード発行(８桁)
# ($sw) でアルファベット４桁+数字４桁
sub Password{
	my($sw) = $_[0];

	srand(time|$$);
	my($i, @s, $ret);

	if($sw){
		for($i = 0; $i < 8; $i++){
			$ret .= (int(rand(9)) + 1);
		}
	}else{
		for($i = 0; $i <= 3; $i++){
			$s[$i] = int(rand(26)) + 97;
		}
		$ret = pack("c4",$s[0],$s[1],$s[2],$s[3]);
		srand;
		for($i = 0; $i <= 3; $i++){
			$ret .= (int(rand(9)) + 1);
		}
	}
	return($ret);
}

# 星座を得る
# $ymd = (yyyy/mm/dd, mm/dd)
# '$sw=1'->日本語、'$sw=2'->英語
sub Seiza{
	my ($ymd, $sw) = @_;

	$sw = ($sw < 1) ? 1 : $sw;
	$sw = ($sw > 2) ? 2 : $sw;

	if(length($ymd) <= 5){
		$ymd =~ s/[^\d]//g;
		$ymd = '0000'.$ymd;
	}

	$ymd = RightStr_('0000'.$ymd, 4);

	my @star = (
		[ 101,  119, '山羊座', 'Capricorn'  ],
		[ 120,  218, '水瓶座', 'Aquarius'   ],
		[ 219,  320, '魚座'  , 'Pisces'     ],
		[ 321,  419, '牡羊座', 'Aries'      ],
		[ 420,  520, '牡牛座', 'Taurus'     ],
		[ 521,  621, '双子座', 'Gemini'     ],
		[ 622,  722, '蟹座'  , 'Cancer'     ],
		[ 723,  821, '獅子座', 'Leo'        ],
		[ 822,  922, '乙女座', 'Virgo'      ],
		[ 923, 1023, '天秤座', 'Libra'      ],
		[1024, 1122, 'åｶ座'  , 'Scorpio'    ],
		[1123, 1221, '射手座', 'Sagittarius'],
		[1222, 1231, '山羊座', 'Capricorn'  ]
	);

	my $ret = '';
	for(my $i = 0; $i < @star; $i++){
		if( ($ymd >= $star[$i][0]) && ($ymd <= $star[$i][1]) ){
			$ret = $star[$i][$sw + 1];
			last;
		}
	}
	return($ret);
}

# 都道府県が含まれているか判断
# 返り値は都道府県番号
sub KenMatch{
	my ($add) = @_;
	$add = cnv2sjis($add);

	my @ken = (
		'北海道','青森県','岩手県','宮城県','秋田県','山形県','福島県',
		'茨城県','栃木県','群馬県','埼玉県','千葉県','東京都','神奈川','新潟県',
		'富山県','石川県','福井県','山梨県','長野県','岐阜県','静岡県','愛知県',
		'三重県','滋賀県','京都府','大阪府','兵庫県','奈良県','和歌山','鳥取県',
		'島根県','岡山県','広島県','山口県','徳島県','香川県','愛媛県','高知県',
		'福岡県','佐賀県','長崎県','熊本県','大分県','宮崎県','鹿児島','沖縄県'
	);

	my $ret = 0;
	for(my $i = 0; $i < @ken; $i++){
		if(index($add, $ken[$i]) >= 0){
			$ret = $i + 1;
			last;
		}
	}
	return($ret);
}

# ローンの計算
# $c04 = 実質年利
# $c06 = 借り入れ額
# $c08 = 支払い回数
# $c10 = ボーナス加算額(年2回)
# 戻り値 = @(初回支払額, 以降支払額, ボーナス支払額)
sub Loan{
	my ($c04, $c06, $c08, $c10) = @_;

	return(0)unless($c04);
	return(0)unless($c06);
	return(0)unless($c08);
	return(0)unless($c10);

	# 月利率
	my $c77 = $c04 / 1200;
	# 金利::複利
	my $c88 = (1 + $c77) ** $ c08;
	my $c13 = ($c77 * $c88 / ($c88 - 1) * $c08 - 1) * 10000;
	$c13 = int($c13) / 10000;

	# 分割::手数料
	my $f07 = int ($c06 * $c13);

	# 分割::総支払い額
	my $f08 = $c06 + $f07;

	# ２回目以降::支払い額
	my $c09 = int($c08 / 6);
	my $f10 = ($f08 - $c10 * $c09) / $c08;
	$f10 = int($f10 / 100);
	$f10 = $f10 * 100;

	# 初回::支払い額
	my $f11 = $c08 - 1;
	my $f09 = $f08 - $c10 * $c09 - $f10 * $f11;

	# 返り値はリスト
	return($f09, $f10, $c10);
}


;#//////////////////////////////////////////////////////////////////////////////
;# 正規表現
;#//////////////////////////////////////////////////////////////////////////////


# <TAG>を含む文字列か判定
sub isTagInc{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $tag_nrom = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}}
	my $tag_comm = '<!(?:--[^-]*-(?:[^-]+-)*?-(?:[^>-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)';
	my $tag_regx = qq{$tag_comm|<$tag_nrom};
	my $ret = ($s =~ /^$tag_regx/) ? 1 : 0;
	return($ret);
}

# <TAG>を含む文字列か判定
# 0:<TAG>なし, 1=<TAG>含む, 2=１つの<TAG>のみ
# 簡易型なので'<ヤッホー>' みたいなのは<TAG>として判断
sub isTagOnly{
	my ($s) = @_;
	my $ret = 0;
	if(isTagInc($s)){
		$ret = 1;
		$s = TrimS($s);
		unless(index($s, '<')){
			$ret = (index($s, '>') < length($s) - 1) ? 1 : 2;
		}
	}
	return($ret)
}

# メールアドレス判定
# メールチェックは完全には出来ない！
# MailerによりRFC2822準拠か否か異なる
sub isMail{
    my ($s) = @_;

	# RFC2822非準拠(DoCoMo, au)
	# "address.."@docomo.ne.jpで送信すればＯＫらしい！？
	my $ret =  ($s =~ /^[-_\.a-zA-Z0-9]+\@[-_\.a-zA-Z0-9]+$/) ? 1 : 0;
    return($ret);
}

# 携帯メールアドレス判定
# $s=アドレス
# $f=0: 寛容
# $f=1: 厳格
sub isCellular{
    my ($s, $f) = @_;

    # 共通
	# (@)連続は使用不可
    if($s ne '' && PosStr('@@', $s) == 0){
		my ($f0, $f1, $f2, $f3, $f4, $f5);
		my ($add, $dom) = CutOff('@', $s);

		# local-part
		$f1 = (PosStr(' ', $s) == 0) ? 1 : 0;
		$f2 = (PosStr('..', $add) == 0) ? 1 : 0;
		$f3 = (LeftStr($add, 1) ne '.') ? 1 : 0;
		$f4 = (RightStr($add, 1) ne '.') ? 1 : 0;
		$f5 = (isAlphabet(LeftStr($add, 1))) ? 1 : 0;

		# domain-part
		switch(lc($dom)){
			case 'ezweb.ne.jp'{
				# strictness for check
				$f2 = ($f) ? $f2 : 1;
				$f4 = ($f) ? $f4 : 1;
				# 1.スペースは使用不可
				# 2.(.) の連続使用不可!?
				# 3.(.) 最初は使用不可
				# 4.(.) 最後は使用不可!?
				$f0 = ($f1 && $f2 && $f3 && $f4) ? 1 : 0;
			}
			case 'docomo.ne.jp'{
				# strictness for check
				$f2 = ($f) ? $f2 : 1;
				$f4 = ($f) ? $f4 : 1;
				# 1.スペースは使用不可
				# 2.(.) の連続使用不可 !?
				# 4.(.) 最後は使用不可 !?
				# 5.先頭文字は英文字のみ
				$f0 = ($f1 && $f2 && $f4 && $f5) ? 1 : 0;
			}
			case 'softbank.ne.jp'{
				# 1.スペースは使用不可
				# 2.(.) の連続使用不可
				# 4.(.) 最後は使用不可
				# 5.先頭文字は英文字のみ
				$f0 = ($f1 && $f2 && $f4 && $f5) ? 1 : 0;
			}
		}
		# 簡易アドレスチェック
		my $ret = ($f0) ? ($s =~ /^[a-z0-9\_\-\.]+@[^.]+\..+/i) : 0;
		return($ret);
	}else{
		return(0);
	}
}

# ＵＲＬ判定
sub isURL{
	my ($s) = @_;
	#my $ret =  ($s =~ /^http\:\/\/[\w\.\~\-\/]+$/) ? 1 : 0;
	my $ret =  ($s =~ /s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+/g) ? 1 : 0;
	return($ret);
}

# 電話番号判定
sub isTel{
	my ($s) = @_;
	my $ret = ($s =~ /[0-9]{3}[- ]?[0-9]{4}$/) ? 1 : 0;
	return($ret);
}

# 日付判定
sub isDay{
	my ($s) = @_;
	#my $ret = ($s =~ /^[2-3][0-9][0-9][0-9]\/[0-1][0-9]\/[0-3][0-9]$/) ? 1: 0;
	my $ret = ($s =~ /^2[0-9][0-9][0-9]\/(0[1-9]|1[12])\/(3[01]|[12][0-9]|0[1-9])$/) ? 1 : 0;
	#my $ret = ($s =~ /(19[0-9][0-9]|200[0-99])\/(_?[1-9]|1「0ー9」)\/(_|[1-3])?[0-9]/) ? 1 : 0;
	return($ret);
}

# 括弧を取り除く
sub DelParen{
	my ($s) = @_;
	$s = cnv2sjis($s);
	# []{}()<>
	$s =~ s/\[.+?\]|\{.+?\}|\(.+?\)|\<.+?\>//g;
	# ［］｛｝（）＜＞【】〔〕「」『』
	$s =~ s/［.+?］|｛.+?｝|（.+?）|＜.+?＞|【.+?】|《.+?》|≪.+?≫|〔.+?〕|「.+?」|『.+?』//g;

	#$s =~ s/\[[^\]]+\]|\{[^\}]+\}|\([^\)]+\)|\<[^\>]+\>//g;
	#$s =~ s/［[^］]+］|｛[^｝]+｝|（[^）]+）|＜[^＞]+＞|【[^】]+】|〔[^〕]+〕|「[^」]+」|『[^』]+』//g;
	return($s);
}

## K2/LIBPERL LIBRARY++ ------------------------------------------------------
1;                                                      ## Presented by Dr.k2 ##
## EOF -------------------------------------------------------------------------