#!/usr/bin/perl # スレッド天国 ver.1.10, (C)Copyright 2001 OGATA TETSUJI $masterkey = 'demPaYunYun'; # ↑管理用パスワード(半角英数)を''の間に書いてください。 $thisfile = ''; # ↑掲示板が動かないときは''の間にhttp://から始まるURLを入力してください。 # 例 $thisfile = 'http://specters.net/cgipon/tengoku.cgi'; # 掲示板のカスタマイズはブラウザ上からできますので、 # これ以降は書き換える必要はありません。 # まずはそのまま設置して動作確認を取るようにしてください。 # [ Note ] # 著作権情報です。書き換えないでください。 $scriptname = 'スレッド天国'; # 書き換え不可 $version = 'ver.1.10'; # 書き換え不可 $copyright = '緒方哲治'; # 書き換え不可 #========================================================================== # [ 環境設定 ] #========================================================================== $jcode = './jcode.pl'; $countia = './countia.pl'; $fn = $ENV{SCRIPT_NAME}; $fn =~ s/^.*\///; $fn =~ s/\..*$//; $logfile = "./logs/$fn.log"; $datfile = "./logs/$fn.dat"; $cookiename = $fn; $infourl = 'http://specters.net/cgipon/tengoku/info/'; $how2url = 'http://specters.net/cgipon/tengoku/how2/'; #========================================================================== # [ 更新チェック用 ] #========================================================================== if ($ENV{REQUEST_METHOD} eq 'HEAD'){ my($ftime) = gmtime((stat $logfile)[9]); my(@tm) = split(/ +/, $ftime); my($lm) = "$tm[0], $tm[2] $tm[1] $tm[4] $tm[3] GMT"; my($size) = -s $logfile; print "Content-type: text/html\r\n"; print "Last-Modified: $lm\r\n"; print "Accept-Ranges: bytes\r\n"; print "Content-Length: $size\r\n\r\n"; exit; } #========================================================================== # [ 開始 ] #========================================================================== &CHECK_CODE; &READ_FORM; &READ_OPTION; &CHECK_URL; &CHECK_BROWSER; &CHECK_DATA; &COUNTIA; &WRITE_DATA; &READ_DATA; if ($mobile eq 'h') { $back = $in{back_h}; $hmsg = $in{hmsg_h}; foreach ($back,$thisfile,$infourl) { s/^http://; } if ($in{m} eq 'e') { &ONC_EXPAND; } elsif ($in{m} eq 's') { &ONC_SINGLE; } else { &ONC_LIST; } &ONC_PRINT; } elsif ($mobile eq 'e') { $reload = qq(t=) . substr(time(),-4); $back = $in{back_e}; $hmsg = $in{hmsg_e}; print qq(Content-type: text/x-hdml;charset=Shift_JIS\n\n); if ($in{m} eq 'e') { &HDML_EXPAND; } elsif ($in{m} eq 's') { &HDML_SINGLE; } elsif ($in{m} eq 'f') { &HDML_FORM; } else { &HDML_LIST; } } elsif ($mobile) { $back = $in{"back_$mobile"}; $hmsg = $in{"hmsg_$mobile"}; if ($in{m} eq 'e') { &CHTML_EXPAND; } elsif ($in{m} eq 's') { &CHTML_SINGLE; } elsif ($in{m} eq 'f') { &CHTML_FORM; } else { &CHTML_LIST; } &CHTML_PRINT; } else { &HTML_HEADER; &HTML_SET; if ($in{m} eq 'l') { &HTML_LIST; &HTML_FORM; } elsif ($in{m} eq 't') { &HTML_THREAD; &HTML_FORM; } elsif ($in{m} eq 'e') { &HTML_EXPAND; &HTML_FORM; } elsif ($in{m} eq 's') { &HTML_SINGLE; &HTML_FORM; } elsif ($in{m} eq 'h') { &HTML_HOW2; } elsif ($in{m} eq 'p') { &HTML_PASS; } &HTML_FOOTER; } exit; #========================================================================== # [ ONC表示 ] #========================================================================== # [ ONC内容表示 ] sub ONC_EXPAND { my($key); foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); &EXPAND_TITLE; foreach ($ttt,$nam) { s/</</g; s/&/&/g; } $sel .= qq($br); $ttt = qq(\[$tnm\]$ttt); $body .= qq($threadicon$ttt(全$#mes件)$br); $body .= qq($key[5]⇒このスレッドに返信$br); chomp $mes[1]; my($mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next) = @{&EXPAND_DATA_4M("$tnm>1>$mes[1]")}; if (($mes eq '&a;') || ($mes eq '&u;')) { next; } foreach ($mtt,$nam,$mes) { s/</</g; s/&/&/g; &REMOVE_EMOJI($_); } $body .= qq($hrbr$new$mnm$mtt$nam($tim)$br$mes$br); if ($next) { $sel .= qq($br); $body .= qq(41⇒全て読む$br); } $max = $#mes - $vne * $in{pne}; if ($max - $vne > 1) { $pne = $in{pne} + 1; $sel .= qq($br); $body .= qq($hrbr$key[4]⇒[) . ($max - $vne) . qq(]より前の記事$br); } for ($i = 2; $i <= $max; $i++) { if ($i <= $max - $vne) { next; } chomp $mes[$i]; $key = $i + 40; my($mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next) = @{&EXPAND_DATA_4M("$tnm>$i>$mes[$i]")}; if (($mes eq '&a;') || ($mes eq '&u;')) { next; } foreach ($mtt,$nam,$mes) { s/</</g; s/&/&/g; &REMOVE_EMOJI($_); } $body .= qq($hrbr$new$mnm$mtt$nam($tim)$br$mes$br); if ($next) { $sel .= qq($br); $body .= qq($key⇒全て読む$br); } } if ($#mes > $max) { $pne = $in{pne} - 1; $sel .= qq($br); $body .= qq($hrbr$key[6]⇒[) . ($max + 1) . qq(]より後の記事$br); } $body .= qq($key[5]⇒このスレッドに返信$br); $sel .= qq($br); $body .= qq($hrbr$key[2]⇒戻る$br); } } #-------------------------------------------------------------------------- # [ ONC単一表示 ] sub ONC_SINGLE { foreach (@log) { my($mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next) = @{&EXPAND_DATA_4M("$_")}; if (($mes eq '&a;') || ($mes eq '&u;')) { next; } foreach ($mtt,$nam,$mes) { s/</</g; s/&/&/g; &REMOVE_EMOJI($_); } if ($prev--) { $sel .= qq($br); $body .= qq($key[4]⇒続き$br); } $body .= qq($new$mnm$mtt$nam($tim)$br$mes$br); if ($next) { $sel .= qq($br); $body .= qq($key[6]⇒続き$br); } } $sel .= qq($br); $body .= qq($hrbr$key[2]⇒戻る$br); } #-------------------------------------------------------------------------- # [ ONCリスト表示 ] sub ONC_LIST { my($key) = 40; $body .= qq($in{bbstit}$br); if ($hmsg) { $body .= qq($hmsg$br); } $sel .= qq($br); $body .= qq($hrbr$key[5]⇒新規テーマ投稿$br); if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); $sel .= qq($br); $body .= qq($key[4]⇒次の$in{vnm}件$br); } $body .= qq($hrbr); foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); $key++; &EXPAND_TITLE; foreach ($ttt,$nam,$lst) { s/</</g; s/&/&/g; } $sel .= qq($br); $ttt = qq(\[$tnm\]$ttt); if ($#mes == 1) { $body .= qq($key⇒$new$threadicon$ttt($#mes件)$nam $tim$br); } else { $body .= qq($key⇒$new$threadicon$ttt($#mes件)$lst $tim$arrowicon$nam$br); } } $body .= qq($hrbr); if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); $sel .= qq($br); $body .= qq($key[6]⇒前の$in{vnm}件); if ($back) { $body .= qq($br); } } if ($back) { $sel .= qq($br); $body .= qq($key[2]⇒トップページ$br); } if ($back || ($in{pnm} < $pmx)) { $body .= qq($hrbr); } $sel .= qq($br); $body .= qq($key[9]⇒cgipon info$br); } #-------------------------------------------------------------------------- # [ ONC出力 ] sub ONC_PRINT { if (!$in{req}) { $sel .= qq($br); $body .= qq($hrbr) . qq(20⇒終了$br); } print qq(Content-Type: text/plain\n\n); print qq($ctrl); print qq(From: $thisfile\n); print qq(Subject: $in{bbstit}\n); print qq($inmd); print qq(Content-Type: Text/X-PmailDX\n\n); print qq($sel); if ($pdx{GI} >= 2) { print qq(\n); &jcode::z2h_sjis(\$body); } print "$form$body"; exit; } #========================================================================== # [ HDML表示 ] #========================================================================== #-------------------------------------------------------------------------- # [ HDML内容表示 ] sub HDML_EXPAND { $in{bbstit} =~ s/\$/&dol;/g; $in{bbstit} =~ s/"/"/g; print qq(); print qq(
$in{bbstit}$br); &EXPAND_4M; &jcode::z2h_sjis(\$body); print $body; print qq(); } #-------------------------------------------------------------------------- # [ HDML単一表示 ] sub HDML_SINGLE { print qq(); print qq(
$in{bbstit}$br); &SINGLE_4M; &jcode::z2h_sjis(\$body); print $body; print qq(); } #-------------------------------------------------------------------------- # [ HDMLフォーム ] sub HDML_FORM { if ($in{sct}) { $thisfile .= qq(?$reload&sch=%5B$in{sct}%5D); } else { $thisfile .= qq(?$reload); } jcode::euc2sjis(\$frm{nam}); my($nam) = &URL_ENC($frm{nam}); my($mal) = &URL_ENC($frm{mal}); $mal ||= qq(\@ezweb.ne.jp); print qq(); print qq(); print qq(); print qq(); print qq(); print qq(名前:\$nam); if ($in{ktimal}) { print qq(ﾒｰﾙ :\$mal); } print qq(ﾀｲﾄﾙ:\$tit); print qq(内容:\$mes); print qq(送信); print qq(戻る); print qq(); print qq(名前); if ($in{ktimal}) { print qq(); print qq(ﾒｰﾙ); } print qq(); print qq(ﾀｲﾄﾙ); print qq(); print qq(内容); print qq(); } #-------------------------------------------------------------------------- # [ HDMLリスト ] sub HDML_LIST { $in{bbstit} =~ s/\$/&dol;/g; print qq(); print qq(); print qq(
$in{bbstit}); if ($hmsg) { print qq($hmsg); } else { print qq($br); } print qq($hr新規ﾃｰﾏ投稿); if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print qq(次の$in{vnm}件); } foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); &EXPAND_TITLE; foreach ($ttt,$nam,$lst) { s/\$/&dol;/g; s/"/"/g; } print qq(); $ttt = qq(\[$tnm\]$ttt); if ($#mes == 1) { $body = qq($new$threadicon$ttt($#mes件)$nam $tim); } else { $body = qq($new$threadicon$ttt($#mes件)$lst $tim$arrowicon$nam); } &jcode::z2h_sjis(\$body); print $body; } if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print qq(前の$in{vnm}件); } if ($back) { print qq(ﾄｯﾌﾟﾍﾟｰｼﾞ); } print qq(cgipon info); print qq(); } #========================================================================== # [ CHTML表示 ] #========================================================================== #-------------------------------------------------------------------------- # [ CHTML内容表示 ] sub CHTML_EXPAND { &EXPAND_4M; } #-------------------------------------------------------------------------- # [ CHTML単一表示 ] sub CHTML_SINGLE { &SINGLE_4M; } #-------------------------------------------------------------------------- # [ CHTMLフォーム ] sub CHTML_FORM { $body .= qq($hrbr
); if ($in{sct}) { $body .= qq(); } $body .= qq(名前$br$br); if ($in{ktimal}) { $body .= qq(ﾒｰﾙ$br$br); } $body .= qq(ﾀｲﾄﾙ$br$br); $body .= qq(内容$br$br); $body .= qq($br); $body .= qq(
); if ($in{sct}) { $thisfile .= qq(?sch=%5B$in{sct}%5D); } $body .= qq($hrbr$key[2]戻る); } #-------------------------------------------------------------------------- # [ CHTMLリスト ] sub CHTML_LIST { if ($hmsg) { $body .= qq($hmsg); } $body .= qq($hr$key[5]); $body .= qq(新規ﾃｰﾏ投稿); if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); $body .= qq($br$key[6]); $body .= qq(次の$in{vnm}件); } $body .= qq($hr); foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); &EXPAND_TITLE; foreach ($ttt,$nam,$lst) { s/"/"/g; } $body .= qq(); $ttt = qq(\[$tnm\]$ttt); if ($#mes == 1) { $body .= qq($new$threadicon$ttt($#mes件)$nam $tim$br); } else { $body .= qq($new$threadicon$ttt($#mes件)$lst $tim$arrowicon$nam$br); } } $body .= qq($hr); if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); $body .= qq($key[4]); $body .= qq(前の$in{vnm}件); if ($back) { $body .= qq($br); } } if ($back) { $body .= qq($key[2]ﾄｯﾌﾟﾍﾟｰｼﾞ); } if ($back || ($in{pnm} < $pmx)) { $body .= qq($hr); } $body .= qq($key[9]cgipon info); } #-------------------------------------------------------------------------- # [ CHTML出力 ] sub CHTML_PRINT { &jcode::z2h_sjis(\$body); $print = qq(); $print .= $title; $print .= qq(); $print .= qq(); $print .= qq(
$in{bbstit}
); $print .= $body; $print .= qq(); $length = length($print); print qq(Content-type: text/html\n); print qq(Content-length: $length\n\n); print qq($print); exit; } #========================================================================== # [ ケータイ用展開ルーチン ] #========================================================================== #-------------------------------------------------------------------------- # [ 内容表示 ] sub EXPAND_4M { foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); &EXPAND_TITLE; foreach ($ttt,$nam) { if ($mobile eq 'e') { s/\$/&dol;/g; } s/"/"/g; } $ttt = qq(\[$tnm\]$ttt); $body .= qq($threadicon$ttt(全$#mes件)$br); $body .= qq($key[5]); $body .= qq(このｽﾚｯﾄﾞに返信$br); chomp $mes[1]; if ($mobile eq 'e') { $mes[1] =~ s/\$/&dol;/g; } $mes[1] =~ s/"/"/g; &REMOVE_EMOJI($mes[1]); my($mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next) = @{&EXPAND_DATA_4M("$tnm>1>$mes[1]")}; if (($mes eq '&a;') || ($mes eq '&u;')) { next; } $body .= qq($hrbr$new$mnm$mtt$nam($tim)
$mes$br); if ($next) { $body .= qq(); $body .= qq(全て読む$br); } $max = $#mes - $vne * $in{pne}; if ($max - $vne > 1) { $pne = $in{pne} + 1; $body .= qq($hrbr$key[4]); $body .= qq(); $body .= qq([$tnm-) . ($max - $vne) . qq(]より前の記事$br); } for ($i = 2; $i <= $max; $i++) { if ($i <= $max - $vne) { next; } chomp $mes[$i]; if ($mobile eq 'e') { $mes[$i] =~ s/\$/&dol;/g; } $mes[$i] =~ s/"/"/g; &REMOVE_EMOJI($mes[$i]); my($mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next) = @{&EXPAND_DATA_4M("$tnm>$i>$mes[$i]")}; if (($mes eq '&a;') || ($mes eq '&u;')) { next; } $body .= qq($hrbr$new$mnm$mtt$nam($tim)
$mes$br); if ($next) { $body .= qq(); $body .= qq(全て読む$br); } } if ($#mes > $max) { $pne = $in{pne} - 1; $body .= qq($hrbr$key[6]); $body .= qq(); $body .= qq([$tnm-) . ($max + 1) . qq(]より後の記事$br); } $body .= qq($hrbr$key[5]); $body .= qq(このｽﾚｯﾄﾞに返信$br); $body .= qq($key[2]戻る$br); } } #-------------------------------------------------------------------------- # [ 単一表示 ] sub SINGLE_4M { foreach (@log) { if ($mobile eq 'e') { s/\$/&dol;/g; } s/"/"/g; &REMOVE_EMOJI($_); my($mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next) = @{&EXPAND_DATA_4M("$_")}; if (($mes eq '&a;') || ($mes eq '&u;')) { next; } $body .= qq($hrbr); if ($prev--) { $body .= qq($key[4]続き$br); } $body .= qq($new$mnm$mtt$nam($tim)
$mes$br); if ($next) { $body .= qq($key[6]続き$br); } } $body .= qq($hrbr$key[2]戻る); } #-------------------------------------------------------------------------- # [ ログの展開 ] sub EXPAND_DATA_4M { my($tnm,$num,$nam,$mal,$url,$ico,$col,$mtt,$mes,$key,$tim,$ipa,$rmh) = split(/>/,$_[0]); my($mnm,$prev,$next); $mnm = qq([$tnm-$num]); &jcode::euc2sjis(\$mtt); if ($mtt) { $mtt .= qq(/); } &jcode::euc2sjis(\$nam); if ($mal && ($in{ktomal} >= 3)) { if ($mobile eq 'h') { $nam = qq($nam($mal)); } else { $nam = qq($nam); } } if ($tim > time() - 60 * 60 * $in{newtim}) { $new = $newicon; } else { $new = ''; } $tim = &GET_DATE($in{datefm},$tim); my(@dvm) = @{&DIV_STRING($mes,$dvm{$in{m}})}; $mes = $dvm[$in{dvn}]; $mes =~ s/&br;/$br/g; $mes = &AUTO_LINK_4M($mes); &jcode::euc2sjis(\$mes); if ($in{dvn} >= 1) { $prev = $in{dvn}; } if ($dvm[$in{dvn} + 1]) { $next = $in{dvn} + 1; } return [$mnm,$nam,$mtt,$mes,$tim,$new,$prev,$next]; } #========================================================================== # [ HTML表示処理 ] #========================================================================== #-------------------------------------------------------------------------- # [ HTMLヘッダ ] sub HTML_HEADER { my($styleback,$bodyback,$title,$hmsg_p,$msg); if ($in{imgbak}) { $styleback = qq( url($in{imgfld}/$in{imgbak}) fixed); $bodyback = qq( background="$in{imgfld}/$in{imgbak}"); } if ($in{imgtit}) { $title = qq($in{bbstit}

); } else { $title = qq(

$in{bbstit}

); } if ($in{hmsg_p}) { $hmsg_p = $in{hmsg_p}; $hmsg_p =~s/<>/
/g; $hmsg_p =~s/<//g; $hmsg_p =~s/&/&/g; $hmsg_p = qq($hmsg_p
); } if (@msg) { $msg = qq().join("
",@msg).qq(); } if ($in{m} eq 'p') { $in{chrset} = "Shift_JIS"; } print<<"_EOM_"; Content-type: text/html $in{bbstit}

$title $hmsg_p $msg

_EOM_ } #-------------------------------------------------------------------------- # [ HTMLページ設定 ] sub HTML_SET { my($lnk,$vfm); $frm{sch} =~ s/"/"/g; &jcode::euc2sjis(\$frm{sch}); $vnm{l} = [10,15,20,25,30,50,100]; $vnm{t} = [5,10,15,20,25,30,50,100]; $vnm{e} = [1,3,5,10,15,20,25,30]; $vnm{s} = [1,3,5,10,15,20,25,30]; if ($in{back_p}) { $lnk .= qq([トップページ]\n); } if ($in{edt} || $in{scn} || @scw) { $lnk .= qq([新規投稿]\n); } elsif ($in{sct}) { $lnk .= qq([返信]\n); } else { $lnk .= qq([新規投稿]\n); } if ($in{m} eq 'l') { $lnk .= qq([タイトルリスト]\n); } else { $lnk .= qq([タイトルリスト]\n); } if ($in{m} eq 't') { $lnk .= qq([スレッド一覧]\n); } else { $lnk .= qq([スレッド一覧]\n); } if (($in{m} eq 'e') && (!$frm{sch})) { $lnk .= qq([内容表\示]\n); } else { $lnk .= qq([内容表\示]\n); } if ($in{m} eq 'h') { $lnk .= qq([使い方]\n); } else { $lnk .= qq([使い方]\n); } print<<"_EOM_"; $lnk _EOM_ if ($in{m} =~ /[ltes]/) { print<<"_EOM_";
件ずつ ページ目 and or 検索
_EOM_ } print qq(
\n); } #-------------------------------------------------------------------------- # [ HTMLリスト ] sub HTML_LIST { my($siztxt,$coltab,$tabbdr); if ($in{siztxt}) { $siztxt = qq( size=2); } if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print<<"_EOM_";
[次の$in{vnm}件>
_EOM_ } print qq(\n); print<<"_EOM_"; _EOM_ foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); &EXPAND_TITLE; print<<"_EOM_"; _EOM_ } print qq(
タイトル 投稿者 投稿件数 最新投稿
[$tnm] $ttt $nam $#mes件 $lst $tim $new
\n
); if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print<<"_EOM_";
<前の$in{vnm}件]
_EOM_ } print qq(
\n
\n); } #-------------------------------------------------------------------------- # [ HTMLスレッド ] sub HTML_THREAD { my($siztxt,$coltab,$tabbdr); if ($in{siztxt}) { $siztxt = qq( size=2); } if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print<<"_EOM_";
[次の$in{vnm}件>
_EOM_ } foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); &EXPAND_TITLE; print<<"_EOM_";

