#!/usr/bin/perl # スレッド天国 ver.1.10, (C)Copyright 2001 OGATA TETSUJI $masterkey = '878'; # ↑管理用パスワード(半角英数)を''の間に書いてください。 $thisfile = ''; # ↑掲示板が動かないときは''の間にhttp://から始まるURLを入力してください。 # 例 $thisfile = 'http://specters.net/cgipon/tengoku.cgi'; #-------------------------------------------------------------------------- # # 掲示板のカスタマイズはブラウザ上からできますので、 # これ以降は書き換える必要はありません。 # まずはそのまま設置して動作確認を取るようにしてください。 # #-------------------------------------------------------------------------- #========================================================================== # [ Note ] # 著作権情報です。書き換えないでください。 #========================================================================== $scriptname = 'スレッド天国'; # 書き換え不可 $version = 'ver.1.10'; # 書き換え不可 $copyright = '緒方哲治'; # 書き換え不可 #-------------------------------------------------------------------------- # [ 著作権・使用上の注意 ] # # このソフトウェア（以下「スレッド天国」と記述）は緒方哲治が作成しました。 # 著作権は緒方哲治に属します。（jcode.plを除く） # 著作者の許可なく配布・販売することを禁止します。 # # スレッド天国はフリーソフトです。 # スレッド天国を使用して発生したいかなる損害に対しても作者は責任を負いません。 # 改造は自由ですが、スクリプト内および表示されるHTML内にある著作者情報は削除・ # 変更しないでください。 # またCGIぽんへのリンク（以下）部分も削除・変更しないでください。 # http://specters.net/cgipon/ # http://specters.net/cgipon/tengoku/info/ # http://specters.net/cgipon/tengoku/how2/ # # perlはversion5以上を使用してください。 # データファイルは何らかの事故により破壊されることがありますので常にバックアッ # プを取るよう心がけてください。 # # CGIぽん http://specters.net/cgipon/ 緒方哲治 cgipon@specters.net #========================================================================== # [ 環境設定 ] #========================================================================== $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); } if ($in{m} eq 'l') { $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_"; \n \n
[$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); } 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 $new $url
  $ico $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; }