#!/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;
s/&/&/g;
}
$sel .= qq(<SEL=$key[5];$thisfile?req=nam&sch=%5B$tnm%5D>$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;
s/&/&/g;
&REMOVE_EMOJI($_);
}
$body .= qq($hrbr$new$mnm$mtt$nam($tim)$br$mes$br);
if ($next) {
$sel .= qq(<SEL=41;$thisfile?sch=%5B$tnm-1%5D>$br);
$body .= qq(41⇒全て読む$br);
}
$max = $#mes - $vne * $in{pne};
if ($max - $vne > 1) {
$pne = $in{pne} + 1;
$sel .= qq(<SEL=$key[4];$thisfile?sch=%5B$tnm%5D&pne=$pne>$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;
s/&/&/g;
&REMOVE_EMOJI($_);
}
$body .= qq($hrbr$new$mnm$mtt$nam($tim)$br$mes$br);
if ($next) {
$sel .= qq(<SEL=$key;$thisfile?sch=%5B$tnm-$i%5D>$br);
$body .= qq($key⇒全て読む$br);
}
}
if ($#mes > $max) {
$pne = $in{pne} - 1;
$sel .= qq(<SEL=$key[6];$thisfile?sch=%5B$tnm%5D&pne=$pne>$br);
$body .= qq($hrbr$key[6]⇒[) . ($max + 1) . qq(]より後の記事$br);
}
$body .= qq($key[5]⇒このスレッドに返信$br);
$sel .= qq(<SEL=$key[2];$thisfile>$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;
s/&/&/g;
&REMOVE_EMOJI($_);
}
if ($prev--) {
$sel .= qq(<SEL=$key[4];$thisfile?sch=%5B$in{sct}-$in{scn}%5D&dvn=$prev>$br);
$body .= qq($key[4]⇒続き$br);
}
$body .= qq($new$mnm$mtt$nam($tim)$br$mes$br);
if ($next) {
$sel .= qq(<SEL=$key[6];$thisfile?sch=%5B$in{sct}-$in{scn}%5D&dvn=$next>$br);
$body .= qq($key[6]⇒続き$br);
}
}
$sel .= qq(<SEL=$key[2];$thisfile?sch=%5B$in{sct}%5D>$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(<SEL=$key[5];$thisfile?req=nam>$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(<SEL=$key[4];$thisfile?$query>$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;
s/&/&/g;
}
$sel .= qq(<SEL=$key;$thisfile?sch=%5B$tnm%5D>$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(<SEL=6;$thisfile?$query>$br);
$body .= qq($key[6]⇒前の$in{vnm}件);
if ($back) { $body .= qq($br); }
}
if ($back) {
$sel .= qq(<SEL=$key[2];$back>$br);
$body .= qq($key[2]⇒トップページ$br);
}
if ($back || ($in{pnm} < $pmx)) { $body .= qq($hrbr); }
$sel .= qq(<SEL=$key[9];$infourl>$br);
$body .= qq($key[9]⇒cgipon info$br);
}
#--------------------------------------------------------------------------
# [ ONC出力 ]
sub ONC_PRINT {
if (!$in{req}) {
$sel .= qq(<SEL=20;$thisfile?req=end>$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(<BODY=$in{coldef};bg=$in{colmbg}>\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(<HDML version=3.0 ttl=0 markable=true>);
print qq(<DISPLAY title="$in{bbstit}"><CENTER>$in{bbstit}$br);
&EXPAND_4M;
&jcode::z2h_sjis(\$body);
print $body;
print qq(</DISPLAY></HDML>);
}
#--------------------------------------------------------------------------
# [ HDML単一表示 ]
sub HDML_SINGLE {
print qq(<HDML version=3.0 ttl=0 markable=true>);
print qq(<DISPLAY title="$in{bbstit}"><CENTER>$in{bbstit}$br);
&SINGLE_4M;
&jcode::z2h_sjis(\$body);
print $body;
print qq(</DISPLAY></HDML>);
}
#--------------------------------------------------------------------------
# [ 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(<HDML version=3.0 ttl=0 markable=true>);
print qq(<NODISPLAY name=preset>);
print qq(<ACTION type=accept task=go dest=#index);
print qq( vars="nam=$nam&mal=$mal&tit=&mes=">);
print qq(</NODISPLAY>);
print qq(<CHOICE name=index>);
print qq(<CE task=go dest=#innam label="名前">名前:\$nam);
if ($in{ktimal}) {
print qq(<CE task=go dest=#inmal label="ﾒｰﾙ">ﾒｰﾙ :\$mal);
}
print qq(<CE task=go dest=#intit label="ﾀｲﾄﾙ">ﾀｲﾄﾙ:\$tit);
print qq(<CE task=go dest=#inmes label="内容">内容:\$mes);
print qq(<CE task=go dest="$thisfile");
print qq( postdata="nam=\$nam&mal=\$mal&tit=\$tit&mes=\$mes&cok=e">送信);
print qq(<CE task=go dest="$thisfile">戻る</CHOICE>);
print qq(<ENTRY name=innam key=nam default=\$nam>);
print qq(<ACTION type=accept task=go dest=#index>名前</ENTRY>);
if ($in{ktimal}) {
print qq(<ENTRY name=inmal key=mal default=\$mal>);
print qq(<ACTION type=accept task=go dest=#index);
print qq( emptyok=true format="*m">ﾒｰﾙ</ENTRY>);
}
print qq(<ENTRY name=intit key=tit default=\$tit>);
print qq(<ACTION type=accept task=go dest=#index emptyok=true>ﾀｲﾄﾙ</ENTRY>);
print qq(<ENTRY name=inmes key=mes default=\$mes>);
print qq(<ACTION type=accept task=go dest=#index>内容</ENTRY>);
print qq(</HDML>);
}
#--------------------------------------------------------------------------
# [ HDMLリスト ]
sub HDML_LIST {
$in{bbstit} =~ s/\$/&dol;/g;
print qq(<HDML version=3.0 ttl=0 markable=true>);
print qq(<CHOICE title="$in{bbstit}" method=alpha>);
print qq(<CENTER>$in{bbstit});
if ($hmsg) { print qq(<LINE>$hmsg<WRAP>); } else { print qq($br); }
print qq($hr<CE task=go dest="$thisfile?$reload&m=f">新規ﾃｰﾏ投稿);
if ($in{pnm} != 1) {
my($pnm) = $in{pnm} - 1;
$query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm);
print qq(<CE task=go dest="$thisfile?$query">次の$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(<CE task=go dest="$thisfile?$reload&sch=%5B$tnm%5D">);
$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(<CE task=go dest="$thisfile?$query">前の$in{vnm}件);
}
if ($back) {
print qq(<CE task=go dest="$back">ﾄｯﾌﾟﾍﾟｰｼﾞ);
}
print qq(<CE task=go dest="$infourl">cgipon info);
print qq(</CHOICE></HDML>);
}
#==========================================================================
# [ CHTML表示 ]
#==========================================================================
#--------------------------------------------------------------------------
# [ CHTML内容表示 ]
sub CHTML_EXPAND {
&EXPAND_4M;
}
#--------------------------------------------------------------------------
# [ CHTML単一表示 ]
sub CHTML_SINGLE {
&SINGLE_4M;
}
#--------------------------------------------------------------------------
# [ CHTMLフォーム ]
sub CHTML_FORM {
$body .= qq($hrbr<FORM action="$thisfile" method="$method">);
if ($in{sct}) {
$body .= qq(<INPUT type="hidden" name="sch" value="[$in{sct}]">);
}
$body .= qq(名前$br<INPUT type="text" name="nam" size=12>$br);
if ($in{ktimal}) {
$body .= qq(ﾒｰﾙ$br<INPUT type="text" name="mal" size=12 maxlength=64);
if ($mobile eq 'j') {
$body .= qq( value="\@jp-*.ne.jp" mode="alphabet");
} elsif ($mobile eq 'i') {
$body .= qq( value="\@docomo.ne.jp");
} elsif ($mobile eq 'd') {
$body .= qq( value="\@" astyle="3");
}
$body .= qq(>$br);
}
$body .= qq(ﾀｲﾄﾙ$br<INPUT type="text" name="tit" size=12>$br);
$body .= qq(内容$br<TEXTAREA name="mes" rows=4></TEXTAREA>$br);
$body .= qq(<INPUT type="submit" value="送信">$br);
$body .= qq(</FORM>);
if ($in{sct}) { $thisfile .= qq(?sch=%5B$in{sct}%5D); }
$body .= qq($hrbr$key[2]<A $href="$thisfile" $adkey=2$nnm>戻る</A>);
}
#--------------------------------------------------------------------------
# [ CHTMLリスト ]
sub CHTML_LIST {
if ($hmsg) { $body .= qq(<MARQUEE loop=4>$hmsg</MARQUEE>); }
$body .= qq($hr$key[5]<A $href="$thisfile?$reload&m=f" $adkey=5$nnm>);
$body .= qq(新規ﾃｰﾏ投稿</A>);
if ($in{pnm} != 1) {
my($pnm) = $in{pnm} - 1;
$query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm);
$body .= qq($br$key[6]<A $href="$thisfile?$query" $adkey=6$nnm>);
$body .= qq(次の$in{vnm}件</A>);
}
$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(<A $href="$thisfile?$reload&sch=%5B$tnm%5D">);
$ttt = qq(\[$tnm\]$ttt);
if ($#mes == 1) {
$body .= qq($new$threadicon$ttt($#mes件)</A>$nam $tim$br);
} else {
$body .= qq($new$threadicon$ttt($#mes件)</A>$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]<A $href="$thisfile?$query" $adkey=4$nnm>);
$body .= qq(前の$in{vnm}件</A>);
if ($back) { $body .= qq($br); }
}
if ($back) {
$body .= qq($key[2]<A $href="$back" $adkey=2$nnm>ﾄｯﾌﾟﾍﾟｰｼﾞ</A>);
}
if ($back || ($in{pnm} < $pmx)) { $body .= qq($hr); }
$body .= qq($key[9]<A $href="$infourl" $adkey=9$nnm>cgipon info</A>);
}
#--------------------------------------------------------------------------
# [ CHTML出力 ]
sub CHTML_PRINT {
&jcode::z2h_sjis(\$body);
$print = qq(<HTML><HEAD>);
$print .= $title;
$print .= qq(</HEAD>);
$print .= qq(<BODY bgcolor=$in{colmbg} text=$in{coldef} link=$in{colanc}>);
$print .= qq(<CENTER>$in{bbstit}</CENTER>);
$print .= $body;
$print .= qq(</BODY></HTML>);
$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]<A $href="$thisfile?$reload&m=f&sch=%5B$tnm%5D");
$body .= qq( $adkey=5$nnm>);
$body .= qq(このｽﾚｯﾄﾞに返信</A>$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)<BR>$mes$br);
if ($next) {
$body .= qq(<A $href="$thisfile?$reload&sch=%5B$tnm-1%5D">);
$body .= qq(全て読む</A>$br);
}
$max = $#mes - $vne * $in{pne};
if ($max - $vne > 1) {
$pne = $in{pne} + 1;
$body .= qq($hrbr$key[4]);
$body .= qq(<A $href="$thisfile?$reload&sch=%5B$tnm%5D&pne=$pne");
$body .= qq( $adkey=4$nnm>);
$body .= qq([$tnm-) . ($max - $vne) . qq(]より前の記事</A>$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)<BR>$mes$br);
if ($next) {
$body .= qq(<A $href="$thisfile?$reload&sch=%5B$tnm-$i%5D">);
$body .= qq(全て読む</A>$br);
}
}
if ($#mes > $max) {
$pne = $in{pne} - 1;
$body .= qq($hrbr$key[6]);
$body .= qq(<A $href="$thisfile?$reload&sch=%5B$tnm%5D&pne=$pne");
$body .= qq( $adkey=6$nnm>);
$body .= qq([$tnm-) . ($max + 1) . qq(]より後の記事</A>$br);
}
$body .= qq($hrbr$key[5]<A $href="$thisfile?$reload&m=f&sch=%5B$tnm%5D");
$body .= qq( $adkey=5$nnm>);
$body .= qq(このｽﾚｯﾄﾞに返信</A>$br);
$body .= qq($key[2]<A $href="$thisfile?$reload");
$body .= qq( $adkey=2$nnm>戻る</A>$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]<A $href="$thisfile?$reload&sch=%5B$in{sct}-$in{scn}%5D&dvn=$prev" $adkey=4$nnm>続き</A>$br);
}
$body .= qq($new$mnm$mtt$nam($tim)<BR>$mes$br);
if ($next) {
$body .= qq($key[6]<A $href="$thisfile?$reload&sch=%5B$in{sct}-$in{scn}%5D&dvn=$next" $adkey=6$nnm>続き</A>$br);
}
}
$body .= qq($hrbr$key[2]<A $href="$thisfile?$reload&sch=%5B$in{sct}%5D");
$body .= qq( $adkey=2$nnm>戻る</A>);
}
#--------------------------------------------------------------------------
# [ ログの展開 ]
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(<A $href="$mailto$mal">$nam</A>);
}
}
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(<IMG src="$in{imgfld}/$in{imgtit}" alt="$in{bbstit}"><BR><BR>);
} else {
$title = qq(<H1><FONT color="$in{colptt}">$in{bbstit}</FONT></H1>);
}
if ($in{hmsg_p}) {
$hmsg_p = $in{hmsg_p};
$hmsg_p =~s/<>/<BR>/g;
$hmsg_p =~s/</</g;
$hmsg_p =~s/>/>/g;
$hmsg_p =~s/&/&/g;
$hmsg_p = qq(<FONT size=2>$hmsg_p</FONT><BR>);
}
if (@msg) {
$msg = qq(<FONT color="$in{colsch}"><B>).join("<BR>",@msg).qq(</B></FONT>);
}
if ($in{m} eq 'p') {
$in{chrset} = "Shift_JIS";
}
print<<"_EOM_";
Content-type: text/html
<HTML lang=ja>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=$in{chrset}">
<META http-equiv="Content-Style-Type" content="text/css">
<TITLE>$in{bbstit}</TITLE>
<LINK rev="made" href="mailto:cgipon\@specters.net">
<STYLE type="text/css">
<!--
a { color:$in{colanc}; text-decoration:none; }
a:hover { color:$in{colhov}; text-decoration:underline; }
body { background:$in{colbak}$styleback; font-family:Osaka-等幅,ＭＳ ゴシック; }
-->
</STYLE>
</HEAD>
<BODY bgcolor="$in{colbak}"$bodyback text="$in{coldef}" link="$in{colanc}" alink="$in{colanc}" vlink="$in{colanc}">
<BASEFONT size=3 face="ＭＳ ゴシック">
<CENTER>
<P>
$title
$hmsg_p
$msg
</P>
_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([<A href="$in{back_p}">トップページ</A>]\n);
}
if ($in{edt} || $in{scn} || @scw) {
$lnk .= qq([<A href="$thisfile?t=0#form">新しい話題を書き込む！</A>]\n);
} elsif ($in{sct}) {
$lnk .= qq([<A href="#form">返信</A>]\n);
} else {
$lnk .= qq([<A href="#form">新しい話題を書き込む！</A>]\n);
}
if ($in{m} eq 'l') {
$lnk .= qq(<B>[タイトルリスト]</B>\n);
} else {
$lnk .= qq([<A href="$thisfile?m=l">タイトルリスト</A>]\n);
}
if ($in{m} eq 't') {
$lnk .= qq(<B>[話題別に見る]</B>\n);
} else {
$lnk .= qq([<A href="$thisfile?m=t">話題別に見る</A>]\n);
}
if (($in{m} eq 'e') && (!$frm{sch})) {
$lnk .= qq(<B>[内容を\読む]</B>\n);
} else {
$lnk .= qq([<A href="$thisfile?m=e">内容を\読む</A>]\n);
}
if ($in{m} eq 'h') {
$lnk .= qq(<B>[使い方]</B>\n);
} else {
$lnk .= qq([<A href="$thisfile?m=h">使い方</A>]\n);
}
if ($in{m} eq 'l') {
$lnk .= qq(<B>[ホームへ戻る]</B>\n);
} else {
$lnk .= qq([<A href="http://www.mmm878.com/jamy/">ホームへ戻る</A>]\n);
}
print<<"_EOM_";
<FONT size=2>
$lnk
</FONT>
_EOM_
if ($in{m} =~ /[ltes]/) {
print<<"_EOM_";
<FORM action="$thisfile" method="post">
<FONT size=2>
<INPUT type="hidden" name="cok" value="2">
<INPUT type="hidden" name="m" value="$in{m}">
<SELECT name="vn$in{m}">
_EOM_
foreach (@{$vnm{$in{m}}}) {
print qq( <OPTION value="$_");
if ($_ == $in{vnm}) { print qq( selected); }
print qq(>$_\n);
}
print<<"_EOM_";
</SELECT>件ずつ
<SELECT name="pnm">
_EOM_
for ($i = 1; $i <= $pmx; $i++) {
print qq( <OPTION value="$i");
if ($i == $in{pnm}) { print qq( selected); }
print qq(>$i\n);
}
print<<"_EOM_";
</SELECT>ページ目
<INPUT type="radio" name="aor" value="and" checked>and
<INPUT type="radio" name="aor" value="or">or
検索
<INPUT type="text" name="sch" value="$frm{sch}">
<INPUT type="submit" value="送信">
</FONT>
</FORM>
_EOM_
}
print qq(<HR width="$in{widtab}">\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_";
<CENTER>
<FONT size=2>
[<A href="$thisfile?$query">次の$in{vnm}件</A>>
</FONT>
</CENTER>
<HR width="$in{widtab}">
_EOM_
}
print qq(\n);
print<<"_EOM_";
<TABLE width="$in{widtab}"$tabbdr$coltab>
<TR style="background:$in{coltbg};">
<TD align="center">
<FONT size=2>タイトル</FONT>
</TD>
<TD align="center">
<FONT size=2>投稿者</FONT>
</TD>
<TD align="center">
<FONT size=2>投稿件数</FONT>
</TD>
<TD align="center">
<FONT size=2>最新投稿</FONT>
</TD>
</TR>
_EOM_
foreach (@log) {
local(@mes) = split(/<>/,$_);
local($tnm) = $mes[0];
local($ttt,$nam,$lst,$tim,$new);
&EXPAND_TITLE;
print<<"_EOM_";
<TR style="background:$in{coltbg};">
<TD>
<A href="$thisfile?sch=%5B$tnm%5D">
<FONT size=2>[$tnm]</FONT>
<FONT$siztxt color="$in{colttt}"><B>$ttt</B></FONT>
</A>
</TD>
<TD>
<FONT$siztxt color="$in{colnam}"><B>$nam</B></FONT>
</TD>
<TD>
<FONT size=2>$#mes件</FONT>
</TD>
<TD>
<FONT$siztxt color="$in{colnam}">$lst</FONT>
<FONT size=2 color="$in{coltim}">$tim</FONT>
$new
</TD>
</TR>
_EOM_
}
print qq(</TABLE>\n<BR>);
if ($in{pnm} < $pmx) {
my($pnm) = $in{pnm} + 1;
$query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm);
print<<"_EOM_";
<HR width="$in{widtab}">
<CENTER>
<FONT size=2>
<<A href="$thisfile?$query">前の$in{vnm}件</A>]
</FONT>
</CENTER>
_EOM_
}
print qq(<HR width="$in{widtab}">\n<BR>\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_";
<CENTER>
<FONT size=2>
[<A href="$thisfile?$query">次の$in{vnm}件</A>>
</FONT>
</CENTER>
<HR width="$in{widtab}">
_EOM_
}
foreach (@log) {
local(@mes) = split(/<>/,$_);
local($tnm) = $mes[0];
local($ttt,$nam,$lst,$tim,$new);
&EXPAND_TITLE;
print<<"_EOM_";
<TABLE width="$in{widtab}"$tabbdr$coltab cellpadding=4>
<TR style="background:$in{coltbg}">
<TD>
<A href="$thisfile?sch=%5B$tnm%5D"><FONT size=2>[$tnm]</FONT>
<FONT$siztxt color="$in{colttt}"><B>$ttt</B></FONT></A>
<FONT$siztxt color="$in{colnam}"><B>$nam</B></FONT>
<FONT size=2>- 最新投稿</FONT>
<FONT$siztxt color="$in{colnam}">$lst</FONT>
<FONT size=2 color="$in{coltim}">$tim</FONT>
$new
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>
_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_";
<A href="$thisfile?sch=%5B$tnm-$i%5D"><FONT size=2>[$tnm-$i] </FONT>
<FONT size=2 color="$in{colttt}">$mtt</FONT></A>
<FONT size=2 color="$in{colnam}">$nam</FONT>
<FONT size=2 color="$in{coltim}">$tim</FONT>
$new
<BR>
_EOM_
}
print qq( </TD>\n </TR>\n</TABLE>\n<BR>\n);
}
if ($in{pnm} < $pmx) {
my($pnm) = $in{pnm} + 1;
$query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm);
print<<"_EOM_";
<HR width="$in{widtab}">
<CENTER>
<FONT size=2>
<<A href="$thisfile?$query">前の$in{vnm}件</A>]
</FONT>
</CENTER>
_EOM_
}
print qq(<HR width="$in{widtab}">\n<BR>\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_";
<CENTER>
<FONT size=2>
[<A href="$thisfile?$query">次の$in{vnm}件</A>>
</FONT>
</CENTER>
<HR width="$in{widtab}">
_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(<DIV align="right"><FONT size=2>)
. qq(<A href="$thisfile?sch=%5B$tnm%5D">)
. qq(>> この話題[$tnm]に返信</A></FONT></DIV>);
$num = qq(<A href="$thisfile?sch=%5B$tnm%5D"><FONT size=2>)
. qq([$tnm]</FONT></A>);
} else {
$in{sct} = $tnm;
$num = qq(<FONT size=2>[$tnm]</FONT>);
}
print<<"_EOM_";
<TABLE width="$in{widtab}"$tabbdr$coltab cellpadding=4>
<TR style="background:$in{coltbg}">
<TD>
$num
<FONT$siztxt color="$in{colttt}"><B>$ttt</B></FONT>
<FONT$siztxt color="$in{colnam}"><B>$nam</B></FONT>
<FONT size=2>- 最新投稿</FONT>
<FONT$siztxt color="$in{colnam}">$lst</FONT>
<FONT size=2 color="$in{coltim}">$tim</FONT>
$new
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>
_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
<TABLE width=100% cellpadding=8>
<TR valign=top>
<TD colspan=2>
$ipa
$mnm
$mtt
$nam
$tim
$new
$url
<BR>
</TD>
</TR>
<TR valign=top>
<TD> $ico</TD>
<TD width=100%>$mes</TD>
</TR>
</TABLE>
_EOM_
$hrl = qq(<HR>);
}
print<<"_EOM_";
$lnk
</TD>
</TR>
</TABLE>
<BR>
_EOM_
}
if ($in{pnm} < $pmx) {
my($pnm) = $in{pnm} + 1;
$query = qq(m=$in{m}&vne=$in{vnm}&pnm=$pnm);
print<<"_EOM_";
<HR width="$in{widtab}">
<CENTER>
<FONT size=2>
<<A href="$thisfile?$query">前の$in{vnm}件</A>]
</FONT>
</CENTER>
_EOM_
}
print qq(<HR width="$in{widtab}">\n<BR>\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_";
<CENTER>
<FONT size=2>
[<A href="$thisfile?$query">次の$in{vnm}件</A>>
</FONT>
</CENTER>
<HR width="$in{widtab}">
_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(<FONT size=2 color="$in{coltim}">)
. qq(管理人により削除されました。</FONT>);
} elsif ((split(/>/,$_))[8] eq '&u;') {
$ico = '';
$mes = qq(<FONT size=2 color="$in{coltim}">)
. qq(投稿者により削除されました。</FONT>);
}
$lnk = qq(<DIV align="right"><FONT size=2>)
. qq(<A href="$thisfile?sch=%5B$tnm%5D">)
. qq(>> この話題[$tnm]を全て読む</A></FONT></DIV>);
print<<"_EOM_";
<TABLE width="$in{widtab}"$tabbdr$coltab cellpadding=4>
<TR style="background:$in{colmbg};">
<TD>
$ipa $mnm $mtt $nam $tim $new $url $edt<BR>
<TABLE width=100% cellpadding=4>
<TR valign=top>
<TD>$ico</TD>
<TD width=100%>$mes$lnk</TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE>
<BR>
_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_";
<HR width="$in{widtab}">
<CENTER>
<FONT size=2>
<<A href="$thisfile?$query">前の$in{vnm}件</A>]
</FONT>
</CENTER>
_EOM_
}
print qq(<HR width="$in{widtab}">\n<BR>\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(<FONT size=2>[$tnm-$num]</FONT>);
$mes =~ s/&br;/<BR>/g;
$mes =~ s/ / /g;
$mes =~ s/ ([^&])/ $1/g;
$mes =~ s/> /> /g;
if (@scw) {
foreach ($nam,$mtt,$mes) {
s/\x96/<FONT color="$in{colsch}"><B>/g;
s/\x97/<\/B><\/FONT>/g;
}
} elsif (!$in{scn}) {
$mnm = qq(<A href="$thisfile?sch=%5B$tnm-$i%5D">$mnm</A>);
}
&jcode::euc2sjis(\$mtt);
$mtt = qq(<FONT$siztxt color="$in{colttt}"><B>$mtt</B></FONT>);
&jcode::euc2sjis(\$nam);
if ($mal) { $nam = qq(<A href="mailto:$mal">$nam</A>); }
$nam = qq(<FONT$siztxt color="$in{colnam}"><B>$nam</B></FONT>);
if ($tim > time() - 60 * 60 * $in{newtim}) {
$new = $newicon;
} else {
$new = '';
}
if (!$key) {
$edt = qq(<FONT size=2>修正済み</FONT>);
} elsif ($tim + $in{edtlim} * 60 >= time()) {
if (!$in{edt}) {
$edt = qq(<FONT size=2>)
. qq(<A href="$thisfile?sch=%5B$tnm-$num%5D&edt=1">)
. qq(修正</A></FONT>);
}
} else {
$edt = qq(<FONT size=2>修正時間切れ</FONT>);
}
$tim = &GET_DATE($in{datefm},$tim);
$tim = qq(<FONT size=2 color="$in{coltim}">$tim</FONT>);
if ($url) {
if ($in{lnkimg}) {
$url = qq(<A href="http://$url" target="_blank">)
. qq(<IMG src="$in{imgfld}/$in{lnkimg}" border=0></A>);
} elsif ($in{lnktxt}) {
$url = qq(<FONT size=2>)
. qq([<A href="http://$url" target="_blank">$in{lnktxt}</A>])
. qq(</FONT>);
} else {
$url = qq(<FONT size=2>)
. qq([<A href="http://$url" target="_blank">http://$url</A>])
. qq(</FONT>);
}
}
if ($icons[0]) {
$ico ||= (split(/=/,$icons[0]))[0];
$ico = qq(<IMG src="$in{imgfld}/$ico">);
} else {
$ico = '';
}
if ($color[0]) {
$col ||= $color[0];
} else {
$col = $in{coldef};
}
$mes = &AUTO_LINK($mes);
&jcode::euc2sjis(\$mes);
$mes = qq(<FONT$siztxt color="$col">$mes</FONT>);
if ($rmh) { $ipa = qq($ipa($rmh)); }
$ipa = qq(<!-- $ipa -->);
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(<FONT size=2>); $ket = qq(</FONT>); }
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_";
<TABLE width="$in{widtab}"$tabbdr$coltab>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B>スレッド[$in{sct}]一括削除</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>
<CENTER>
<FORM action="$thisfile" method="post">
<INPUT type="hidden" name="m" value="$frm{m}">
<INPUT type="hidden" name="edt" value="2">
<INPUT type="hidden" name="sch" value="[$in{sct}]">
<INPUT type="checkbox" name="del">
<B>削除する</B>
<FONT size=2>管理者用パスワード</FONT>
<INPUT type="password" name="pky">
<INPUT type="submit" value="送信">
</CENTER>
</TD>
</TR>
</TABLE>
</FORM>
</CENTER>
</TD>
</TR>
</TABLE>
<HR width="$in{widtab}">
_EOM_
return;
} elsif ($in{edt}) {
$hid .= qq(<INPUT type="hidden" name="sch" value="[$in{sct}-$in{scn}]">\n);
$hid .= qq(<INPUT type="hidden" name="edt" value="$in{edt}">\n);
$del .= qq( <TR>\n <TD colspan=2>\n);
$del .= qq( <INPUT type="checkbox" name="del">\n);
$del .= qq( <B>削除する</B>\n);
if ($in{edt} == 2) {
$del .= qq( <FONT size=2>);
$del .= qq(管理者用パスワード</FONT>\n);
$del .= qq( <INPUT type="password" name="pky">\n);
}
$del .= qq( </TD>\n </TR>\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(<INPUT type="hidden" name="sch" value="[$in{sct}]">\n);
$hid .= qq(<INPUT type="hidden" name="cok" value="3">\n);
$ftt = qq(この話題[$in{sct}]に返信);
$btn = qq([$in{sct}] に返信);
} else {
$hid .= qq(<INPUT type="hidden" name="cok" value="3">);
$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( <TR>\n <TD>$bra<B>$in{iconam}</B>$ket</TD>\n);
if ($icons[0] =~ /=/) {
$ico .= qq( <TD>\n <SELECT name="ico">\n);
foreach (@icons) {
my($name,$value) = split(/=/,$_);
$ico .= qq( <OPTION value="$name");
if ($name eq $frm{ico}) { $ico .= qq( selected); $flag = 1; }
$ico .= qq(>$value\n);
}
if (!$flag) {
$ico .= qq( <OPTION value="$frm{ico}" selected>$frm{ico}\n);
}
$ico .= qq( </SELECT>\n </TD>\n </TR>\n);
} else {
$ico .= qq( <TD>\n <TABLE>\n <TR>\n);
foreach (@icons) {
($_) = split(/=/,$_);
$ico .= qq( <TD><IMG src="$in{imgfld}/$_"><BR>)
. qq(<INPUT type="radio" name="ico" value="$_");
if ($_ eq $frm{ico}) { $ico .= qq( checked); $flag = 1; }
$ico .= qq(></TD>\n);
}
if (!$flag) {
$ico .= qq( <TD><IMG src="$in{imgfld}/$frm{ico}"><BR>)
. qq(<INPUT type="radio" name="ico" value="$frm{ico}" checked>\n)
. qq(</TD>);
}
$ico .= qq( </TR>\n </TABLE>\n </TD>\n </TR>\n);
}
} elsif ($icons[0]) {
($frm{ico}) = split(/=/,$icons[0]);
$hid .= qq(<INPUT type="hidden" name="ico" value="$frm{ico}">);
}
$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( <TR>\n <TD>$bra<B> 色 </B>$ket</TD>\n);
if ($color[0] =~ /=/) {
$col .= qq( <TD>\n <SELECT name="col">\n);
foreach (@color) {
my($name,$value) = split(/=/,$_);
$col .= qq( <OPTION value="$name");
if ($name eq $frm{col}) { $col .= qq( selected); $flag = 1; }
$col .= qq(>$value\n);
}
if (!$flag) {
$col .= qq( <OPTION value="$frm{col}" selected>$frm{col}\n);
}
$col .= qq( </SELECT>\n </TD>\n </TR>\n);
} else {
$col .= qq( <TD>\n <TABLE>\n <TR>\n);
foreach (@color) {
s/=.*//;
$col .= qq( <TD><FONT size=2 color="$_">■)
. qq(</FONT><INPUT type="radio" name="col" value="$_");
if ($_ eq $frm{col}) { $col .= qq( checked); $flag = 1; }
$col .= qq(></TD>\n);
}
if (!$flag) {
$col .= qq( <TD>)
. qq(<FONT size=2 color="$frm{col}">■</FONT>)
. qq(<INPUT type="radio" name="col" value="$frm{col}" checked>)
. qq(</TD>\n);
}
$col .= qq( </TR>\n </TABLE>\n </TD>\n </TR>\n);
}
} elsif ($color[0]) {
($frm{col}) = split(/=/,$color[0]);
$hid .= qq(<INPUT type="hidden" name="col" value="$frm{col}">);
}
if ($in{fmsg_p}) {
$fmsg_p = $in{fmsg_p};
$fmsg_p =~s/<>/<\/LI>\n <LI>/g;
$fmsg_p =~s/</</g;
$fmsg_p =~s/>/>/g;
$fmsg_p =~s/&/&/g;
$fmsg_p=<<_EOM_
<TABLE>
<TR>
<TD>
<FONT size=2>
<UL>
<LI>$fmsg_p</LI>
</UL>
</FONT>
</TD>
</TR>
</TABLE>
_EOM_
}
print<<"_EOM_";
<TABLE width="$in{widtab}"$tabbdr$coltab>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B><A name="form"><SPAN style="color:$in{coldef};">$ftt</SPAN></A></B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>
<CENTER>
<FORM action="$thisfile" method="post">
<INPUT type="hidden" name="m" value="$frm{m}">
<INPUT type="hidden" name="vnl" value="$frm{vnl}">
<INPUT type="hidden" name="vnt" value="$frm{vnt}">
<INPUT type="hidden" name="vne" value="$frm{vne}">
$hid
<TABLE>
<TR>
<TD>$bra<B>名 前</B>$ket</TD>
<TD><INPUT type="text" name="nam" size=24 value="$frm{nam}"></TD>
</TR>
<TR>
<TD>$bra<B>メール</B>$ket</TD>
<TD><INPUT type="text" name="mal" size=24 value="$frm{mal}"></TD>
</TR>
<TR>
<TD>$bra<B>ＵＲＬ</B>$ket</TD>
<TD><INPUT type="text" name="url" size=48 value="http://$frm{url}"></TD>
</TR>
$ico
$col
<TR>
<TD>$bra<B>タイトル</B>$ket</TD>
<TD><INPUT type="text" name="tit" size=48 value="$frm{tit}"></TD>
</TR>
<TR>
<TD colspan=2>
<TEXTAREA name="mes" cols=50 rows=12>$frm{mes}</TEXTAREA>
</TD>
</TR>
$del
<TR>
<TD colspan=2>
<CENTER>
<INPUT type="submit" value="$btn">
<INPUT type="reset" value="書き直す">
</CENTER>
</TD>
</TR>
</TABLE>
</FORM>
$fmsg_p
</CENTER>
</TD>
</TR>
</TABLE>
<BR>
<HR width="$in{widtab}">
_EOM_
}
#--------------------------------------------------------------------------
# [ HTML使い方 ]
sub HTML_HOW2 {
my($bra,$ket,$coltab,$tabbdr);
if ($in{siztxt}) {
$bra = qq(\n <FONT size=2>);
$ket = qq(\n </FONT>);
}
if ($in{coltab}) {
$in{tabbdr} ||= 1;
$coltab = qq( bordercolor="$in{coltab}");
}
if ($in{tabbdr}) { $tabbdr = qq( border="$in{tabbdr}"); }
print<<"_EOM_";
<TABLE width="$in{widtab}">
<TR>
<TD>
<CENTER>
<TABLE$tabbdr$coltab>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B>書き込みルール</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>$bra
<UL>
<LI>HTMLタグは使えません。</LI>
<LI>URL、メールアドレスは自動的にリンクされます。</LI>
<LI>[123]と書くと、その番号のスレッドへリンクされます。</LI>
<LI>[12-3]と書くと、その番号の記事へリンクされます。</LI>
</UL>$ket
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B>検索方法</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>$bra
<UL>
<LI>過去の記事の検索ができます。</LI>
<LI>[123]と送信すれば、その番号のスレッドが読めます。</LI>
<LI>[12-3]と送信すれば、その番号の記事が読めます。</LI>
<LI>スペースで区切れば and検索 or検索 が可能\です。</LI>
</UL>$ket
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B>修正方法</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>$bra
<UL>
<LI>投稿してから$in{edtlim}分以内の記事を一度だけ修正/削除することができます。</LI>
<LI>修正したい記事を単独で表\示し、「修正」の文字をクリックすれば修正画面にいきます。</LI>
<LI>修正/削除できるのは投稿した（クッキーを受け取った）パソ\コンのみです。</LI>
</UL>$ket
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B>表\示モード</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>$bra
<UL>
<LI>
ページを開いたときの表\示モードを設定できます。<BR>
- <A href="$thisfile?m=l&cok=1">いつもタイトルリストモードで表\示する。</A><BR>
- <A href="$thisfile?m=t&cok=1">いつもスレッド一覧モードで表\示する。</A><BR>
- <A href="$thisfile?m=e&cok=1">いつも内容表\示モードで表\示する。</A>
</LI>
<LI>クッキーを受け取れるパソ\コンでのみ有効です。</LI>
<LI>お気に入り登録時の状況によって、正しく設定されないことがあります。</LI>
</UL>$ket
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>
<CENTER>
<B>モバイルアクセス</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD>$bra
<UL>
<LI>i-mode、EZweb、J-SKY、H"、ドットiに対応。</LI>
<LI>ケータイからも同じURLでアクセスできます。</LI>
<LI><A href="mailto:@?body=$thisfile">ケータイにURLを送る。</A></LI>
</UL>$ket
</TD>
</TR>
</TABLE>
</CENTER>
</TD>
</TR>
</TABLE>
<BR>
<HR width="$in{widtab}">$bra
さらに詳しく知りたい方は<A href="$how2url" target="_top">こちら</A>をご覧ください。$ket
<HR width="$in{widtab}">
_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(<IMG src="$def{imgfld}/$def{$_}">$def{$_});
$pre{$_} = $in{$_};
$pre{$_} &&= qq(<IMG src="$in{imgfld}/$in{$_}">$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(<FONT size=2 color="$def{$_}">■</FONT>$def{$_});
$pre{$_} = $in{$_};
$pre{$_} = qq(<FONT size=2 color="$pre{$_}">■</FONT>$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(<FONT size=2 color="$_">■</FONT>);
}
foreach (split(/<>/,$in{colm_p})) {
my($name,$value) = split(/=/,$_);
$pre{col} .= qq(<FONT size=2 color="$name">■</FONT>);
$txt{col} .= qq($_\n);
}
$txt{col} =~ s/"/"/g;
foreach (split(/<>/,$def{icon_p})) {
s/=.*//;
$def{ico} .= qq(<IMG src="$in{imgfld}/$_"> );
}
foreach (split(/<>/,$in{icon_p})) {
my($name,$value) = split(/=/,$_);
$pre{ico} .= qq(<IMG src="$in{imgfld}/$name"> );
$txt{ico} .= qq($_\n);
}
$txt{ico} =~ s/"/"/g;
foreach (qw(hmsg_p fmsg_p)) {
$def{$_} =~ s/<>/<BR>/g;
$def{$_} =~ s/</</g;
$def{$_} =~ s/>/>/g;
$def{$_} =~ s/&/&/g;
$pre{$_} = $in{$_};
$pre{$_} =~ s/<>/<BR>/g;
$pre{$_} =~ s/</</g;
$pre{$_} =~ s/>/>/g;
$pre{$_} =~ s/&/&/g;
$txt{$_} =~ s/<>/\n/g;
}
print<<"_EOM_";
<FORM action="$thisfile" method="post">
<INPUT type="hidden" name="m" value="p">
<INPUT type="hidden" name="pky" value="$in{pky}">
<INPUT type="hidden" name="set" value="1">
<TABLE width="$in{widtab}"$tabbdr$coltab>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>基本設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>掲示板の名前</B></TD>
<TD>$def{bbstit}</TD>
<TD>$pre{bbstit}</TD>
<TD><INPUT type="text" name="bbstit" value="$txt{bbstit}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>管理人の名前</B></TD>
<TD>$def{admnam}</TD>
<TD>$pre{admnam}</TD>
<TD><INPUT type="text" name="admnam" value="$txt{admnam}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>管理人のメールアドレス</B></TD>
<TD>$def{admmal}</TD>
<TD>$pre{admmal}</TD>
<TD><INPUT type="text" name="admmal" value="$txt{admmal}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ログファイルの最大サイズ</B></TD>
<TD>$def{logmax}</TD>
<TD>$pre{logmax}</TD>
<TD><INPUT type="text" name="logmax" value="$txt{logmax}">KB</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>デフォルトモード</B></TD>
<TD colspan=3>
<INPUT type="radio" name="defmod" value="l"$defmod{l}>タイトルリスト
<INPUT type="radio" name="defmod" value="t"$defmod{t}>スレッド一覧
<INPUT type="radio" name="defmod" value="e"$defmod{e}>内容表\示
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>修正可能\時間</B></TD>
<TD>$def{edtlim}</TD>
<TD>$pre{edtlim}</TD>
<TD><INPUT type="text" name="edtlim" value="$txt{edtlim}">分</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>URL設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ドットiのトップページ</B></TD>
<TD>$def{back_d}</TD>
<TD>$pre{back_d}</TD>
<TD><INPUT type="text" name="back_d" value="$txt{back_d}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>EZwebのトップページ</B></TD>
<TD>$def{back_e}</TD>
<TD>$pre{back_e}</TD>
<TD><INPUT type="text" name="back_e" value="$txt{back_e}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>H"のトップページ</B></TD>
<TD>$def{back_h}</TD>
<TD>$pre{back_h}</TD>
<TD><INPUT type="text" name="back_h" value="$txt{back_h}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>i-modeのトップページ</B></TD>
<TD>$def{back_i}</TD>
<TD>$pre{back_i}</TD>
<TD><INPUT type="text" name="back_i" value="$txt{back_i}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>J-SKYのトップページ</B></TD>
<TD>$def{back_j}</TD>
<TD>$pre{back_j}</TD>
<TD><INPUT type="text" name="back_j" value="$txt{back_j}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>PCのトップページ</B></TD>
<TD>$def{back_p}</TD>
<TD>$pre{back_p}</TD>
<TD><INPUT type="text" name="back_p" value="$txt{back_p}"></TD>
</TR>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>デザイン・画像設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>画像フォルダ</B></TD>
<TD>$def{imgfld}</TD>
<TD>$pre{imgfld}</TD>
<TD><INPUT type="text" name="imgfld" value="$txt{imgfld}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>タイトル画像</B></TD>
<TD>$def{imgtit}</TD>
<TD>$pre{imgtit}</TD>
<TD><INPUT type="text" name="imgtit" value="$txt{imgtit}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>背景画像</B></TD>
<TD>$def{imgbak}</TD>
<TD>$pre{imgbak}</TD>
<TD><INPUT type="text" name="imgbak" value="$txt{imgbak}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>リンク画像</B></TD>
<TD>$def{lnkimg}</TD>
<TD>$pre{lnkimg}</TD>
<TD><INPUT type="text" name="lnkimg" value="$txt{lnkimg}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>リンクテキスト</B></TD>
<TD>$def{lnktxt}</TD>
<TD>$pre{lnktxt}</TD>
<TD><INPUT type="text" name="lnktxt" value="$txt{lnktxt}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>アイコンの名前</B></TD>
<TD>$def{iconam}</TD>
<TD>$pre{iconam}</TD>
<TD><INPUT type="text" name="iconam" value="$txt{iconam}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ドットi用のアイコン</B></TD>
<TD>$def{icon_d}</TD>
<TD>$pre{icon_d}</TD>
<TD><INPUT type="text" name="icon_d" value="$txt{icon_d}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>EZweb用のアイコン</B></TD>
<TD>$def{icon_e}</TD>
<TD>$pre{icon_e}</TD>
<TD><INPUT type="text" name="icon_e" value="$txt{icon_e}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>H"用のアイコン</B></TD>
<TD>$def{icon_h}</TD>
<TD>$pre{icon_h}</TD>
<TD><INPUT type="text" name="icon_h" value="$txt{icon_h}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>i-mode用のアイコン</B></TD>
<TD>$def{icon_i}</TD>
<TD>$pre{icon_i}</TD>
<TD><INPUT type="text" name="icon_i" value="$txt{icon_i}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>J-SKY用のアイコン</B></TD>
<TD>$def{icon_j}</TD>
<TD>$pre{icon_j}</TD>
<TD><INPUT type="text" name="icon_j" value="$txt{icon_j}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD rowspan=3><B>PC用のアイコン</B></TD>
<TD colspan=3>初期設定<BR>$def{ico}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>現在の設定<BR>$pre{ico}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>
<TEXTAREA name="icon_p" cols=32 rows=8>$txt{ico}</TEXTAREA>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>投稿時間表\示</B></TD>
<TD>$def{datefm}</TD>
<TD>$pre{datefm}</TD>
<TD><INPUT type="text" name="datefm" value="$txt{datefm}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>newマークを付ける時間</B></TD>
<TD>$def{newtim}</TD>
<TD>$pre{newtim}</TD>
<TD><INPUT type="text" name="newtim" value="$txt{newtim}">時間</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>テキストサイズ</B></TD>
<TD colspan=3>
<INPUT type="radio" name="siztxt" value="0"$siztxt[0]>大
<INPUT type="radio" name="siztxt" value="1"$siztxt[1]>小
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ページ幅</B></TD>
<TD>$def{widtab}</TD>
<TD>$pre{widtab}</TD>
<TD><INPUT type="text" name="widtab" value="$txt{widtab}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>テーブル枠線の太さ</B></TD>
<TD>$def{tabbdr}</TD>
<TD>$pre{tabbdr}</TD>
<TD><INPUT type="text" name="tabbdr" value="$txt{tabbdr}"></TD>
</TR>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>色設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ページ背景色</B></TD>
<TD>$def{colbak}</TD>
<TD>$pre{colbak}</TD>
<TD><INPUT type="text" name="colbak" value="$txt{colbak}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>デフォルト文字色</B></TD>
<TD>$def{coldef}</TD>
<TD>$pre{coldef}</TD>
<TD><INPUT type="text" name="coldef" value="$txt{coldef}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ページタイトル文字色</B></TD>
<TD>$def{colptt}</TD>
<TD>$pre{colptt}</TD>
<TD><INPUT type="text" name="colptt" value="$txt{colptt}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>スレッドタイトル背景色</B></TD>
<TD>$def{coltbg}</TD>
<TD>$pre{coltbg}</TD>
<TD><INPUT type="text" name="coltbg" value="$txt{coltbg}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>メッセージタイトル文字色</B></TD>
<TD>$def{colttt}</TD>
<TD>$pre{colttt}</TD>
<TD><INPUT type="text" name="colttt" value="$txt{colttt}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>メッセージ背景色</B></TD>
<TD>$def{colmbg}</TD>
<TD>$pre{colmbg}</TD>
<TD><INPUT type="text" name="colmbg" value="$txt{colmbg}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>アンカー文字色</B></TD>
<TD>$def{colanc}</TD>
<TD>$pre{colanc}</TD>
<TD><INPUT type="text" name="colanc" value="$txt{colanc}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>アンカーポイント時文字色</B></TD>
<TD>$def{colhov}</TD>
<TD>$pre{colhov}</TD>
<TD><INPUT type="text" name="colhov" value="$txt{colhov}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>投稿者名文字色</B></TD>
<TD>$def{colnam}</TD>
<TD>$pre{colnam}</TD>
<TD><INPUT type="text" name="colnam" value="$txt{colnam}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>投稿時間文字色</B></TD>
<TD>$def{coltim}</TD>
<TD>$pre{coltim}</TD>
<TD><INPUT type="text" name="coltim" value="$txt{coltim}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>被検索語文字色</B></TD>
<TD>$def{colsch}</TD>
<TD>$pre{colsch}</TD>
<TD><INPUT type="text" name="colsch" value="$txt{colsch}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ドットi投稿の文字色</B></TD>
<TD>$def{colm_d}</TD>
<TD>$pre{colm_d}</TD>
<TD><INPUT type="text" name="colm_d" value="$txt{colm_d}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>EZweb投稿の文字色</B></TD>
<TD>$def{colm_e}</TD>
<TD>$pre{colm_e}</TD>
<TD><INPUT type="text" name="colm_e" value="$txt{colm_e}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>H"投稿の文字色</B></TD>
<TD>$def{colm_h}</TD>
<TD>$pre{colm_h}</TD>
<TD><INPUT type="text" name="colm_h" value="$txt{colm_h}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>i-mode投稿の文字色</B></TD>
<TD>$def{colm_i}</TD>
<TD>$pre{colm_i}</TD>
<TD><INPUT type="text" name="colm_i" value="$txt{colm_i}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>J-SKY投稿の文字色</B></TD>
<TD>$def{colm_j}</TD>
<TD>$pre{colm_j}</TD>
<TD><INPUT type="text" name="colm_j" value="$txt{colm_j}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD rowspan=3><B>PC投稿の文字色</B></TD>
<TD colspan=3>初期設定<BR>$def{col}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>現在の設定<BR>$pre{col}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>
<TEXTAREA name="colm_p" cols=32 rows=8>$txt{col}</TEXTAREA>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>テーブル枠線の色</B></TD>
<TD>$def{coltab}</TD>
<TD>$pre{coltab}</TD>
<TD><INPUT type="text" name="coltab" value="$txt{coltab}"></TD>
</TR>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>文字設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>ドットiのタイトル下コメント</B></TD>
<TD>$def{hmsg_d}</TD>
<TD>$pre{hmsg_d}</TD>
<TD><INPUT type="text" name="hmsg_d" value="$txt{hmsg_d}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>EZwebのタイトル下コメント</B></TD>
<TD>$def{hmsg_e}</TD>
<TD>$pre{hmsg_e}</TD>
<TD><INPUT type="text" name="hmsg_e" value="$txt{hmsg_e}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>H"のタイトル下コメント</B></TD>
<TD>$def{hmsg_h}</TD>
<TD>$pre{hmsg_h}</TD>
<TD><INPUT type="text" name="hmsg_h" value="$txt{hmsg_h}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>i-modeのタイトル下コメント</B></TD>
<TD>$def{hmsg_i}</TD>
<TD>$pre{hmsg_i}</TD>
<TD><INPUT type="text" name="hmsg_i" value="$txt{hmsg_i}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>J-SKYのタイトル下コメント</B></TD>
<TD>$def{hmsg_j}</TD>
<TD>$pre{hmsg_j}</TD>
<TD><INPUT type="text" name="hmsg_j" value="$txt{hmsg_j}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD rowspan=3><B>PCのタイトル下コメント</B></TD>
<TD colspan=3>初期設定<BR>$def{hmsg_p}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>現在の設定<BR>$pre{hmsg_p}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>
<TEXTAREA name="hmsg_p" cols=32 rows=8>$txt{hmsg_p}</TEXTAREA>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD rowspan=3><B>PCのフォーム下コメント</B></TD>
<TD colspan=3>初期設定<BR>$def{fmsg_p}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>現在の設定<BR>$pre{fmsg_p}</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD colspan=3>
<TEXTAREA name="fmsg_p" cols=32 rows=8>$txt{fmsg_p}</TEXTAREA>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>ケータイ入出力設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>メールアドレスの入力</B></TD>
<TD colspan=3>
<INPUT type="radio" name="ktimal" value="0"$ktimal[0]>なし
<INPUT type="radio" name="ktimal" value="1"$ktimal[1]>あり
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>メールアドレスの出力</B></TD>
<TD colspan=3>
<INPUT type="radio" name="ktomal" value="0"$ktomal[0]>なし（完全消去）<BR>
<INPUT type="radio" name="ktomal" value="1"$ktomal[1]>あり<BR>
<INPUT type="radio" name="ktomal" value="2"$ktomal[2]>投稿者メールアドレスリンク<BR>
<INPUT type="radio" name="ktomal" value="3"$ktomal[3]>本文メールアドレスリンク<BR>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>電話番号の出力</B></TD>
<TD colspan=3>
<INPUT type="radio" name="ktotel" value="0"$ktotel[0]>消去する<BR>
<INPUT type="radio" name="ktotel" value="1"$ktotel[1]>消去しない<BR>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>絵文字の出力</B></TD>
<TD colspan=3>
<INPUT type="radio" name="ktoemg" value="0"$ktoemg[0]>なし（完全消去）<BR>
<INPUT type="radio" name="ktoemg" value="1"$ktoemg[1]>あり（表\示可能\端末のみ）<BR>
</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>H"の入力方式</B></TD>
<TD colspan=3>
<INPUT type="radio" name="ktioff" value="0"$ktioff[0]>オンライン<BR>
<INPUT type="radio" name="ktioff" value="1"$ktioff[1]>オフライン（内容入力時に一旦回線が切れます）<BR>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>sendmail設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>sendmailのパス</B></TD>
<TD>$def{mlpath}</TD>
<TD>$pre{mlpath}</TD>
<TD><INPUT type="text" name="mlpath" value="$txt{mlpath}"></TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>送信先メールアドレス</B></TD>
<TD>$def{mailto}</TD>
<TD>$pre{mailto}</TD>
<TD><INPUT type="text" name="mailto" value="$txt{mailto}"></TD>
</TR>
_EOM_
if (-r $countia) {
print<<"_EOM_";
<TR style="background:$in{coltbg};">
<TD colspan=4>
<CENTER>
<B>COUNTIA設定</B>
</CENTER>
</TD>
</TR>
<TR style="background:$in{coltbg};">
<TD>設定名</TD>
<TD>初期設定</TD>
<TD>現在の設定</TD>
<TD>変更欄</TD>
</TR>
<TR style="background:$in{colmbg};">
<TD><B>アクセスログ</B></TD>
<TD colspan=3>
<INPUT type="radio" name="logcia" value="0"$logcia[0]>取らない<BR>
<INPUT type="radio" name="logcia" value="1"$logcia[1]>取る<BR>
</TD>
</TR>
_EOM_
}
print<<"_EOM_";
<TR>
<TD colspan=4>
<CENTER>
<INPUT type="submit" value="送信する">
<INPUT type="reset" value="リセット">
</CENTER>
</TD>
</TR>
</TABLE>
</FORM>
<HR width="$in{widtab}">
_EOM_
} else {
print<<"_EOM_";
<FORM action="$thisfile" method="post">
<INPUT type="hidden" name="m" value="p">
<FONT size=2>管理者用パスワード</FONT>
<INPUT type="password" name="pky">
<INPUT type="submit" value="送信">
</FORM>
<HR width="$in{widtab}">
_EOM_
}
}
#--------------------------------------------------------------------------
# [ HTMLフッタ ] # 著作権情報の部分は書き換えないでください。
sub HTML_FOOTER {
my($tim,$adm,$nam);
$tim = qq([) . &GET_DATE() . qq(] $in{bbstit}\n);
if ($in{sct} && !$in{scn}) {
$adm = qq(<A href="$thisfile?sch=%5B$in{sct}%5D&edt=2">)
. qq(<FONT color="$in{coldef}" style="text-decoration:none;">)
. qq(管理人</FONT></A>\n);
} elsif ($in{scn} && !$in{edt}) {
$adm = qq(<A href="$thisfile?sch=%5B$in{sct}-$in{scn}%5D&edt=2">)
. qq(<FONT color="$in{coldef}" style="text-decoration:none;">)
. qq(管理人</FONT></A>\n);
} else {
$adm = qq(<A href="$thisfile?m=p">)
. qq(<FONT color="$in{coldef}" style="text-decoration:none;">)
. qq(管理人</FONT></A>\n);
}
$nam = qq(<A href="mailto:$in{admmal}?subject=$in{bbstit}">)
. qq($in{admnam}</A><BR>\n);
$cpr = qq(<A href="http://specters.net/cgipon/" target="_top">)
. qq($scriptname</A> $version\n);
print<<"_EOM_";
<TABLE width="$in{widtab}">
<TR>
<TD align="right">
<FONT size=2>$tim$adm$nam$cpr</FONT>
</TD>
</TR>
</TABLE>
</CENTER>
</BASEFONT>
</BODY>
</HTML>
_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 (<OPT>) {
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(<HR>);
$br = qq(<BR>);
$hrbr = $hr;
$href = 'href';
$mailto = 'mailto:';
if ($ua[1] <= 2) {
$method = 'get';
} else {
$method = 'post';
$title = qq(<TITLE>$in{bbstit}</TITLE>);
@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(<HR>);
$br = qq(<BR>);
$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(<TITLE>$in{bbstit}</TITLE>);
$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(<BR>);
$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(<IMG icon=lightbulb>);
$threadicon = qq(<IMG icon=book1>);
$arrowicon = qq(<IMG icon=leftarrow1>);
$in{datefm} = qq(M/d HH:mm);
}
elsif ($ua[0] eq 'ASTEL') {
$mobile = 'd';
$adkey = 'accesskey';
$imgext = '.gif';
$hr = qq(<HR>);
$br = qq(<BR>);
$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(<TITLE>$in{bbstit}</TITLE>);
$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(<HR>);
$br = qq(<BR>);
$href = 'href';
$mailto = 'mailto:';
$newicon = qq(<FONT size=2 color="$in{colsch}">new</FONT>);
}
}
#--------------------------------------------------------------------------
# [ データのチェック ]
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(/<>/,<OLD>);
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 (<OLD>) {
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 (<OLD>) {
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 (<OLD>) {
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("ログファイルが開けません。");
<LOG>;
if ($in{sch}) {
if ($in{sct}) {
$in{vnm} = 1;
while (<LOG>) {
$pnm++;
if ($in{sct} == (split(/<>/,$_))[0]) {
push (@log,$_);
last;
}
}
while (<LOG>) { $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 (<LOG>) {
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 (<LOG>) {
$dnm++;
if (push (@log,$_) == $in{vnm} + 1) {
if (++$pnm == $in{pnm}) { last; }
splice(@log,0,$in{vnm});
}
}
splice(@log,$in{vnm});
while (<LOG>) { $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 =~ 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 =~ s/>/>/g;
$str =~ tr/\t/ /;
return $str;
}
#--------------------------------------------------------------------------
# [ オートリンク ]
sub AUTO_LINK {
# +?.*^$()[{|\
# s?https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+
$str = $_[0];
$str =~ s/(https?:\/\/[\w\+\?\.\/\-~&=:@%;,#]+)
/<A href=\"$1\" target=\"_blank\">$1<\/A>/giox;
$str =~ s/(ftp:\/\/[\w\+\?\.\/\-~&=:@%;,]+)
/<A href=\"$1\" target=\"_blank\">$1<\/A>/giox;
$str =~ s/([\w\.\-]+)\@([\w\.\-]+)
/<A href=\"mailto\:$1\@$2\">$1\@$2<\/A>/giox;
$str =~ s/\[(\d+)(-\d+)?\]
/<A href=\"$thisfile\?sch=%5B$1$2\%5D\">\[$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\.\-]+)
/<A href=\"mailto\:$1\@$2\">$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;
$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;
$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(<A href="http://specters.net/cgipon/">$scriptname</A>)
. qq( $version\n);
print<<"_EOM_";
Content-type: text/html
<HTML>
<BODY bgcolor="#ffffff">
<H3 style="color:#cc0000;background:#eeeeee;text-align:center;">
<B>エラー</B>
</H3>
<H4 style="text-align:center;">$_[0]<H4>
<HR>
$cpr
</BODY>
</HTML>
_EOM_
exit;
}