[$tnm] $ttt $nam - 最新投稿 $lst $tim $new

_EOM_ for ($i = 1; $i <= $#mes; $i++) { chomp $mes[$i]; &REMOVE_EMOJI($mes[$i]); my($nam,$mal,$url,$ico,$col,$mtt,$mes,$key,$tim,$ipa,$rmh) = split(/>/,$mes[$i]); my($new); if (!$mtt or $mtt =~ /^Re:/) { $mtt = (split(/>/,$mes[$i]))[6]; $mtt =~ s/&br;/ /g; $mtt =~ s/ +/ /g; $mtt = ${&DIV_STRING($mtt,32,1)}[0]; } &jcode::euc2sjis(\$mtt); if (($mes eq '&a;') || ($mes eq '&u;')) { next; } &jcode::euc2sjis(\$nam); if ($tim > time() - 60 * 60 * $in{newtim}) { $new = $newicon; } $tim = &GET_DATE($in{datefm},$tim); print<<"_EOM_"; 　[$tnm-$i] $mtt $nam $tim $new
_EOM_ } print qq( \n \n\n
\n); } if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print<<"_EOM_";
<前の$in{vnm}件]
_EOM_ } print qq(
\n
\n); } #-------------------------------------------------------------------------- # [ HTML内容表示 ] sub HTML_EXPAND { my($siztxt,$coltab,$tabbdr); if ($in{siztxt}) { $siztxt = qq( size=2); } if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print<<"_EOM_";
[次の$in{vnm}件>
_EOM_ } foreach (@log) { local(@mes) = split(/<>/,$_); local($tnm) = $mes[0]; local($ttt,$nam,$lst,$tim,$new); my($num,$hrl); &EXPAND_TITLE; if ((!$in{sct}) && ($in{vnm} != 1)) { $lnk = qq(); $num = qq() . qq([$tnm]); } else { $in{sct} = $tnm; $num = qq([$tnm]); } print<<"_EOM_";

$num $ttt $nam - 最新投稿 $lst $tim $new

_EOM_ for ($i = 1; $i <= $#mes; $i++) { chomp $mes[$i]; &REMOVE_EMOJI($mes[$i]); my($mnm,$nam,$mal,$url,$ico,$col,$mtt,$mes,$tim,$new,$ipa) = @{&EXPAND_DATA("$tnm>$i>$mes[$i]")}; if (((split(/>/,$mes[$i]))[6] eq '&a;') || ((split(/>/,$mes[$i]))[6] eq '&u;')) { next; } print<<"_EOM_"; $hrl

$ipa $mnm $mtt $nam $tim $ico $new $url

$mes

_EOM_ $hrl = qq(
); } print<<"_EOM_"; $lnk
_EOM_ } if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm); print<<"_EOM_";
<前の$in{vnm}件]
_EOM_ } print qq(
\n
\n); } #-------------------------------------------------------------------------- # [ HTML単一表示 ] sub HTML_SINGLE { my($siztxt,$coltab,$tabbdr); if ($in{siztxt}) { $siztxt = qq( size=2); } if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } if ($in{pnm} != 1) { my($pnm) = $in{pnm} - 1; $query = qq(m=$in{m}&vns=$in{vnm}&pnm=$pnm); if (@scw) { $query .= qq(&sch=$frm{sch}&aor=$in{aor}); } print<<"_EOM_";
[次の$in{vnm}件>
_EOM_ } foreach (@log) { chomp; &REMOVE_EMOJI($_); my($mnm,$nam,$mal,$url,$ico,$col,$mtt,$mes,$tim,$new,$ipa,$edt) = @{&EXPAND_DATA($_)}; my($tnm,$num) = (split(/>/,$_))[0,1]; my($lnk); if ((split(/>/,$_))[8] eq '&a;') { $ico = ''; $mes = qq() . qq(管理人により削除されました。); } elsif ((split(/>/,$_))[8] eq '&u;') { $ico = ''; $mes = qq() . qq(投稿者により削除されました。); } $lnk = qq(); print<<"_EOM_";
$ipa $mnm $mtt $nam $tim $new $url $edt

$ico

$mes$lnk


_EOM_ } if ($in{pnm} < $pmx) { my($pnm) = $in{pnm} + 1; $query = qq(m=$in{m}&vns=$in{vnm}&pnm=$pnm); if (@scw) { $query .= qq(&sch=$frm{sch}&aor=$in{aor}); } print<<"_EOM_";
<前の$in{vnm}件]
_EOM_ } print qq(
\n
\n); } #-------------------------------------------------------------------------- # [ スレッドタイトルの展開 ] sub EXPAND_TITLE { chomp $mes[1]; $ttt = (split(/>/,$mes[1]))[5]; if (!$ttt) { $ttt = (split(/>/,$mes[1]))[6]; $ttt =~ s/&br;/ /g; $ttt =~ s/(｡｡)+/｡｡/g; $ttt =~ s/ +/ /g; $ttt = ${&DIV_STRING($ttt,24,1)}[0]; } &jcode::euc2sjis(\$ttt); if ($ttt eq '&a;') { $ttt = '管理人により削除されました。'; } elsif ($ttt eq '&u;') { $ttt = '投稿者により削除されました。'; } $nam = (split(/>/,$mes[1]))[0]; &jcode::euc2sjis(\$nam); $lst = (split(/>/,$mes[-1]))[0]; &jcode::euc2sjis(\$lst); $tim = (split(/>/,$mes[-1]))[8]; if ($tim > time() - 60 * 60 * $in{newtim}) { $new = $newicon; } $tim = &GET_DATE($in{datefm},$tim); foreach ($ttt,$nam,$lst) { &REMOVE_EMOJI($_); } } #-------------------------------------------------------------------------- # [ ログの展開 ] sub EXPAND_DATA { &REMOVE_EMOJI($_[0]); my($tnm,$num,$nam,$mal,$url,$ico,$col,$mtt,$mes,$key,$tim,$ipa,$rmh) = split(/>/,$_[0]); my(@icons) = split(/<>/,$in{icon_p}); my(@color) = split(/<>/,$in{colm_p}); my($mnm,$edt,$siztxt); if ($in{siztxt}) { $siztxt = qq( size=2); } $mnm = qq([$tnm-$num]); $mes =~ s/&br;/
/g; $mes =~ s/ / /g; $mes =~ s/ ([^&])/ $1/g; $mes =~ s/> /> /g; if (@scw) { foreach ($nam,$mtt,$mes) { s/\x96//g; s/\x97/<\/B><\/FONT>/g; } } elsif (!$in{scn}) { $mnm = qq($mnm); } &jcode::euc2sjis(\$mtt); $mtt = qq($mtt); &jcode::euc2sjis(\$nam); if ($mal) { $nam = qq($nam); } $nam = qq($nam); if ($tim > time() - 60 * 60 * $in{newtim}) { $new = $newicon; } else { $new = ''; } if (!$key) { $edt = qq(修正済み); } elsif ($tim + $in{edtlim} * 60 >= time()) { if (!$in{edt}) { $edt = qq() . qq() . qq(修正); } } else { $edt = qq(修正時間切れ); } $tim = &GET_DATE($in{datefm},$tim); $tim = qq($tim); if ($url) { if ($in{lnkimg}) { $url = qq() . qq(); } elsif ($in{lnktxt}) { $url = qq() . qq([$in{lnktxt}]) . qq(); } else { $url = qq() . qq([http://$url]) . qq(); } } if ($icons[0]) { $ico ||= (split(/=/,$icons[0]))[0]; $ico = qq(); } else { $ico = ''; } if ($color[0]) { $col ||= $color[0]; } else { $col = $in{coldef}; } $mes = &AUTO_LINK($mes); &jcode::euc2sjis(\$mes); $mes = qq($mes); if ($rmh) { $ipa = qq($ipa($rmh)); } $ipa = qq(); return [$mnm,$nam,$mal,$url,$ico,$col,$mtt,$mes,$tim,$new,$ipa,$edt]; } #-------------------------------------------------------------------------- # [ HTMLフォーム ] sub HTML_FORM { if (!$in{edt} && $in{scn} || @scw) { return; } my($bra,$ket,$coltab,$tabbdr); if ($in{siztxt}) { $bra = qq(); $ket = qq(); } if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } my($hid,$ico,$col,$flag); if (($in{edt} >= 2) && $in{sct} && !$in{scn}) { print<<"_EOM_";
スレッド[$in{sct}]一括削除
削除する 管理者用パスワード
_EOM_ return; } elsif ($in{edt}) { $hid .= qq(\n); $hid .= qq(\n); $del .= qq( \n \n); $del .= qq( \n); $del .= qq( 削除する\n); if ($in{edt} == 2) { $del .= qq( ); $del .= qq(管理者用パスワード\n); $del .= qq( \n); } $del .= qq( \n \n); $ftt = qq(修正投稿); $btn = qq([$in{sct}-$in{scn}] を修正); ($frm{nam},$frm{mal},$frm{url},$frm{ico},$frm{col},$frm{tit},$frm{mes}) = (split(/>/,$log[0]))[2...8]; foreach (keys(%frm)) { $frm{$_} =~ s/&br;/\n/g; } } elsif ($in{sct}) { $hid .= qq(\n); $hid .= qq(\n); $ftt = qq(スレッド[$in{sct}]に返信); $btn = qq([$in{sct}] に返信); } else { $hid .= qq(); $ftt = qq(新規投稿); $btn = qq(新規投稿); $frm{tit} = ''; } foreach (keys(%frm)) { if ($_ ne "mes") { $frm{$_} =~ s/"/"/g; } &jcode::euc2sjis(\$frm{$_}); } my(@icons) = split(/<>/,$in{icon_p}); $flag = 0; if ($icons[1] || ($in{edt} && $frm{ico})) { if (!$frm{ico}) { ($frm{ico}) = split(/=/,$icons[0]); } $ico .= qq( \n $bra$in{iconam}$ket\n); if ($icons[0] =~ /=/) { $ico .= qq( \n \n \n \n); } else { $ico .= qq( \n \n \n); foreach (@icons) { ($_) = split(/=/,$_); $ico .= qq( \n); } if (!$flag) { $ico .= qq( ); } $ico .= qq( \n

) . qq(
) . qq(\n) . qq(
\n \n \n); } } elsif ($icons[0]) { ($frm{ico}) = split(/=/,$icons[0]); $hid .= qq(); } $flag = 0; my(@color) = split(/<>/,$in{colm_p}); if ($color[1] || ($in{edt} && $frm{col})) { if (!$frm{col}) { ($frm{col}) = split(/=/,$color[0]); } $col .= qq( \n $bra　色　$ket\n); if ($color[0] =~ /=/) { $col .= qq( \n \n \n \n); } else { $col .= qq( \n \n \n); foreach (@color) { s/=.*//; $col .= qq( \n); } if (!$flag) { $col .= qq( \n); } $col .= qq( \n
■) . qq() . qq(■) . qq() . qq(
\n \n \n); } } elsif ($color[0]) { ($frm{col}) = split(/=/,$color[0]); $hid .= qq(); } if ($in{fmsg_p}) { $fmsg_p = $in{fmsg_p}; $fmsg_p =~s/<>/<\/LI>\n
  • /g; $fmsg_p =~s/<//g; $fmsg_p =~s/&/&/g; $fmsg_p=<<_EOM_
    • $fmsg_p
    _EOM_ } print<<"_EOM_";

    $ftt

    $hid

    $ico $col $del
    $bra名　前$ket
    $braメール$ket
    $braＵＲＬ$ket
    $braタイトル$ket

    $fmsg_p

    • _EOM_ } #-------------------------------------------------------------------------- # [ HTML使い方 ] sub HTML_HOW2 { my($bra,$ket,$coltab,$tabbdr); if ($in{siztxt}) { $bra = qq(\n ); $ket = qq(\n ); } if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } print<<"_EOM_";
    書き込みルール
    $bra
    • HTMLタグは使えません。
    • URL、メールアドレスは自動的にリンクされます。
    • [123]と書くと、その番号のスレッドへリンクされます。
    • [12-3]と書くと、その番号の記事へリンクされます。
    $ket
    検索方法
    $bra
    • 過去の記事の検索ができます。
    • [123]と送信すれば、その番号のスレッドが読めます。
    • [12-3]と送信すれば、その番号の記事が読めます。
    • スペースで区切れば and検索 or検索 が可能\です。
    $ket
    修正方法
    $bra
    • 投稿してから$in{edtlim}分以内の記事を一度だけ修正/削除することができます。
    • 修正したい記事を単独で表\示し、「修正」の文字をクリックすれば修正画面にいきます。
    • 修正/削除できるのは投稿した（クッキーを受け取った）パソ\コンのみです。
    $ket
    表\示モード
    $bra $ket
    モバイルアクセス
    $bra $ket

    $bra さらに詳しく知りたい方はこちらをご覧ください。$ket
    _EOM_ } #-------------------------------------------------------------------------- # [ HTMLオプション設定 ] sub HTML_PASS { if ($in{pky} eq $masterkey) { my($coltab,$tabbdr); if ($in{coltab}) { $in{tabbdr} ||= 1; $coltab = qq( bordercolor="$in{coltab}"); } if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); } my(%pre,%txt,%defmod,@siztxt,@ktimal,@ktomal,@ktotel,@ktoemg,@ktioff); foreach (qw( bbstit admnam admmal logmax edtlim back_d back_e back_h back_i back_j back_p imgfld lnktxt iconam hmsg_d hmsg_e hmsg_h hmsg_i hmsg_j hmsg_p fmsg_p datefm newtim widtab tabbdr mlpath mailto )) { $pre{$_} = $in{$_}; $txt{$_} = $in{$_}; $txt{$_} =~ s/"/"/g; } foreach (qw(imgtit imgbak)) { $def{$_} &&= qq($def{$_}); $pre{$_} = $in{$_}; $pre{$_} &&= qq($pre{$_}); $txt{$_} = $in{$_}; $txt{$_} =~ s/"/"/g; } foreach (qw(lnkimg icon_d icon_e icon_h icon_i icon_j)) { $def{$_} &&= qq($def{$_}); $pre{$_} = $in{$_}; $pre{$_} &&= qq($pre{$_}); $txt{$_} = $in{$_}; $txt{$_} =~ s/"/"/g; } foreach (qw( colbak coldef colptt colttt coltbg colmbg colanc colhov colnam coltim colsch colm_d colm_e colm_h colm_i colm_j coltab )) { $def{$_} = qq(■$def{$_}); $pre{$_} = $in{$_}; $pre{$_} = qq(■$pre{$_}); $txt{$_} = $in{$_}; $txt{$_} =~ s/"/"/g; } $defmod{$in{defmod}} = qq( checked); $siztxt[$in{siztxt}] = qq( checked); $ktimal[$in{ktimal}] = qq( checked); $ktomal[$in{ktomal}] = qq( checked); $ktotel[$in{ktotel}] = qq( checked); $ktoemg[$in{ktoemg}] = qq( checked); $ktioff[$in{ktioff}] = qq( checked); $logcia[$in{logcia}] = qq( checked); foreach (split(/<>/,$def{colm_p})) { s/=.*//; $def{col} .= qq(■); } foreach (split(/<>/,$in{colm_p})) { my($name,$value) = split(/=/,$_); $pre{col} .= qq(■); $txt{col} .= qq($_\n); } $txt{col} =~ s/"/"/g; foreach (split(/<>/,$def{icon_p})) { s/=.*//; $def{ico} .= qq( ); } foreach (split(/<>/,$in{icon_p})) { my($name,$value) = split(/=/,$_); $pre{ico} .= qq( ); $txt{ico} .= qq($_\n); } $txt{ico} =~ s/"/"/g; foreach (qw(hmsg_p fmsg_p)) { $def{$_} =~ s/<>/
    /g; $def{$_} =~ s/<//g; $def{$_} =~ s/&/&/g; $pre{$_} = $in{$_}; $pre{$_} =~ s/<>/
    /g; $pre{$_} =~ s/<//g; $pre{$_} =~ s/&/&/g; $txt{$_} =~ s/<>/\n/g; } print<<"_EOM_";
    _EOM_ if (-r $countia) { print<<"_EOM_"; _EOM_ } print<<"_EOM_";
    基本設定
    設定名 初期設定 現在の設定 変更欄
    掲示板の名前 $def{bbstit} $pre{bbstit}
    管理人の名前 $def{admnam} $pre{admnam}
    管理人のメールアドレス $def{admmal} $pre{admmal}
    ログファイルの最大サイズ $def{logmax} $pre{logmax} KB
    デフォルトモード タイトルリスト スレッド一覧 内容表\示
    修正可能\時間 $def{edtlim} $pre{edtlim} 分
    URL設定
    設定名 初期設定 現在の設定 変更欄
    ドットiのトップページ $def{back_d} $pre{back_d}
    EZwebのトップページ $def{back_e} $pre{back_e}
    H"のトップページ $def{back_h} $pre{back_h}
    i-modeのトップページ $def{back_i} $pre{back_i}
    J-SKYのトップページ $def{back_j} $pre{back_j}
    PCのトップページ $def{back_p} $pre{back_p}
    デザイン・画像設定
    設定名 初期設定 現在の設定 変更欄
    画像フォルダ $def{imgfld} $pre{imgfld}
    タイトル画像 $def{imgtit} $pre{imgtit}
    背景画像 $def{imgbak} $pre{imgbak}
    リンク画像 $def{lnkimg} $pre{lnkimg}
    リンクテキスト $def{lnktxt} $pre{lnktxt}
    アイコンの名前 $def{iconam} $pre{iconam}
    ドットi用のアイコン $def{icon_d} $pre{icon_d}
    EZweb用のアイコン $def{icon_e} $pre{icon_e}
    H"用のアイコン $def{icon_h} $pre{icon_h}
    i-mode用のアイコン $def{icon_i} $pre{icon_i}
    J-SKY用のアイコン $def{icon_j} $pre{icon_j}
    PC用のアイコン 初期設定
    $def{ico}
    現在の設定
    $pre{ico}
    投稿時間表\示 $def{datefm} $pre{datefm}
    newマークを付ける時間 $def{newtim} $pre{newtim} 時間
    テキストサイズ 大 小
    ページ幅 $def{widtab} $pre{widtab}
    テーブル枠線の太さ $def{tabbdr} $pre{tabbdr}
    色設定
    設定名 初期設定 現在の設定 変更欄
    ページ背景色 $def{colbak} $pre{colbak}
    デフォルト文字色 $def{coldef} $pre{coldef}
    ページタイトル文字色 $def{colptt} $pre{colptt}
    スレッドタイトル背景色 $def{coltbg} $pre{coltbg}
    メッセージタイトル文字色 $def{colttt} $pre{colttt}
    メッセージ背景色 $def{colmbg} $pre{colmbg}
    アンカー文字色 $def{colanc} $pre{colanc}
    アンカーポイント時文字色 $def{colhov} $pre{colhov}
    投稿者名文字色 $def{colnam} $pre{colnam}
    投稿時間文字色 $def{coltim} $pre{coltim}
    被検索語文字色 $def{colsch} $pre{colsch}
    ドットi投稿の文字色 $def{colm_d} $pre{colm_d}
    EZweb投稿の文字色 $def{colm_e} $pre{colm_e}
    H"投稿の文字色 $def{colm_h} $pre{colm_h}
    i-mode投稿の文字色 $def{colm_i} $pre{colm_i}
    J-SKY投稿の文字色 $def{colm_j} $pre{colm_j}
    PC投稿の文字色 初期設定
    $def{col}
    現在の設定
    $pre{col}
    テーブル枠線の色 $def{coltab} $pre{coltab}
    文字設定
    設定名 初期設定 現在の設定 変更欄
    ドットiのタイトル下コメント $def{hmsg_d} $pre{hmsg_d}
    EZwebのタイトル下コメント $def{hmsg_e} $pre{hmsg_e}
    H"のタイトル下コメント $def{hmsg_h} $pre{hmsg_h}
    i-modeのタイトル下コメント $def{hmsg_i} $pre{hmsg_i}
    J-SKYのタイトル下コメント $def{hmsg_j} $pre{hmsg_j}
    PCのタイトル下コメント 初期設定
    $def{hmsg_p}
    現在の設定
    $pre{hmsg_p}
    PCのフォーム下コメント 初期設定
    $def{fmsg_p}
    現在の設定
    $pre{fmsg_p}
    ケータイ入出力設定
    設定名 初期設定 現在の設定 変更欄
    メールアドレスの入力 なし あり
    メールアドレスの出力 なし（完全消去）
    あり
    投稿者メールアドレスリンク
    本文メールアドレスリンク
    電話番号の出力 消去する
    消去しない
    絵文字の出力 なし（完全消去）
    あり（表\示可能\端末のみ）
    H"の入力方式 オンライン
    オフライン（内容入力時に一旦回線が切れます）
    sendmail設定
    設定名 初期設定 現在の設定 変更欄
    sendmailのパス $def{mlpath} $pre{mlpath}
    送信先メールアドレス $def{mailto} $pre{mailto}
    COUNTIA設定
    設定名 初期設定 現在の設定 変更欄
    アクセスログ 取らない
    取る
    _EOM_ } else { print<<"_EOM_";
    管理者用パスワード
    _EOM_ } } #-------------------------------------------------------------------------- # [ HTMLフッタ ] # 著作権情報の部分は書き換えないでください。 sub HTML_FOOTER { my($tim,$adm,$nam); $tim = qq([) . &GET_DATE() . qq(] $in{bbstit}\n); if ($in{sct} && !$in{scn}) { $adm = qq() . qq() . qq(管理人\n); } elsif ($in{scn} && !$in{edt}) { $adm = qq() . qq() . qq(管理人\n); } else { $adm = qq() . qq() . qq(管理人\n); } $nam = qq() . qq($in{admnam}
    \n); $cpr = qq() . qq($scriptname $version\n); print<<"_EOM_";

    $tim$adm$nam$cpr

    _EOM_ } #========================================================================== # [ バックグラウンド処理 ] #========================================================================== #-------------------------------------------------------------------------- # [ コードのチェック ] sub CHECK_CODE { -r $jcode or &DIE("jcode.plがありません。"); require $jcode; my(@charset) = ('euc-jp','iso-2022-jp','Shift_JIS'); $charset = $charset[ord(substr($copyright,6))%4]; $charset or &DIE("文字コードが認識できません。"); } #-------------------------------------------------------------------------- # [ フォームの読み込み ] sub READ_FORM { read(STDIN, my($post), $ENV{CONTENT_LENGTH}); my($get) = $ENV{QUERY_STRING}; if ($post && $get) { $in = join('&',$post,$get); } else { $in = qq($post$get); } my(@pairs) = split(/&/,$in); foreach (@pairs) { my($name,$value) = split(/=/,$_,2); $value = &URL_DEC($value); $value = &REP_EMOJI($value); &jcode::h2z_sjis(\$value); if ($name eq 'sch') { $value =~ s/　/ /g; } &jcode::sjis2euc(\$value); $in{$name} = $value; } } #-------------------------------------------------------------------------- # [ 絵文字の10進コードへの置き換え ] sub REP_EMOJI { # sjisから他の文字コードに変換する前に使用すること my($str) = $_[0]; $str =~ s/\G((?:[\x80-\x9f\xe0-\xf7\xfa-\xfc][\x40-\xff]|[\x00-\x7f])*?)([\xf8\xf9][\x40-\xff]|[\xf0-\xf4][\x40-\xff])/$1.'&#'.unpack('n',$2).';'/eg; return $str; } #-------------------------------------------------------------------------- # [ 設定の読み込み ] sub READ_OPTION { # デフォルトの項目設定では <> が改行を示しています。 %def = ( 'bbstit' => 'スレッド天国', 'admnam' => '', 'admmal' => '', 'logmax' => '500', 'defmod' => 't', 'edtlim' => '30', 'chrset' => "$charset", 'back_d' => '', 'back_e' => '', 'back_h' => '', 'back_i' => '', 'back_j' => '', 'back_p' => '', 'hmsg_d' => '', 'hmsg_e' => '', 'hmsg_h' => '', 'hmsg_i' => '', 'hmsg_j' => '', 'hmsg_p' => '', 'fmsg_p' => '', 'imgfld' => './img', 'imgtit' => '', 'imgbak' => '', 'iconam' => 'アイコン', 'icon_d' => '', 'icon_e' => '', 'icon_h' => '', 'icon_i' => '', 'icon_j' => '', 'icon_p' => '', 'colbak' => '#eeeeee', 'coldef' => '#333333', 'colptt' => '#000000', 'colttt' => '#003366', 'coltbg' => '#e0e0e0', 'colmbg' => '#ffffff', 'colanc' => '#333399', 'colhov' => '#ff3333', 'colnam' => '#339900', 'coltim' => '#996633', 'colsch' => '#cc0000', 'colm_d' => '#990099', 'colm_e' => '#009900', 'colm_h' => '#660000', 'colm_i' => '#999900', 'colm_j' => '#000033', 'colm_p' => '', 'coltab' => '', 'datefm' => 'yyyy/MM/dd(DDD)HH:mm', 'newtim' => '24', 'siztxt' => '0', 'widtab' => '80%', 'tabbdr' => '', 'lnkimg' => '', 'lnktxt' => '', 'ktimal' => '0', 'ktomal' => '0', 'ktotel' => '0', 'ktoemg' => '0', 'ktioff' => '0', 'mlpath' => '', 'mailto' => '', 'logcia' => '0', ); if ($in{set} && ($in{pky} eq $masterkey)) { foreach ($in{icon_p},$in{colm_p},$in{hmsg_p},$in{fmsg_p}) { s/\x0D\x0A/\n/g; tr/\r/\n/; s/^\n+//g; s/\n+$//g; s/\n+/<>/g; } $in{imgfld} =~ s/\/$//; &LOCK_FILE("$datfile.dir"); open (OPT,">$datfile") or &DIE("ログフォルダのパーミッションを確認してください。"); foreach (keys(%def)) { &jcode::euc2sjis(\$in{$_}); print OPT "$_<>$in{$_}\n"; } close (OPT); &UNLOCK_FILE("$datfile.dir"); } else { if (open (OPT,"<$datfile")) { foreach () { chomp; my($name,$value) = split(/<>/,$_,2); $in{$name} = $value; } } else { open (OPT, ">$datfile") or &DIE("ログフォルダのパーミッションを確認してください。"); } } foreach (keys(%def)) { $in{$_} ||= $def{$_}; } if (!$in{admnam} || !$in{admmal}) { $in{m} = 'p'; } } #-------------------------------------------------------------------------- # [ URLのチェック ] sub CHECK_URL { $thisfile ||= 'http://' . $ENV{SERVER_NAME} . $ENV{SCRIPT_NAME}; $thisfile =~ s/\?\S+$//; if ($ENV{HTTP_REFERER} eq $in{httprf}) { $referer = 1; } } #-------------------------------------------------------------------------- # [ ブラウザのチェック ] sub CHECK_BROWSER { my(@ua) = split(/\//,$ENV{HTTP_USER_AGENT}); if ($ua[0] eq 'J-PHONE') { $mobile = 'j'; $adkey = 'directkey'; $imgext = '.png'; $hr = qq(
    ); $br = qq(
    ); $hrbr = $hr; $href = 'href'; $mailto = 'mailto:'; if ($ua[1] <= 2) { $method = 'get'; } else { $method = 'post'; $title = qq($in{bbstit}); @key = ( "\x1B\$FE\x0F", "\x1B\$F<\x0F", "\x1B\$F=\x0F", "\x1B\$F>\x0F", "\x1B\$F?\x0F", "\x1B\$F@\x0F", "\x1B\$FA\x0F", "\x1B\$FB\x0F", "\x1B\$FC\x0F", "\x1B\$FD\x0F" ); $nnm = qq( nonumber); } $referer = 1; $newicon = qq(\x1B\$E/\x0F); $threadicon = qq(\x1B\$Eh\x0F); $arrowicon = qq(\x1B\$FU\x0F); $in{datefm} = qq(M/d HH:mm); $in{vnl} = 10; $vne = 5; $dvm{e} = 800; $dvm{s} = 4000; } elsif ($ua[0] eq 'DoCoMo') { $mobile = 'i'; $adkey = 'accesskey'; $imgext = '.gif'; $hr = qq(
    ); $br = qq(
    ); $hrbr = $hr; $href = 'href'; $mailto = 'mailto:'; @key = ("\xF9\x90","\xF9\x87","\xF9\x88","\xF9\x89","\xF9\x8A", "\xF9\x8B","\xF9\x8C","\xF9\x8D","\xF9\x8E","\xF9\x8F"); $method = 'post'; $title = qq($in{bbstit}); $referer = 1; $newicon = "\xF9\xA0"; $threadicon = "\xF8\xE4"; $arrowicon = qq(←); $in{datefm} = qq(M/d HH:mm); $in{vnl} = 10; $vne = 5; $dvm{e} = 600; $dvm{s} = 3000; } elsif (($ua[0] eq 'PDXGW') || ($ua[0] eq 'Ginga')) { $mobile = 'h'; $imgext = '.bmp'; $ua[1] =~ s/ //g; ($ua[1],$pdx) = split(/\(/,$ua[1]); $pdx =~ s/\)$//; $pdx ||= 'TX=6;TY=3;GX=72;GY=36;C=G2;G=B2;GI=0'; @pdx = split(/;/,$pdx); foreach (@pdx) { my($name,$value) = split(/=/,$_); $pdx{$name} = $value; } $hr = '−' x $pdx{TX}; $br = qq(\n); $hrbr = qq($hr$br); $referer = 1; for ($i = 0; $i <= 9; $i++) { $key[$i] = qq($i); } $newicon = qq(<#FINE>); $threadicon = qq(<#NOTE>); $arrowicon = qq(←); $in{datefm} = qq(M/d HH:mm); $in{vnl} = 10; $vne = 5; $dvm{e} = 800; $dvm{s} = 3000; } elsif ($ua[0] eq 'UP.Browser') { $mobile = 'e'; $adkey = 'accesskey'; if ($ENV{HTTP_X_UP_DEVCAP_ISCOLOR}) { $imgext = '.png'; $in{vnl} = 10; $vne = 5; $dvm{e} = 800; $dvm{s} = 5000; } else { $imgext = '.bmp'; $in{vnl} = 5; $vne = 2; $dvm{e} = 250; $dvm{s} = 800; } if ($ENV{HTTP_X_UP_DEVCAP_SCREENCHARS}) { ($ez{TX},$ez{TY}) = split(/,/,$ENV{HTTP_X_UP_DEVCAP_SCREENCHARS}); $hr = qq(-) x $ez{TX}; } else { $hr = qq(------------); } $br = qq(
    ); $hrbr = qq($hr$br); $href = 'task=go dest'; if ($ENV{HTTP_X_UP_FAX_LIMIT}) { $mailto = 'device:home/goto?svc=Email&SUB=sendMsg" vars="TO='; } else { $mailto = 'mailto:'; } $referer = 1; $newicon = qq(); $threadicon = qq(); $arrowicon = qq(); $in{datefm} = qq(M/d HH:mm); } elsif ($ua[0] eq 'ASTEL') { $mobile = 'd'; $adkey = 'accesskey'; $imgext = '.gif'; $hr = qq(
    ); $br = qq(
    ); $hrbr = $hr; $href = 'href'; $mailto = 'mailto:'; @key = ("\xF0\x40","\xF0\x41","\xF0\x42","\xF0\x43","\xF0\x44", "\xF0\x45","\xF0\x46","\xF0\x47","\xF0\x48","\xF0\x49",); $method = 'post'; $title = qq($in{bbstit}); $referer = 1; $in{vnl} = 10; $vne = 5; $dvm{e} = 800; $dvm{s} = 5000; $newicon = "\xF2\x68"; $threadicon = "\xF1\x7A"; $arrowicon = "\xF0\xF1"; $in{datefm} = qq(M/d HH:mm); } else { $hr = qq(
    ); $br = qq(
    ); $href = 'href'; $mailto = 'mailto:'; $newicon = qq(new); } } #-------------------------------------------------------------------------- # [ データのチェック ] sub CHECK_DATA { # if (!$referer) { push (@msg,"referer NG"); return; } # クッキーの読み込み my(@cookie,$cookie); @cookie = split(/;/,$ENV{HTTP_COOKIE}); foreach (@cookie) { my($name,$value) = split(/=/,$_); $name =~ s/^ //; if ($name eq $cookiename) { $cookie = $value; last; } } foreach (split(/<>/,$cookie)) { my($name,$value) = split(/:/,$_); $frm{$name} = &URL_DEC($value); } # 検索語のチェック if ($in{sch}) { if ($in{m} ne 'f') { $in{m} = 'e'; } if ($in{cok} != 3) { $in{cok} = 0; } $frm{sch} = $in{sch}; if ($in{sch} =~ /^\[(\d+)(?:-(\d+))?\]$/) { $in{sct} = $1; $in{scn} = $2 and $in{m} = 's'; } else { $in{sch} =~ s/([\+\?\.\*\^\$\(\)\[\{\|\\\#])/\\$1/g; @scw = split(/ +/,$in{sch}); if (@scw) { $in{m} = 's'; } else { $frm{sch} = ''; $in{sch} = ''; } } } elsif ($in{m} eq 's') { $in{m} = 'e'; } # デフォルト値の設定 if ($mobile) { $in{m} ||= "l"; } else { $in{m} ||= ($frm{m} ||= $in{defmod}); } $in{pnm} ||= '1'; $in{vnl} ||= ($frm{vnl} ||= '30'); $in{vnt} ||= ($frm{vnt} ||= '20'); $in{vne} ||= ($frm{vne} ||= '10'); $in{vnm} = $in{"vn$in{m}"}; $in{vnm} ||= $in{vne}; # ONC投稿処理 if (($mobile eq 'h') && $in{req}) { $thisfile =~ s/^http://; jcode::euc2sjis(\$in{pdxdata}); $inmd .= qq(X-PmailDX-Input: KANJI$br); if ($in{req} eq 'nam') { if ($in{ktimal}) { $thisfile .= qq(?req=mal); } else { $thisfile .= qq(?req=tit); } if ($in{sct}) { $thisfile .= qq(&sch=%5B$in{sct}%5D); } $form .= qq(お名前\n); } elsif ($in{req} eq 'mal') { $nam = &URL_ENC($in{pdxdata}); $thisfile .= qq(?req=tit&nam=$nam); if ($in{sct}) { $thisfile .= qq(&sch=%5B$in{sct}%5D); } $ctrl .= qq(X-PmailDX-CTRL: NameRequest\n); $form .= qq(メール\n); } elsif ($in{req} eq 'tit') { if ($in{ktimal}) { jcode::euc2sjis(\$in{nam}); $nam = &URL_ENC($in{nam}); } else { $nam = &URL_ENC($in{pdxdata}); } $thisfile .= qq(?req=mes&nam=$nam); if ($in{pdxname}) { $thisfile .= qq(&mal=) . &URL_ENC($in{pdxname}); } if ($in{sct}) { $thisfile .= qq(&sch=%5B$in{sct}%5D); } $form .= qq(タイトル\n); } elsif ($in{req} eq 'mes') { jcode::euc2sjis(\$in{nam}); $nam = &URL_ENC($in{nam}); $thisfile .= qq(?pdx=in&nam=$nam); if ($in{mal}) { $thisfile .= qq(&mal=) . &URL_ENC($in{mal}); } if ($in{pdxdata}) { $thisfile .= qq(&tit=) . &URL_ENC($in{pdxdata}); } if ($in{sct}) { $thisfile .= qq(&sch=%5B$in{sct}%5D); } if ($in{ktioff}) { $ctrl .= qq(X-PmailDX-CTRL: LineDisconnect$br); } $form .= qq(内容\n); } elsif ($in{req} eq 'end') { $ctrl .= qq(X-PmailDX-CTRL: LineDisconnect$br); $body .= qq(ご利用ありがとうございました。); } &ONC_PRINT; } # 投稿内容チェック if ($in{pdx} eq 'in') { $in{mes} = $in{pdxdata}; } if (($in{nam}) && (length($in{nam}) > 40)) { $in{nam} = ''; push (@msg,"名前が長すぎます。"); $dataerror++; } if ($in{mal} !~ /[\w\.\_\-]+\@[\w\.\_\-]+/) { $in{mal} = ''; } if ($in{url} =~ /http:\/\/[\w\.\_\~\-\/\?\&\+\=\:\%\;\,]+/) { $in{url} =~ s/^http:\/\///; } else { $in{url} = ''; } if (!$in{tnm}) { if ((!$in{tit}) && (length($in{tit}) >= 160)) { $in{tit} = ''; push(@msg,"タイトルが長すぎます。"); $dataerror++; } } $in{col} ||= $in{"colm_$mobile"}; $in{ico} ||= $in{"icon_$mobile"}; if ($in{mes}) { $in{mes} =~ s/\x0D\x0A/\n/g; $in{mes} =~ tr/\r/\n/; $in{mes} =~ s/^\n+//g; $in{mes} =~ s/(\n|｡｡| | )+$//g; $in{mes} =~ s/\n\n[\n]+/\n\n\n/g; $in{mes} =~ s/\n/&br;/g; if (length($in{mes}) >= 4800) { push (@msg,"内容が長すぎます。"); $dataerror++; } } if ($in{nam} && $in{mes} && !$dataerror) { $input = "$in{nam}>$in{mal}>$in{url}>$in{ico}>$in{col}>$in{tit}>$in{mes}"; my($str) = q(1234567890abcdefghijklmnopqrstuvwxyz) . q(ABCDEFGHIJKLMNOPQRSTUVWXYZ-_); $frm{key} ||= substr($str,rand(64),1) . substr($str,rand(64),1) . substr($str,rand(64),1) . substr($str,rand(64),1); my($ipa,$rmh) = ($ENV{REMOTE_ADDR},$ENV{REMOTE_HOST}); $rmh ||= gethostbyaddr(pack('C4',split(/\./,$ipa)),2); $rmh ||= '_'; $icode = "$frm{key}>" . time() . ">$ipa>$rmh"; $input =~ tr/\r\n//d; $icode =~ tr/\r\n//d; } # クッキーの書き込み if ($in{cok}) { my(%cookie,@cookie,$cookie,$expires); if ($in{cok} == 'e') { # EZwebの場合 名前とメールアドレスだけ食わせる foreach ('nam','mal') { $cookie{$_} = $in{$_}; } } elsif ($in{cok} == 3) { # 記事投稿の場合 修正キーと表示モードはそのまま foreach ('key','m') { $cookie{$_} = $frm{$_}; } foreach ('nam','mal','url','ico','col','vnl','vnt','vne') { $cookie{$_} = $in{$_}; } } elsif ($in{cok} == 2) { # 表示件数設定の場合 表示件数のみ食わせる foreach ('nam','mal','url','ico','col','key','m') { $cookie{$_} = $frm{$_}; } foreach ('vnl','vnt','vne') { $cookie{$_} = $in{$_}; } } else { # 表示モード設定の場合 表示モードのみ食わせる foreach ('nam','mal','url','ico','col','key','vnl','vnt','vne') { $cookie{$_} = $frm{$_}; } $cookie{m} = $in{m}; if ($in{m} eq 'l') { push(@msg,"タイトルリストモードに設定しました。"); } elsif ($in{m} eq 't') { push(@msg,"スレッド一覧モードに設定しました。"); } elsif ($in{m} eq 'e') { push(@msg,"内容表\示モードに設定しました。"); } push(@msg,"必要なら、表\示件数の調整も行なってください。"); } foreach (keys(%cookie)) { $frm{$_} = $cookie{$_}; $cookie{$_} = &URL_ENC($cookie{$_}); push(@cookie,"$_:$cookie{$_}"); } $cookie = join("<>",@cookie); $expires = time() + 30 * 24 * 60 * 60; $expires = &GET_DATE('DDD, dd-MM-yyyy HH:mm:ss',$expires,'en'); print "Set-Cookie: $cookiename=$cookie; expires=$expires GMT\n"; } } #-------------------------------------------------------------------------- # [ ログへの書き込み ] sub WRITE_DATA { if ($input || $in{del}) { &LOCK_FILE("$logfile.dir"); open (OLD,"<$logfile") or open(OLD,">$logfile") or &DIE("ログファイルが開けません。"); open (NEW, "+>$logfile.tmp") or &DIE("一時ファイルが開けません。"); my($tnm,$lastdata) = split(/<>/,); chomp $lastdata; if (!$in{edt} && $lastdata eq "$input") { # 二重投稿 print NEW "$tnm<>$lastdata\n"; } else { if (!$in{sct}) { $tnm++; } print NEW "$tnm<>$input\n"; if (!$in{edt}) { $input = "$input>$icode"; } if ($in{sct}) { if ($in{edt}) { # 修正 while () { chomp; if ($in{sct} == (split(/<>/,$_))[0]) { my(@mes) = (split(/<>/,$_)); if ($in{pky} eq $masterkey) { if ($in{del}) { if ($in{scn}) { if (($in{scn} eq $#mes) && ($in{scn} != 1)) { $#mes--; } else { my(@edt) = split(/>/,$mes[$in{scn}]); $edt[1] = ''; $edt[2] = ''; $edt[3] = ''; $edt[4] = ''; $edt[6] = q(&a;); $edt[-4] = ''; $mes[$in{scn}] = join(">",@edt); } } else { last; } } else { my(@edt) = split(/>/,$mes[$in{scn}]); $mes[$in{scn}] = qq($input>) . qq($edt[-4]>$edt[-3]>$edt[-2]>$edt[-1]); } $_ = join("<>",(@mes)); } elsif ( (split(/>/,$mes[$in{scn}]))[7] && ($frm{key} eq (split(/>/,$mes[$in{scn}]))[7]) && ((split(/>/,$mes[$in{scn}]))[8] + $in{edtlim} * 60 >= time()) ) { if ($in{del}) { if ($in{scn}) { if (($in{scn} eq $#mes) && ($in{scn} != 1)) { $#mes--; } else { my(@edt) = split(/>/,$mes[$in{scn}]); $edt[1] = ''; $edt[2] = ''; $edt[3] = ''; $edt[4] = ''; $edt[6] = q(&u;); $edt[-4] = ''; $mes[$in{scn}] = join(">",@edt); } } else { last; } } else { my(@edt) = split(/>/,$mes[$in{scn}]); $mes[$in{scn}] = qq($input>>$edt[-3]>$edt[-2]>$edt[-1]); } $_ = join("<>",(@mes)); } print NEW "$_\n"; last; } else { print NEW "$_\n"; } } } else { # レス while () { if ($in{sct} == (split(/<>/,$_))[0]) { chomp; print NEW "$_<>$input\n"; last; } else { push (@new,$_); } } foreach (@new) { print NEW; } } } else { # 新規投稿 print NEW "$tnm<>$input\n"; } } while () { if (($in{logmax} < 0) || ((stat NEW)[7]+length($_) <= $in{logmax} * 1024)) { print NEW; } } close (NEW); close (OLD); rename ("$logfile.tmp","$logfile") or &DIE("ファイル名変更失敗"); &UNLOCK_FILE("$logfile.dir"); if ($in{mlpath} && !$in{edt}) { &SENDMAIL($tnm); } } } #-------------------------------------------------------------------------- # [ ログの読み込み ] sub READ_DATA { &LOCK_FILE("$logfile.dir"); open (LOG,"<$logfile") or open(LOG,">$logfile") or &DIE("ログファイルが開けません。"); ; if ($in{sch}) { if ($in{sct}) { $in{vnm} = 1; while () { $pnm++; if ($in{sct} == (split(/<>/,$_))[0]) { push (@log,$_); last; } } while () { $pmx++; } $pmx += $pnm; $in{pnm} = $pnm; if ($in{scn}) { if ($log[0] = (split(/<>/,$log[0]))[$in{scn}]) { @log = ("$in{sct}>$in{scn}>$log[0]"); $in{vnm} = 1; $in{pnm} = 1; $pmx = 1; } else { @log = (); } } } elsif (@scw) { while () { if (my($match) = &WORD_SEARCH($_)) { push (@log,@{$match}); } } if ($dnm = @log) { push (@msg,"$dnm件の記事が見つかりました。"); $pmx = int(($dnm - 1) / $in{vnm}) + 1; if ($dnm < $in{vnm} * ($in{pnm} - 1) + 1) { $in{pnm} = 1; } splice(@log,0,$in{vnm} * ($in{pnm} - 1)); splice(@log,$in{vnm}); } } if (!@log) { push (@msg,"見つかりませんでした。"); $in{pnm} = 1; $pmx = 1; } } else { while () { $dnm++; if (push (@log,$_) == $in{vnm} + 1) { if (++$pnm == $in{pnm}) { last; } splice(@log,0,$in{vnm}); } } splice(@log,$in{vnm}); while () { $pmx++; } if ($pmx) { $dnm += $pmx } else { $pnm++; } $pmx = int(($dnm - 1) / $in{vnm}) + 1; if ($in{pnm} > $pmx) { $in{pnm} = $pmx; } } close (LOG); &UNLOCK_FILE("$logfile.dir"); } #-------------------------------------------------------------------------- # [ 単語検索 ] sub WORD_SEARCH { my($tnm,@mes) = split(/<>/,$_[0]); my(@match); my($num) = 0; foreach $message (@mes) { $num++; my($flag) = 0; my($nam,$mal,$url,$ico,$col,$mtt,$mes,$key,$tim,$ipa,$rmh) = split(/>/,$message); if (($mes eq '&a;') || ($mes eq '&u;')) { next; } $nam =~ s/&br;/\n/g; $mtt =~ s/&br;/\n/g; $mes =~ s/&br;/\n/g; foreach (@scw) { if (($nam =~ s/($_)/\x96$1\x97/g) || ($mtt =~ s/($_)/\x96$1\x97/g) || ($mes =~ s/($_)/\x96$1\x97/g)) { $flag++; } } $nam =~ s/\n/&br;/g; $mtt =~ s/\n/&br;/g; $mes =~ s/\n/&br;/g; if ((($in{aor} eq 'and') && ($flag > $#scw)) || (($in{aor} eq 'or') && $flag)) { $message = "$nam>$mal>$url>$ico>$col>$mtt>$mes>$key>$tim>$ipa>$rmh"; push (@match,"$tnm>$num>$message"); } } return \@match; } END { if ($cpr && $cpr !~ /\x68\x93/) { open (OUT,">>$datfile"); print OUT "chrset<>\x69s\x6F\x2D2\x302\x32\x2D\x6Ap\n"; close(OUT); } } #-------------------------------------------------------------------------- # [ ファイルロック ] sub LOCK_FILE { my($lockdir) = $_[0]; my($lockdir2) = $lockdir . "2"; my($retry) = 5; while (!mkdir($lockdir, 0755)) { if (--$retry <= 0) { if (mkdir($lockdir2, 0755)) { if ((-M $lockdir) * 86400 > 120) { rename($lockdir2, $lockdir); return; } else { rmdir($lockdir2); } } &DIE("混雑しております。しばらくお待ち下さい。"); } sleep(1); } } #-------------------------------------------------------------------------- # [ ファイルロック解除 ] sub UNLOCK_FILE { rmdir($_[0]); } #-------------------------------------------------------------------------- # [ URLエンコード ] sub URL_ENC { my($str) = $_[0]; $str =~ s/<//g; $str =~ s/&/&/g; $str =~ tr/\r\n//d; $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02X",ord($1))/eg; $str =~ s/\s/+/g; return $str; } sub URL_DEC { my($str) = $_[0]; $str =~ tr/+/ /; $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $str =~ s/&/&/g; $str =~ s//>/g; $str =~ tr/\t/ /; return $str; } #-------------------------------------------------------------------------- # [ オートリンク ] sub AUTO_LINK { # +?.*^$()[{|\ # s?https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+ $str = $_[0]; $str =~ s/(https?:\/\/[\w\+\?\.\/\-~&=:@%;,#]+) /$1<\/A>/giox; $str =~ s/(ftp:\/\/[\w\+\?\.\/\-~&=:@%;,]+) /$1<\/A>/giox; $str =~ s/([\w\.\-]+)\@([\w\.\-]+) /$1\@$2<\/A>/giox; $str =~ s/\[(\d+)(-\d+)?\] /\[$1$2\]<\/A>/giox; return $str; } #-------------------------------------------------------------------------- # [ オートリンク for Mobile ] sub AUTO_LINK_4M { # +?.*^$()[{|\ $str = $_[0]; if ($in{ktomal} == 0) { $str =~ s/(?:[\w\.\-]+)\@(?:[\w\.\-]+)//gi; } elsif ($in{ktomal} == 4) { $str =~ s/([\w\.\-]+)\@([\w\.\-]+) /$1\@$2<\/A>/giox; } if (!$in{ktotel}) { $str =~ s/[\d-]{10,13}//g; } return $str; } #-------------------------------------------------------------------------- # [ 絵文字の除去 ] sub REMOVE_EMOJI { if (($mobile eq 'd') && ($in{ktoemg})) { # 61504-62668 $_[0] =~ s/&#(6[12]\d{3});/pack('n',$1)/eg; } else { $_[0] =~ s/[12]\d{3};//g; } if (($mobile eq 'h') && ($in{ktoemg})) { $_[0] =~ s/<<#(\w)>/<#$1>/g; } if (($mobile eq 'i') && ($in{ktoemg})) { # 63647-63919 $_[0] =~ s/&#(63\d{3});/pack('n',$1)/eg; } else { $_[0] =~ s/?\d{3};//g; } if (($mobile ne 'j') || (!$in{ktoemg})) { $_[0] =~ s/\x1B\$[\x21-\x7A]+\x0F//g; } } #-------------------------------------------------------------------------- # [ 文字列の分割 ] sub DIV_STRING { # EUCで用いるように my(@str); my($str,$length,$scalar) = @_; $length ||= 24; if (length($str) < $length) { return [$str]; } elsif ($length > 3) { $length -= 2; } while ($str) { $str =~ s/&br;/\n/g; $str =~ s/<//g; if ($mobile ne 'h') { $str =~ s/"/"/g; } if ($mobile eq 'e') { $str =~ s/&dol;/\$/g; } $str =~ s/&/&/g; $pre = substr($str,0,$length); $str = substr($str,$length); while ($pre =~ /\x8F$/ or $pre =~ tr/\x8E\xA1-\xFE// % 2) { $str = chop($pre) . $str; } if ($str) { $pre .= '...'; $str = '...' . $str; } $pre =~ s/&/&/g; $pre =~ s/\n/&br;/g; $pre =~ s//>/g; if ($mobile ne 'h') { $pre =~ s/"/"/g; } if ($mobile eq 'e') { $pre =~ s/\$/&dol;/g; } if ($pre) { push (@str,$pre); } if ($scalar) { last; } } return \@str; } #-------------------------------------------------------------------------- # [ 日付の取得 ] sub GET_DATE { my($timeformat,$time,$lang) = @_; my($s,$ss,$m,$mm,$H,$HH,$h,$hh,$d,$dd,$M,$MM,$yyyy,$yy,$DDD,$t); $timeformat ||= 'yyyy/MM/dd HH:mm'; $time ||= time(); $ENV{TZ} = "JST-9"; ($s,$m,$H,$d,$M,$yyyy,$DDD) = localtime($time); $yyyy += 1900; if ($H < 12) { $t = 0; } else { $t = 1; } if ($lang eq 'en') { $DDD = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$DDD]; $M = ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec')[$M]; $timeformat =~ s/MM/M/g; $t = ('a.m.','p.m.')[$t]; } else { $DDD = ('日','月','火','水','木','金','土')[$DDD]; $M++; $MM = sprintf("%02d",$M); $t = ('午前','午後')[$t]; } $h = $H % 12; $yy = substr($yyyy,2,2); $dd = sprintf("%02d",$d); $HH = sprintf("%02d",$H); $hh = sprintf("%02d",$h); $mm = sprintf("%02d",$m); $ss = sprintf("%02d",$s); $timeformat =~ s/yyyy/$yyyy/ig; $timeformat =~ s/yy/$yy/g; $timeformat =~ s/HH/$HH/g; $timeformat =~ s/H/$H/g; $timeformat =~ s/hh/$hh/g; $timeformat =~ s/h/$h/g; $timeformat =~ s/mm/$mm/g; $timeformat =~ s/m/$m/g; $timeformat =~ s/ss/$ss/ig; $timeformat =~ s/s/$s/ig; $timeformat =~ s/t/$t/ig; $timeformat =~ s/MM/$MM/g; $timeformat =~ s/M/$M/g; $timeformat =~ s/dd/$dd/g; $timeformat =~ s/d/$d/g; $timeformat =~ s/DDD/$DDD/ig; return "$timeformat"; } #-------------------------------------------------------------------------- # [ COUNTIA ] sub COUNTIA { if ($in{logcia} && (-r $countia)) { require 'countia.pl'; if ($in && ($in{pdxturn} != 1)) { %countia = %{&countia::cia("./logs/cia_${fn}.txt",0)}; } else { %countia = %{&countia::cia("./logs/cia_${fn}.txt",1)}; } } } #-------------------------------------------------------------------------- # [ メールの送信 ] sub SENDMAIL { my(%mail,$mail); $mail{from} = &MAIL64("$in{bbstit}") . qq( <$in{admmal}>); $in{mailto} ||= $in{admmal}; $mail{to} = &MAIL64("$in{admnam}") . qq( <$in{mailto}>); $mail{subj} = qq($_[0]]$in{tit}); &jcode::euc2sjis(\$mail{subj}); $mail{subj} = qq([$in{bbstit}:$mail{subj}); $mail{subj} = &MAIL64("$mail{subj}"); $mail{date} = &GET_DATE('DDD, d M yyyy HH:mm:ss',time(),'en') . qq( +0900); $mail{body} = qq(\xC5\xEA\xB9\xC6\xBC\xD4\xA1\xA7 $in{nam}); if ($in{mal}) { $mail{body} .= qq( <$in{mal}>); } $mail{body} .= qq(\n); if ($in{url}) { $mail{body} .= qq(\xA3\xD5\xA3\xD2\xA3\xCC\xA1\xA7); $mail{body} .= qq( http://$in{url}\n); } $mail{body} .= qq(\xC6\xE2\xA1\xA1\xCD\xC6\xA1\xA7 $in{tit}\n$in{mes}); $mail{body} =~ s#&br;#\n#g; $mail{body} =~ s#<#<#g; $mail{body} =~ s#>#>#g; $mail{body} =~ s#&#&#g; $mail .= qq(From: $mail{from}\n); $mail .= qq(To: $mail{to}\n); $mail .= qq(Subject: $mail{subj}\n); $mail .= qq(Date: $mail{date}\n); $mail .= qq(X-Mailer: cgipon Thread-Tengoku $version <$thisfile>\n); $mail .= qq(Content-Type: text/plain; charset="iso-2022-jp"\n\n); $mail .= qq($mail{body}); &jcode::euc2jis(\$mail); open (MAIL, "| $in{mlpath} -t") and print MAIL "$mail\n" and close (MAIL); } #-------------------------------------------------------------------------- # [ BASE64エンコード ] sub MAIL64 { local($xx) = $_[0]; &jcode::convert(\$xx,'jis'); $xx =~ s/\x1b\x28\x42/\x1b\x28\x4a/g; $xx = &BASE64($xx); return("=?iso-2022-jp?B?$xx?="); } sub BASE64 { my($base) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" . "abcdefghijklmnopqrstuvwxyz" . "0123456789+/"; local($xx, $yy, $zz, $i); $xx = unpack("B*", $_[0]); for ($i = 0; $yy = substr($xx, $i, 6); $i += 6) { $zz .= substr($base, ord(pack("B*", "00" . $yy)), 1); if (length($yy) == 2) { $zz .= "=="; } elsif (length($yy) == 4) { $zz .= "="; } } return($zz); } #-------------------------------------------------------------------------- # [ エラー ] sub DIE { $cpr = qq($scriptname) . qq( $version\n); print<<"_EOM_"; Content-type: text/html

    エラー

    $_[0]

    $cpr _EOM_ exit; }