new file: @hi-ho/bbs.cgi
new file: @hi-ho/getlog.cgi new file: [1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/bbscgi.txt new file: [1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/getlogcgi.txt new file: [1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/locationcgi.txt new file: [1999-05-04 - present] REMIX/bbs.txt new file: [1999-05-04 - present] REMIX/getlog_m.txt new file: [1999-05-04 - present] REMIX/jcode.txt new file: [1999-05-04 - present] REMIX/location.txt new file: [1999-05-04 - present] REMIX/loveyou.dat new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/bbs.txt new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/count0.txt new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/delete.txt new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/getlog.txt new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/jcode.txt new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/location.txt new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/loveyou.dat new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/readme.html new file: [1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/update.html new file: [1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/bbs.cgi new file: [1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/getlog_m.cgi new file: [1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/jcode.pl new file: [1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/list.cgi new file: [1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/loveyou.dat new file: [1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/readme.txt new file: source.txt
This commit is contained in:
parent
f3adb72feb
commit
dce359389d
947
@hi-ho/bbs.cgi
Normal file
947
@hi-ho/bbs.cgi
Normal file
|
|
@ -0,0 +1,947 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#----------------#
|
||||
# 初期設定 #
|
||||
#----------------#
|
||||
|
||||
|
||||
# 掲示板の名前 --------------------------
|
||||
|
||||
|
||||
$title = 'あやしいわーるど＠はいほー';
|
||||
|
||||
# 文字色や背景などの設定
|
||||
|
||||
# body部
|
||||
|
||||
$bgc = '004040';
|
||||
|
||||
$textc = 'ffffff';
|
||||
|
||||
$linkc = 'eeffee';
|
||||
|
||||
$vlinkc = 'dddddd';
|
||||
|
||||
$alinkc = 'ff0000';
|
||||
|
||||
# 題名の色
|
||||
|
||||
$subjc = 'ffffee';
|
||||
|
||||
# --- 表示件数 --------------------------------------------
|
||||
# １ページに表示する件数のデフォルト値
|
||||
$def = 30;
|
||||
# １ページに表示する件数の最小値
|
||||
$defmin = 0;
|
||||
# この件数以上でリロード／書き込みしたときには次はこの件数にする。
|
||||
$defmax =300;
|
||||
|
||||
# --- ＵＲＬ ----------------------------------------------
|
||||
# このスクリプト
|
||||
$cgiurl = 'bbs.cgi';
|
||||
|
||||
|
||||
# 連絡先
|
||||
$mailadd = 'goodby@strangers.com';
|
||||
|
||||
# ログのＵＲＬ
|
||||
$loglog0 = 'log';
|
||||
$loglog1 = 'http://';
|
||||
|
||||
# ---------------------------------------- 書き込みチェック ----------------------------------------
|
||||
# 管理人名前チェック・メールアドレス・パスワード
|
||||
$namez = 'しば';
|
||||
$pass = 'chiba';
|
||||
# 書き込み最大量
|
||||
$maxlength = 1024*16;
|
||||
#投稿内容文字数
|
||||
$max_v = 8000;
|
||||
#投稿内容行数（上の文字数との兼ね合いを考えて）
|
||||
$max_line = 120;
|
||||
|
||||
# 二重書き込みチェック件数
|
||||
$check = 10;
|
||||
# 二重書き込みチェックバイト数
|
||||
$checklength = 10;
|
||||
# 書き込み件数の最大登録数の設定
|
||||
$max = '300';
|
||||
|
||||
# ------------------------------------ ディレクトリ・ファイル名 ------------------------------------
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
# 内容が書き込まれる記録ファイルのパスを設定
|
||||
$file = './loveyou.dat';
|
||||
# 別途とるログのファイル名先頭文字・拡張子の指定
|
||||
$logfile = "./log/";
|
||||
$logfiledat = ".html";
|
||||
|
||||
# -------------------------------------------- カウンタ --------------------------------------------
|
||||
# カウンタプラス値
|
||||
$countplus = "";
|
||||
# カウンタ開始日
|
||||
$countdate = '99/6/20';
|
||||
# カウンタファイルの先頭文字・拡張子の指定
|
||||
$countfile = './count/count';
|
||||
$countfiledat = '.txt';
|
||||
# カウンタ強度（０のときは使用しない）
|
||||
$countlevel = 3;
|
||||
|
||||
# --------------------------------------------- その他 ---------------------------------------------
|
||||
# 時差
|
||||
$tim =0*3600;
|
||||
# 入力形式の設定
|
||||
$method = 'post';
|
||||
|
||||
|
||||
# 時刻処理
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time + $tim );
|
||||
$month = ($mon + 1);
|
||||
|
||||
# 時刻のゼロサプレス
|
||||
if ($month < 10) { $month = "0$month"; }
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($sec < 10) { $sec = "0$sec"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
|
||||
# 曜日変換処理
|
||||
$y0="日"; $y1="月"; $y2="火"; $y3="水"; $y4="木"; $y5="金"; $y6="土";
|
||||
$youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6) [$wday];
|
||||
|
||||
# 時刻フォーマット
|
||||
$date_now = "$month月$mday日($youbi)$hour時$min分$sec秒";
|
||||
# ログファイル名取得
|
||||
$filedate = "$logfile$year$month$mday$logfiledat";
|
||||
# よくわからない変数
|
||||
$gesu = $ENV{'REMOTE_PORT'};
|
||||
# 投稿時のaction名
|
||||
$action = "regist";
|
||||
|
||||
# 追加対策 -------------------------------
|
||||
|
||||
# 外部投稿防止コード
|
||||
$protect_a = 9987; # 4桁
|
||||
$protect_b = 55; # 2桁
|
||||
$protect_c = 112; # 3桁
|
||||
|
||||
# 過去ログの最大ファイルサイズ
|
||||
$maxoldlogsize = 3 * 1024 * 1024; # 3MB
|
||||
|
||||
###########################################################################################
|
||||
|
||||
# フォーム入力されたデータを$bufferに格納する（getかpostかによって取得方法が異なる）
|
||||
#if ($ENV{'REQUEST_METHOD'} eq "POST" && $ENV{'CONTENT_LENGTH'} < $maxlength) { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
#else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
if ($ENV{'CONTENT_LENGTH'} > $maxlength) {&error(5);}
|
||||
|
||||
# $bufferに格納されたFORM形式のデータを取り出す
|
||||
@pairs = split(/&/,$buffer);
|
||||
foreach $pair (@pairs) {
|
||||
|
||||
($name, $value) = split(/=/, $pair);
|
||||
$value =~ tr/+/ /;
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
|
||||
# 記録するデータはsjis
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
|
||||
#改行連打のいたずらを回避（３行以上何も書かずに改行のみの部分は改行無視）
|
||||
#スペース＋改行の連打を回避（上記を回避するためにスペースをいれて改行する悪戯の場合）
|
||||
if ($value =~ /\r\n/) { $value =~ s/\r\n/\r/g; }
|
||||
if ($value =~ /\n/) { $value =~ s/\n/\r/g; }
|
||||
|
||||
if ($value =~ / \r \r/) { $value =~ s/ \r \r//g; }
|
||||
if ($value =~ /\ \r\ \r/) { $value =~ s/\ \r\ \r//g; }
|
||||
if ($value =~ / \r/) { $value =~ s/ \r/\r/g; }
|
||||
if ($value =~ /\ \r/) { $value =~ s/\ \r/\r/g; }
|
||||
if ($value =~ /\r\r\r\r/) { $value =~ s/\r\r\r\r//g; }
|
||||
|
||||
|
||||
# 処理の都合上の処理
|
||||
$value =~ s/\n//g; # 改行文字は消去
|
||||
|
||||
if ($name eq 'value') { $value =~ s/&/&\;/g; $value =~ s/\,/\0/g; }
|
||||
elsif ($name ne 'page' && $name ne 'image') { $value =~ s/\,//g; $value =~ s/\;//g; $value =~ s/\://g; $value =~ s/\=//g; }
|
||||
|
||||
else { $value =~ s/\,//g; }
|
||||
|
||||
$value =~ s/</<\;/g; $value =~ s/>/>\;/g;
|
||||
|
||||
$FORM{$name} = $value;
|
||||
}
|
||||
|
||||
|
||||
# 表示ページ数の決定 ##################################################
|
||||
if ($FORM{'def'} ne '') { $def = $FORM{'def'}; }
|
||||
if ($def < $defmin) { $def = $defmin;}
|
||||
$defnext = $def;
|
||||
if ($defnext > $defmax) {$defnext = $defmax;}
|
||||
|
||||
# 表示色の決定 ########################################################
|
||||
if ($FORM{'bgcolor'} ne '') { $bgc = $FORM{'bgcolor'}; }
|
||||
$body = "<body bgcolor=\"#$bgc\" text=\"#$textc\" link=\"#$linkc\" vlink=\"#$vlinkc\" alink=\"#$alinkc\">";
|
||||
|
||||
# ポップアップウインドウの決定 ########################################################
|
||||
|
||||
#if ($FORM{'image'} eq '') { $checked1='checked'; }
|
||||
#if ($FORM{'image'} eq '2') { $checked2='checked'; }
|
||||
|
||||
#if ($FORM{'himage'} eq '') { $himage=''; }
|
||||
#if ($FORM{'himage'} eq '2'){ $link='$sec$min'; }
|
||||
|
||||
|
||||
# 全体の流れを決定する（actionやpwdはフォーム入力されたデータを格納する名前）
|
||||
########################################################
|
||||
# action=regist --> 記事記録処理して通常画面へ
|
||||
# その他 --> 通常画面へ
|
||||
|
||||
if (($FORM{'def'} eq '0') && ($FORM{'value'} ne '')) { ®ist; }
|
||||
if ($FORM{'def'} eq '0') { &read; }
|
||||
|
||||
if ($FORM{'action'} eq "$action") { ®ist; }
|
||||
if ($FORM{'action'} eq 'search1') { &search1; }
|
||||
if ($FORM{'action'} eq 'search2') { &search2; }
|
||||
if ($FORM{'action'} eq 'search3') { &search3; }
|
||||
&html;
|
||||
|
||||
# メイン表示サブルーチン #######################################################
|
||||
sub html {
|
||||
|
||||
# プロテクトキー生成
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pkey ) = ( $ptime + $protect_a ) * $protect_b + $protect_c;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
|
||||
# バナーはここ
|
||||
|
||||
print "<font size=+1><b>$title</b></font>\n";
|
||||
print "<font size=-1> <b><a href=\"http://www.geocities.com/Tokyo/Subway/1282/front.html\" target=\"_top\">おしらせページ</a></b></font> \n";
|
||||
print " <font size=-1><b><a href=\"http://freehosting1.at.webjump.com/sw/swatty-webjump/\" target=\"_top\">スワティ</a></b></font>\n";
|
||||
#print "<font size=-1><b><a href=\"mailto:$mailadd\">連絡先</a></b></font>\n";
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">\n";
|
||||
print "投稿者 <input type=text name=\"name\" size=20 maxlength=40 value=\"$FORM{'name'}\"><br>";
|
||||
print "メール <input type=text name=\"email\" size=30><br>\n";
|
||||
print "題名 <input type=text name=\"subject\" size=30 maxlength=60> \n";
|
||||
print "<input type=submit value=\"投稿／リロード\"><input type=reset value=\"消す\"><p>内容<i>（タグは使えません。内容を書かずに投稿ボタンを押すとリロードになります。）</i><br><textarea name=\"value\" rows=5 cols=70></textarea><input type=hidden name=\"page\" size=70 value=\"http://\"><p>\n";
|
||||
print "表\示件数\n";
|
||||
print "<input type=text name=\"def\" size=8 value=\"$defnext\">\n";
|
||||
print "バックグラウンドカラー<input type=text name=\"bgcolor\" size=6 value=\"$bgc\"><input type=hidden name=\"link\" value=\"$FORM{'link'}\">\n";
|
||||
print "URL自動リンク<input type=checkbox name=\"image\" value=\"1\" checked></font> \n";
|
||||
|
||||
print "<input type=hidden name=\"code\" value=\"$sec$min\@$pkey.com\">\n";
|
||||
|
||||
|
||||
|
||||
print "<input type=hidden name=\"win_time\" value=\"$month$mday$hour$min$sec\">\n";
|
||||
|
||||
|
||||
print "<p><font size=-1>最近の過去ログは<a href=\"./getlog.cgi\" target=\"_top\">ここ</a>。\n";
|
||||
|
||||
|
||||
|
||||
|
||||
#カウンター
|
||||
if ( $countlevel > 0 ){
|
||||
print "<font size=-1>$countdateから ";
|
||||
&counter; print "$countplus（こわれにくさレベル$countlevel）</font>\n"; }
|
||||
|
||||
print "<input type=hidden name=\"win_count\" value=\"$maxcount\">\n";
|
||||
|
||||
|
||||
# プロテクトコード出力
|
||||
print "<input type=hidden name=\"protect\" value=\"$pkey\">\n";
|
||||
|
||||
|
||||
# print "<br><i>新しい記事から表\示します。最高$max件の記事が記録され、それを超えると古い記事から削除されます。<br>\n";
|
||||
# print "１回の表\示で$def件を越える場合は、下のボタンを押すことで次の画面の記事を表\示します。</i>\n";
|
||||
|
||||
|
||||
print "<hr><a href=\"http://extra.onlineexpress.net/cgi-bin/strangeworld/bbs.cgi\">エクストラ</a>、<a href=\"http://www.kinsan.ne.jp/~miki/strangeworld/bbs.cgi\">きんさん</a>、 <a href=\"http://famille.onlineexpress.net/cgi-bin/strangeworld/bbs.cgi\">ふぁみーる</a>、<a href=\"http://www.bea.hi-ho.ne.jp/cgi-bin/user/strangeworld/bbs.cgi\">はいほー</a> | <a href=\"http://www4.famille.ne.jp/~haruna/remix/bbs.cgi\">REMIX</a>、<a href=\"http://kakumeigun.onlineexpress.net/cgi-bin/relax/bbs.cgi\">RELAX</a> | <a href=\"http://edoya.neko.to/2/upload.cgi\">ぁ界遺産</a>、<a href=\"http://saturdaytears.virtualave.net/cgi-bin/upload.cgi\">徘徊する骸</a>\n";
|
||||
|
||||
|
||||
# サーチの注意書き
|
||||
print "<hr>最大\表\示：$max件 ■：返信 ★：投稿者検索 ◆：スレッド検索 \表\示件数0件：未読\表\示<hr>この掲示板に関わるあらゆる行動は全て自分で責任をとってください。\n";
|
||||
|
||||
|
||||
# リロード
|
||||
print "<p></font></font><input type=submit value=\"投稿／リロード\">\n";
|
||||
print "</form>\n";
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open(DB,"$file");
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
if ($FORM{'page'} eq '') { $page = 0; } else { $page = $FORM{'page'}; }
|
||||
|
||||
$accesses = @lines; $accesses--;
|
||||
$page_end = $page + $def - 1;
|
||||
if ($page_end > $accesses) { $page_end = $accesses; }
|
||||
|
||||
foreach ($page .. $page_end) {
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$lines[$_]);
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
chop($postid) if $postid =~ /\n/;
|
||||
&disp;
|
||||
}
|
||||
|
||||
#--- 改ページ処理 ------------------------------------#
|
||||
|
||||
print "</form><hr><p>\n";
|
||||
$page_next = $page_end + 1;
|
||||
$i = $page + 1; $j = $page_end + 1;
|
||||
if ($page_end ne $accesses) {
|
||||
print "<font size=-1><i>以上は、現在登録されている新着順$i番目から$j番目までの記事です。</i></font><p>\n";
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
print "<input type=hidden name=\"page\" value=\"$page_next\">\n";
|
||||
print "<input type=hidden name=\"def\" value=\"$def\">\n";
|
||||
print "<input type=hidden name=\"bgcolor\" value=\"$bgc\">\n";
|
||||
print "<input type=submit value=\"次のページ\"></form>\n";
|
||||
}
|
||||
else {
|
||||
|
||||
print "<font size=-1><i>以上は、現在登録されている新着順$i番目から$j番目までの記事です。";
|
||||
print "これ以下の記事はありません。</i></font>\n";
|
||||
}
|
||||
|
||||
# このスクリプトの著作権表示（かならず表示してください）
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\"><input type=hidden name=\"def\" value=\"$def\"><input type=hidden name=\"bgcolor\" value=\"$bgc\"><input type=submit value=\" リロード \"></form>\n";
|
||||
print "<h4 align=right><hr size=5><a href=\"http://www.ask.or.jp/~rescue/\">MiniBBS v7.5</a> <a href=\"http://www.bea.hi-ho.ne.jp/strangeworld/recycle/\">REQUIEM 990707γ</a> is Free.</h4>\n";
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# 書き込み処理サブルーチン ############################################################
|
||||
sub regist {
|
||||
|
||||
# 内容がスペースならリロード
|
||||
if ($FORM{'value'} eq "") { &html; }
|
||||
|
||||
# 別のページからこのＣＧＩへの投稿を排除する処理
|
||||
$ref = $ENV{'HTTP_REFERER'};
|
||||
$ref_url = $cgiurl; $ref_url =~ s/\~/.*/g;
|
||||
if (!($ref =~ /$ref_url/i)) { &error(form); }
|
||||
|
||||
# 入力されたデータのチェック ##################################
|
||||
if ($FORM{'bgcolor'} eq "") { &error(1); }
|
||||
if ($FORM{'def'} eq "") { &error(1); }
|
||||
if ($FORM{'win_time'} eq "") { &error(1); }
|
||||
if ($FORM{'win_count'} eq "") { &error(1); }
|
||||
if ($FORM{'name'} eq "") { $FORM{'name'} = ''; }
|
||||
if ($FORM{'email'} =~ /,/) { &error(4); }
|
||||
$FORM{'email'}=~ s/\"//g;
|
||||
if ($FORM{'email'} ne "") { if (!($FORM{'email'} =~ /(.*)\@(.*)\.(.*)/)) { &error(3); }}
|
||||
if ($FORM{'subject'} eq "") { $FORM{'subject'} = ' '; }
|
||||
|
||||
if ($FORM{'page'} eq "" || $FORM{'page'} eq "http://") { $FORM{'page'} = ''; }
|
||||
else{
|
||||
$FORM{'page'} =~ s/\s//g;$FORM{'page'} =~ s/\"//g;$FORM{'page'} =~ s/\'//g;
|
||||
$FORM{'page'} =~ s/http\:\/\/http\:\/\//http\:\/\//g;
|
||||
}
|
||||
# 行数制限
|
||||
if ($max_line) {
|
||||
$value_size = ($FORM{'value'} =~ tr/\r/\r/) + 1; # \r の数を数える
|
||||
if ($value_size > $max_line) { &error(1); }
|
||||
}
|
||||
# 文字数制限
|
||||
if ($max_v) {
|
||||
$value_size = length($FORM{'value'});
|
||||
if ($value_size > $max_v) { &error(1); }
|
||||
}
|
||||
|
||||
# カウンター制限
|
||||
|
||||
for( $i=0 ; $i < $countlevel ; $i++){
|
||||
open(IN,"$countfile$i$countfiledat");
|
||||
$count[$i] = <IN>;
|
||||
$filenumber[$count[$i]] = $i;
|
||||
close(IN);
|
||||
}
|
||||
@sortedcount = sort by_number @count;
|
||||
$maxcount = $sortedcount[$countlevel-1];
|
||||
$mincount = $sortedcount[0];
|
||||
|
||||
if ( $FORM{'win_count'} > $maxcount ) { &repeat; }
|
||||
|
||||
|
||||
# プロテクトコードチェック
|
||||
if ( $FORM{'protect'} ne '' ) {
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pcheck ) = ( $FORM{'protect'} - $protect_c ) / $protect_b - $protect_a;
|
||||
|
||||
( $csec, $cmin, $chour, $cmday, $cmon, $cyear, $cwday, $cyday, $cisdat )
|
||||
= localtime ( $pcheck );
|
||||
$cyear += 1900;
|
||||
$cmon++;
|
||||
local ( $cnowdate ) = sprintf ( "%d/%02d/%02d(%s)%02d時%02d分%02d秒",
|
||||
$cyear, $cmon, $cmday,
|
||||
( '日', '月', '火', '水', '木', '金', '土' )[$cwday],
|
||||
$chour, $cmin, $csec );
|
||||
if (
|
||||
( $csec < 0 ) || ( $csec > 60 ) ||
|
||||
( $cmin < 0 ) || ( $cmin > 60 ) ||
|
||||
( $chour < 0 ) || ( $chour > 24 ) ||
|
||||
( ( $ptime - $pcheck ) > 1 * 60 * 60 ) ) { # １時間
|
||||
&error ( 'xxx' );
|
||||
}
|
||||
} else {
|
||||
&error ( 'xxx' );
|
||||
}
|
||||
|
||||
|
||||
|
||||
# 過去ログのファイルサイズチェック
|
||||
if ( ( -s $filedate ) > $maxoldlogsize ) {
|
||||
&error (0);
|
||||
}
|
||||
|
||||
|
||||
|
||||
# 投稿者名チェック
|
||||
$formname = $FORM{'name'};
|
||||
# if ($formname eq "$nameng"){ &error(xx); }
|
||||
if ($formname eq "$pass"){$formname = $namez; $FORM{'email'} = $mailadd;}
|
||||
else {
|
||||
$formname =~ s/$namez/<small>しば<\/small>/g;
|
||||
# $formname =~ s/しぱ/しは゜/g;
|
||||
}
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open (DB,"+<$file") || &error (0);
|
||||
eval 'flock (DB, 2)';
|
||||
@lines = <DB>;
|
||||
|
||||
|
||||
|
||||
# 最大保持記録数の処理
|
||||
$i = 0;
|
||||
foreach $line (@lines) {
|
||||
$i++;
|
||||
if ($i == $max) { last; }
|
||||
push(@new,$line);
|
||||
}
|
||||
|
||||
# 連続同一内容書き込みチェック
|
||||
$i = 0; $j = 0;
|
||||
while ( ( $i < $check ) && ($j == 0) ) {
|
||||
($date0,$name0,$email0,$value0,$subject0,$hpage0,$himage0,$code0,$postid0,$win_time0,$win_count0) = split(/\,/,$lines[$i]);
|
||||
|
||||
if ( $FORM{'value'} eq $value0 ) { $j = 2;}
|
||||
# if ( $FORM{'win_count'} eq $win_count0 ) { $j = 1; }
|
||||
# if (( $FORM{'win_count'} > $win_count0 ) &&($FORM{'win_time'} < $win_time0 )){ $j = 1;}
|
||||
# if (( $FORM{'win_count'} < $win_count0 ) && ($FORM{'win_time'} > $win_time0)){ $j = 1;}
|
||||
|
||||
# if (substr($FORM{'value'},0,$checklength) eq substr($value0,0,$checklength)){ $j = 1; }
|
||||
# if (substr($FORM{'value'},1-$checklength,$checklength) eq substr($value0,1-$checklength,$checklength)) { $j = 1; }
|
||||
$i++;
|
||||
}
|
||||
|
||||
# ID生成
|
||||
if ( $lines[0] =~ /^.*,.*,.*,.*,.*,.*,.*,.*,(.*),.*,.*\n/ ) {
|
||||
$postid = $1 + 1;
|
||||
} else {
|
||||
$postid = 1;
|
||||
}
|
||||
|
||||
if ( $j == 1) { &repeat; }
|
||||
|
||||
|
||||
if ( $j == 0 ) {
|
||||
$value = "$date_now\,$formname\,$FORM{'email'}\,$FORM{'value'}\,$FORM{'subject'}\,$FORM{'page'}\,$FORM{'image'},$FORM{'code'},$postid,$FORM{'win_time'},$FORM{'win_count'}\n";
|
||||
unshift(@new,$value);
|
||||
|
||||
seek (DB, 0, 0);
|
||||
print DB @new;
|
||||
eval 'flock (DB, 8)';
|
||||
close (DB);
|
||||
|
||||
|
||||
# 過去ログ出力
|
||||
########################
|
||||
$FORM{'value'} =~ s/\0/\,/g;
|
||||
open(LOG,">>$filedate") || &error(0);
|
||||
eval 'flock (LOG, 2)';
|
||||
|
||||
|
||||
if (-z LOG) {
|
||||
# ファイルが空の場合はHTMLヘッダを付ける
|
||||
print LOG "<html>\n<body bgcolor=\"#$bgc\" text=\"#$textc\" link=\"#$linkc\" vlink=\"#$vlinkc\" alink=\"#$alinkc\">\n<hr>";
|
||||
|
||||
# 保存後５日を過ぎた過去ログファイルは削除
|
||||
( $oldsec, $oldmin, $oldhour, $oldmday, $oldmonth, $oldyear, $oldwday, $oldyday, $oldisdst )
|
||||
= localtime ( time + $tim - 3 * 60 * 60 * 24 );
|
||||
$oldmonth += 1;
|
||||
$oldlogfilename = sprintf ( "%s%d%02d%02d%s", $logfile, $oldyear, $oldmonth, $oldmday, $logfiledat );
|
||||
unlink $oldlogfilename;
|
||||
}
|
||||
|
||||
print LOG "<font size=+1 color=\"#$subjc\"><b>$FORM{'subject'}</b></font>";
|
||||
# メールアドレスが記録されているデータにはリンクを付ける
|
||||
if ($FORM{'email'} ne '') { print LOG " 投稿者：<b><a href=\"mailto:$FORM{'email'}\">$formname</a></b>\n"; }
|
||||
else { print LOG " 投稿者：<font color=\"#$subjc\"><b>$formname</b></font>\n"; }
|
||||
print LOG "<font size=-1> 投稿日：$date_now";
|
||||
print LOG "</font><p>\n";
|
||||
if ($FORM{image} eq '1') {
|
||||
|
||||
$FORM{'value'} =~ s!((https?|ftp|gopher|telnet|whois|news):(=\S+|[\x21-\x7f])+)!<a href="$1" target="$link">$1</a>!ig;
|
||||
}
|
||||
|
||||
|
||||
print LOG "<blockquote><pre>$FORM{'value'}</pre><p>\n\n";
|
||||
|
||||
# ＵＲＬが記録されているデータにはリンクを付ける
|
||||
if ($FORM{'page'} ne '') {
|
||||
$page0 = $FORM{'page'};
|
||||
$page0 =~ s/$cgiurl\?action=search1\&search=(.*)\&id=\d*/参考：$1/;
|
||||
if ( $FORM{'page'} eq $page0 ) {
|
||||
print LOG "<a href=\"$FORM{'page'}\" target=\"jump\">$page0</a><p>\n";
|
||||
} else {
|
||||
print LOG "<font color=\"#$linkc\"><u>$page0</u></font><p>\n";
|
||||
}
|
||||
}
|
||||
print LOG "</blockquote>\n<hr>";
|
||||
|
||||
eval 'flock (LOG, 8)';
|
||||
close(LOG);
|
||||
|
||||
# if (!open(BD,">>./0000.txt")) {error(0); }
|
||||
# print BD "$date_now\,$FORM{'subject'}\,$host\n";
|
||||
# while ( ($a,$b) = each %ENV) {print BD "$a=$b\,";}
|
||||
# print BD "\n";
|
||||
# close(BD);
|
||||
|
||||
} else {
|
||||
eval 'flock (LOG, 8)';
|
||||
close(LOG);
|
||||
}
|
||||
|
||||
|
||||
# 記録処理後、再読み込みする
|
||||
if ( $FORM{'def'} eq "0" ) { &read; }
|
||||
elsif ( $FORM{'follow'} ne "on" ) { &html; }
|
||||
else {
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>かきこみ完了</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<h1>かきこみ完了</h1>\n";
|
||||
exit;
|
||||
}
|
||||
# print "Location: $cgiurl" . '?' . "\n\n";
|
||||
# exit;
|
||||
}
|
||||
|
||||
|
||||
# フォロー投稿サブルーチン（search1） ############################################
|
||||
sub search1 {
|
||||
|
||||
#--- 入力フォーム画面 --------------------------------#
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$FORM{search}に返信</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
# バナーはここ
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open(DB,"$file");
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0; $i = 0;
|
||||
|
||||
while (($f == 0) && ($i < $accesses)){
|
||||
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$lines[$i]);
|
||||
chop ($postid) if $postid =~ /\n/;
|
||||
if ($postid eq $FORM{id}) { $f = 1;}
|
||||
$i++;
|
||||
}
|
||||
|
||||
|
||||
if ($f == 1){
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
|
||||
&disp;
|
||||
print "<hr>\n";
|
||||
|
||||
$value =~ s/\r/\r> /g;
|
||||
$value =~ s/\r>\s>\s*\r/\r/g;
|
||||
$value ="> $value";
|
||||
#$value =~ s/> > >.*?\r//g;
|
||||
print "<p>\n";
|
||||
|
||||
|
||||
|
||||
# プロテクトキー生成
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pkey ) = ( $ptime + $protect_a ) * $protect_b + $protect_c;
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">\n";
|
||||
|
||||
if ($FORM{'link'} ne '') { $link = $FORM{'link'}; }
|
||||
|
||||
if ($FORM{'link'} ne '_top') { print "<input type=hidden name=\"follow\" value=\"on\">\n"; }
|
||||
print "投稿者 <input type=text name=\"name\" size=20 maxlength=20><br>";
|
||||
print "メール <input type=text name=\"email\" size=30><br>\n";
|
||||
print "題名 <input type=text name=\"subject\" size=30 value=\"＞$name\"> \n";
|
||||
print "<input type=submit value=\" 投稿 \"><input type=reset value=\"消す\"><p>\n";
|
||||
|
||||
|
||||
print "<input type=hidden name=\"def\" value=\"$defnext\">\n";
|
||||
|
||||
# プロテクトコード出力
|
||||
print "<input type=hidden name=\"protect\" value=\"$pkey\">\n";
|
||||
|
||||
print "内容<i>（タグは使えません。\n";
|
||||
print "内容を書かずに投稿ボタンを押すとリロードになります。）</i><br>\n";
|
||||
|
||||
print "<textarea name=\"value\" rows=5 cols=70>$value\r";
|
||||
|
||||
print "</textarea><p>\n";
|
||||
|
||||
|
||||
|
||||
if ($himage ne '1') { print "URL自動リンク<input type=checkbox name=\"image\" value=\"1\"></font> \n";}
|
||||
else{
|
||||
print "URL自動リンク<input type=checkbox name=\"image\" value=\"1\" checked></font> \n";}
|
||||
|
||||
#カウンター
|
||||
if ( $countlevel > 0 ){
|
||||
print "<font size=-1 color=$bgc>$countdateから ";
|
||||
&counter; print "$countplus（こわれにくさレベル$countlevel）</font>\n"; }
|
||||
|
||||
print "<input type=hidden name=\"win_count\" value=\"$maxcount\">\n";
|
||||
|
||||
print "<input type=hidden name=\"win_time\" value=\"$month$mday$hour$min$sec\">\n";
|
||||
|
||||
print "<input type=hidden name=\"code\" value=\"$code\">\n";
|
||||
print "<input type=hidden name=\"page\" size=70 value=\"$cgiurl\?action\=search1\&search\=$date\&id=$postid\">\n";
|
||||
print "<input type=hidden name=\"bgcolor\" value=\"$bgc\"></form><p>\n";
|
||||
}
|
||||
|
||||
else { print "みつかりません<br>";}
|
||||
|
||||
|
||||
print "<hr></body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
# 投稿者名サーチ用サブルーチン（search2） ############################################
|
||||
sub search2 {
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$FORM{search}の投稿一覧</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
# バナーはここ
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open(DB,"$file");
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0;
|
||||
foreach ( @lines ){
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$_);
|
||||
if ( $name eq $FORM{search} ) {
|
||||
$f = 1;
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
&disp;
|
||||
}
|
||||
}
|
||||
|
||||
if ($f == 0){ print "みつかりません<br>";}
|
||||
|
||||
print "<hr></body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# トピックサーチ用サブルーチン（search3） ############################################
|
||||
sub search3 {
|
||||
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>スレッド一覧</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open(DB,"$file");
|
||||
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0;
|
||||
foreach ( @lines ){
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$_);
|
||||
|
||||
if ( $code eq $FORM{search} ) {
|
||||
$f = 1;
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
&disp;
|
||||
}
|
||||
}
|
||||
|
||||
if ($f == 0){ print "みつかりません<br>";}
|
||||
|
||||
print "<hr></body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# ログ読み表示サブルーチン #######################################################
|
||||
sub read {
|
||||
|
||||
# プロテクトキー生成
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pkey ) = ( $ptime + $protect_a ) * $protect_b + $protect_c;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
|
||||
# バナーはここ
|
||||
|
||||
print "<font size=+1><b>$title</b></font> \n";
|
||||
print "<font size=-1><b><a href=\"http://www.geocities.com/Tokyo/Subway/1282/front.html\" target=\"_top\">おしらせページ</a></b></font> \n";
|
||||
print " <font size=-1><b><a href=\"http://freehosting1.at.webjump.com/sw/swatty-webjump/\" target=\"_top\">スワティ</a></b></font>\n";
|
||||
#print "<font size=-1><b><a href=\"mailto:$mailadd\">連絡先</a></b></font>\n";
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">\n";
|
||||
print "投稿者 <input type=text name=\"name\" size=20 maxlength=40 value=\"$FORM{'name'}\"><br>";
|
||||
print "メール <input type=text name=\"email\" size=30><br>\n";
|
||||
print "題名 <input type=text name=\"subject\" size=30 maxlength=60> \n";
|
||||
print "<input type=submit value=\"投稿／リロード\"><input type=reset value=\"消す\"><p>内容<i>（タグは使えません。内容を書かずに投稿ボタンを押すとリロードになります。）</i><br><textarea name=\"value\" rows=5 cols=70></textarea><input type=hidden name=\"page\" size=70 value=\"http://\"><p>\n";
|
||||
print "表\示件数\n";
|
||||
print "<input type=text name=\"def\" size=8 value=\"$defnext\">\n";
|
||||
print "バックグラウンドカラー<input type=text name=\"bgcolor\" size=6 value=\"$bgc\"><input type=hidden name=\"link\" value=\"$FORM{'link'}\">\n";
|
||||
|
||||
|
||||
#$month月$mday日($youbi)$hour時$min分$sec秒
|
||||
|
||||
print "<input type=hidden name=\"win_time\" value=\"$month$mday$hour$min$sec\">\n";
|
||||
|
||||
|
||||
print "URL自動リンク<input type=checkbox name=\"image\" value=\"1\" checked></font> \n";
|
||||
|
||||
print "<input type=hidden name=\"code\" value=\"$sec$min\@$pkey.com\">\n";
|
||||
|
||||
print "<p><font size=-1>最近の過去ログは<a href=\"./getlog.cgi\" target=\"_top\">ここ</a>。\n";
|
||||
|
||||
#カウンター
|
||||
if ( $countlevel > 0 ){
|
||||
print "<font size=-1>$countdateから ";
|
||||
&counter; print "$countplus（こわれにくさレベル$countlevel）</font>\n"; }
|
||||
|
||||
print "<input type=hidden name=\"win_count\" value=\"$maxcount\">\n";
|
||||
|
||||
# プロテクトコード出力
|
||||
print "<input type=hidden name=\"protect\" value=\"$pkey\">\n";
|
||||
|
||||
|
||||
# print "<br><i>新しい記事から表\示します。最高$max件の記事が記録され、それを超えると古い記事から削除されます。<br>\n";
|
||||
# print "１回の表\示で$def件を越える場合は、下のボタンを押すことで次の画面の記事を表\示します。</i>\n";
|
||||
|
||||
print "<hr><a href=\"http://extra.onlineexpress.net/cgi-bin/strangeworld/bbs.cgi\">エクストラ</a>、<a href=\"http://www.kinsan.ne.jp/~miki/strangeworld/bbs.cgi\">きんさん</a>、 <a href=\"http://famille.onlineexpress.net/cgi-bin/strangeworld/bbs.cgi\">ふぁみーる</a>、<a href=\"http://www.bea.hi-ho.ne.jp/cgi-bin/user/strangeworld/bbs.cgi\">はいほー</a> | <a href=\"http://www4.famille.ne.jp/~haruna/remix/bbs.cgi\">REMIX</a>、<a href=\"http://kakumeigun.onlineexpress.net/cgi-bin/relax/bbs.cgi\">RELAX</a> | <a href=\"http://edoya.neko.to/2/upload.cgi\">ぁ界遺産</a>、<a href=\"http://saturdaytears.virtualave.net/cgi-bin/upload.cgi\">徘徊する骸</a>\n";
|
||||
|
||||
# サーチの注意書き
|
||||
print "<hr>最大\表\示：$max件 ■：返信 ★：投稿者検索 ◆：スレッド検索 \表\示件数0件：未読メッセージ<hr>投稿の削除はしないので、この掲示板に関わるあらゆる行動は自分で責任をとってください。\n";
|
||||
|
||||
# リロード
|
||||
print "<p></font></font><input type=submit value=\"投稿／リロード\">\n";
|
||||
|
||||
|
||||
print "</form>\n";
|
||||
|
||||
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# $date=#$month月$mday日($youbi)$hour時$min分$sec秒
|
||||
#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open(DB,"$file");
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
#$FORM{'win_time'}=~ s/0//o;
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0;
|
||||
foreach ( @lines ){
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$_);
|
||||
|
||||
$date_s = $date;
|
||||
$date=~ s/月|日|\(|\)|時|分|秒|火|水|木|金|土//g;
|
||||
#$date=~ s/0//o;
|
||||
|
||||
if ( $FORM{'win_time'} <= $date ) {
|
||||
$f = $f + 1;
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
|
||||
$date = $date_s;
|
||||
&disp;
|
||||
}
|
||||
else { last; }
|
||||
|
||||
}
|
||||
|
||||
$g = $f;
|
||||
|
||||
if ( $f eq 0 ) {print "<hr><p><font size=-1><i>未読メッセージはありません。</i></font><p>";}
|
||||
|
||||
else {print "<hr><p><font size=-1><i>$g件のメッセージがあります。</i></font><p>";}
|
||||
|
||||
|
||||
|
||||
# このスクリプトの著作権表示（かならず表示してください）
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\"><input type=hidden name=\"def\" value=\"$def\"><input type=hidden name=\"bgcolor\" value=\"$bgc\"><input type=hidden name=\"win_time\" value=\"$month$mday$hour$min$sec\"><input type=submit value=\" リロード \"></form>\n";
|
||||
print "<h4 align=right><hr size=5><a href=\"http://www.ask.or.jp/~rescue/\">MiniBBS v7.5</a> <a href=\"http://www.bea.hi-ho.ne.jp/strangeworld/recycle/\">REQUIEM 990707γ</a> is Free.</h4>\n";
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
# 各投稿表示用サブルーチン #############################################################
|
||||
sub disp {
|
||||
|
||||
$hpage0 =$hpage;
|
||||
$hpage0 =~ s/$cgiurl\?action=search1\&search=(.*)\&id=\d*/参考：$1/;
|
||||
print "<hr>";
|
||||
print "<font size=+1 color=\"#$subjc\"><b>$subject</b></font> ";
|
||||
|
||||
|
||||
if ($email ne '') { print "投稿者：<b><a href=\"mailto:$email\">$name</a></b>\n"; }
|
||||
else { print "投稿者：<b>$name</b></font>\n"; }
|
||||
|
||||
print "<font size=-1> 投稿日：$date";
|
||||
|
||||
print " <a href=\"$cgiurl\?bgcolor\=$bgc\&action\=search1\&search\=$date\&id=$postid\" target=\"link\">■</a>";
|
||||
print " <a href=\"$cgiurl\?bgcolor\=$bgc\&action\=search2\&search\=$name\" target=\"link\">★</a>";
|
||||
if ($hpage ne'' ) { print " <a href=\"$cgiurl\?bgcolor\=$bgc\&action\=search3\&search\=$code\" target=\"link\">◆</a>\n"; }
|
||||
print "</font><p>\n";
|
||||
|
||||
if (($FORM{search} eq '') && ($himage eq '1') ){
|
||||
$value =~ s!((https?|ftp|gopher|telnet|whois|news):(=\S+|[\x21-\x7f])+)!<a href=\"$1\" target=\"link\">$1</a>!ig;
|
||||
|
||||
}
|
||||
|
||||
|
||||
print "<blockquote><pre>$value</pre><p>\n\n";
|
||||
|
||||
if ($hpage ne '') { print "<a href=\"$hpage\" target=\"link\">$hpage0</a><p>\n"; }
|
||||
|
||||
print "</blockquote>\n";
|
||||
}
|
||||
|
||||
# エラー処理サブルーチン ############################################################
|
||||
sub error {
|
||||
|
||||
# &error(xx); で呼び出されたルーチンは、()内の数字が $error に代入される。
|
||||
|
||||
$error = $_[0];
|
||||
|
||||
if ($error eq "0") { $error_msg = '記録ファイルの入出力にエラーが発生しました。'; }
|
||||
elsif ($error eq "2") { $error_msg = '内容が書かれていません。または記録禁止のタグが書かれています。'; }
|
||||
elsif ($error eq "3") { $error_msg = 'メールアドレスが正しく入力されていません。'; }
|
||||
elsif ($error eq "4") { $error_msg = 'メールアドレスは複数指定できません。'; }
|
||||
elsif ($error eq "5") { $error_msg = '投稿内容が大きすぎます。'; }
|
||||
|
||||
elsif ($error eq "6") { $error_msg = 'アクセスが混み合ってるため、書き込みできませんでした。もう一度、投稿ボタンを押してください。'; }
|
||||
elsif ($error eq "form") { $error_msg = "投稿画面のＵＲＬが<br>$cgiurl<br>" . '以外からの投稿はできません。'; }
|
||||
elsif ($error eq "x") { $error_msg = "以下の情報が記録されました。けけ"; }
|
||||
elsif ($error eq "xx") { $error_msg = "かわいそう"; }
|
||||
elsif ($error eq 'xxx') { $error_msg = ' '; }
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<h3>$error_msg</h3>\n";
|
||||
|
||||
|
||||
|
||||
if ($error eq "x") {
|
||||
while ( ($a,$b) = each %ENV) {
|
||||
print "$a=$b<br><br>\n";
|
||||
}
|
||||
}
|
||||
|
||||
if ($error eq "xx") {
|
||||
print "<table>\n";
|
||||
}
|
||||
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# カウンター処理サブルーチン #########################################################
|
||||
sub counter {
|
||||
|
||||
for( $i=0 ; $i < $countlevel ; $i++){
|
||||
open(IN,"$countfile$i$countfiledat");
|
||||
$count[$i] = <IN>;
|
||||
$filenumber[$count[$i]] = $i;
|
||||
close(IN);
|
||||
}
|
||||
@sortedcount = sort by_number @count;
|
||||
$maxcount = $sortedcount[$countlevel-1];
|
||||
$mincount = $sortedcount[0];
|
||||
|
||||
$maxcount++;
|
||||
print $maxcount;
|
||||
|
||||
open(OUT,">$countfile$filenumber[$mincount]$countfiledat");
|
||||
print OUT $maxcount;
|
||||
close(OUT);
|
||||
}
|
||||
|
||||
sub by_number {
|
||||
$a <=> $b;
|
||||
}
|
||||
|
||||
#end_of_script
|
||||
326
@hi-ho/getlog.cgi
Normal file
326
@hi-ho/getlog.cgi
Normal file
|
|
@ -0,0 +1,326 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#はじあや＠ふぁみーるのパソヲタさん、本当にありがとう
|
||||
|
||||
|
||||
#--------------------
|
||||
|
||||
$body = '<body bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">';
|
||||
$bbstitle ="あやしいわーるど";
|
||||
|
||||
#$logdir = 'http://www2u.biglobe.ne.jp/~rebirth/strange/log/';
|
||||
|
||||
$cgiurl = 'getlog.cgi';
|
||||
$action ='getlog';
|
||||
|
||||
$bbsurl = './bbs.cgi';
|
||||
$logurl = './log/990720.html';
|
||||
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
|
||||
# キーワードの最大文字数（半角）
|
||||
$keylength = 64;
|
||||
|
||||
# 時差 サーバの時計がずれてる時や日本時間以外にしたい時に使う
|
||||
$tim = 0;
|
||||
|
||||
# 時刻処理
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time + $tim );
|
||||
|
||||
$month = ($mon + 1);
|
||||
$month= "0$month";
|
||||
|
||||
|
||||
$filedate3 = "./log/$year$month$mday.html";
|
||||
$m2day =$mday-1;
|
||||
$filedate2 = "./log/$year$month$m2day.html";
|
||||
$m1day =$mday-2;
|
||||
$filedate1 = "./log/$year$month$m1day.html";
|
||||
#--------------------
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
|
||||
@argv = split(/&/,$buffer);
|
||||
foreach (@argv) {
|
||||
($name, $value) = split(/=/);
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
$COMMAND{$name} = $value;
|
||||
}
|
||||
|
||||
&error(2) if (length($COMMAND{'keyword'}) > $keylength);
|
||||
&viewlog if ($COMMAND{'action'} eq "$action");
|
||||
|
||||
|
||||
&list;
|
||||
|
||||
|
||||
# リストの出力
|
||||
########################
|
||||
sub list {
|
||||
|
||||
#&error(0) if(!opendir(DIR, $logdir));
|
||||
|
||||
opendir(DIR, $logdir);
|
||||
|
||||
|
||||
@files=readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
@files = sort by_number @files;
|
||||
$end = @files;
|
||||
$end--;
|
||||
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ</title></head>\n";
|
||||
print "<form method=get action=\"$cgiurl\">";
|
||||
print "$body\n";
|
||||
print "<center><font size=+1><b>$bbstitle 過去ログ一覧</b></font><br>\n";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">";
|
||||
print "<table>";
|
||||
print "<tr><td></td><td>ファイル名</td><td align=right>サイズ</td><td align=center></td></tr>";
|
||||
|
||||
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat $filedate1;
|
||||
|
||||
|
||||
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$filedate1\"></td>";
|
||||
print "<td><a href=\"$filedate1\">$year$month$m1day.html</a></td>";
|
||||
print "<td align=right>$size byte</td><td align=center></td></tr>";
|
||||
|
||||
#########
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat $logurl;
|
||||
|
||||
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$filedate2\"></td>";
|
||||
print "<td><a href=\"$filedate2\">$year$month$m2day.html</a></td>";
|
||||
print "<td align=right>$size byte</td><td align=center></td></tr>";
|
||||
|
||||
#######
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat $filedate3;
|
||||
|
||||
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$filedate3\" checked></td>";
|
||||
print "<td><a href=\"$filedate3\">$year$month$mday.html</a></td>";
|
||||
print "<td align=right>$size byte</td><td align=center></td></tr>";
|
||||
|
||||
|
||||
|
||||
print "<tr><td></td></tr><tr><td colspan=4>
|
||||
※ラジオボタンでファイル名を指定してください。</td></tr><tr><td></td></tr>\n";
|
||||
print "<tr><td colspan=4><select name=\"hour1\">";
|
||||
print "<option value=\"00\">0";
|
||||
print "<option value=\"01\">1";
|
||||
print "<option value=\"02\">2";
|
||||
print "<option value=\"03\">3";
|
||||
print "<option value=\"04\">4";
|
||||
print "<option value=\"05\">5";
|
||||
print "<option value=\"06\">6";
|
||||
print "<option value=\"07\">7";
|
||||
print "<option value=\"08\">8";
|
||||
print "<option value=\"09\">9";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時";
|
||||
print"<select name=\"min1\">";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"35\">35";
|
||||
print "<option value=\"40\">40";
|
||||
print "<option value=\"45\">45";
|
||||
print "<option value=\"50\">50";
|
||||
print "<option value=\"55\">55";
|
||||
print "</select>分から";
|
||||
|
||||
print "<select name=\"hour2\">";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"00\">0";
|
||||
print "<option value=\"01\">1";
|
||||
print "<option value=\"02\">2";
|
||||
print "<option value=\"03\">3";
|
||||
print "<option value=\"04\">4";
|
||||
print "<option value=\"05\">5";
|
||||
print "<option value=\"06\">6";
|
||||
print "<option value=\"07\">7";
|
||||
print "<option value=\"08\">8";
|
||||
print "<option value=\"09\">9";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時";
|
||||
print"<select name=\"min2\">";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"35\">35";
|
||||
print "<option value=\"40\">40";
|
||||
print "<option value=\"45\">45";
|
||||
print "<option value=\"50\">50";
|
||||
print "<option value=\"55\">55";
|
||||
print "</select>分まで";
|
||||
|
||||
print "</td></tr><br>";
|
||||
print " <tr><td colspan=4>検索：";
|
||||
print "<select name=\"searchmode\">";
|
||||
print "<option value=\"keyword\">全文";
|
||||
print "<option value=\"name\">投稿者名";
|
||||
print "<option value=\"subject\">題名\n</select>";
|
||||
print "<input type=text name=\"keyword\" size=\"24\" maxlength=$keylength></td></tr><tr><td colspan=4 align=center>";
|
||||
print "<input type=submit value=\"Get / Search\"></form></td></tr>";
|
||||
print "</table>";
|
||||
print "<hr>";
|
||||
#print "現在ベータテスト中です。バグを見つけたら掲示板に書いてね";
|
||||
print "<p align=center><a href=\"$bbsurl\">掲示板へ</a></p>";
|
||||
print "<h4 align=right><a href=\"http://logshonin.virtualave.net/\">Getlog Ver0.3b4</a></h4>";
|
||||
print "</body></html>";
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub viewlog {
|
||||
|
||||
#if (!open(DB,"./log/$COMMAND{'logfile'}")) { &error(1); }
|
||||
|
||||
open(DB,$COMMAND{'logfile'});
|
||||
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
#----------------------------
|
||||
$COMMAND{'last'} = $COMMAND{'first'} + 1 if ($COMMAND{'first'} >= $COMMAND{'last'});
|
||||
$first = "$COMMAND{'hour1'}時$COMMAND{'min1'}分";
|
||||
$last = "$COMMAND{'hour2'}時$COMMAND{'min2'}分";
|
||||
|
||||
if ($COMMAND{'searchmode'} eq 'name') { $keyword = "投稿者：.*>${COMMAND{'keyword'}}<"; }
|
||||
elsif ($COMMAND{'searchmode'} eq 'subject') { $keyword = "color=\"#ffffee\"><b>${COMMAND{'keyword'}}</b></font>"; }
|
||||
else { $keyword = $COMMAND{'keyword'}; }
|
||||
if ($keyword ne '') {
|
||||
$keyword =~ s/\\/\\\\/;
|
||||
$keyword =~ s/\[/\\[/;
|
||||
}
|
||||
|
||||
#----------------------------
|
||||
|
||||
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ $COMMAND{'logfile'}</title></head>";
|
||||
print "$body";
|
||||
print "<font size=+1><b>$COMMAND{'logfile'} $first～$last</b></font>";
|
||||
|
||||
############################
|
||||
|
||||
$end = @lines;
|
||||
$end--;
|
||||
foreach (0 .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
$hour = substr( $lines[$_], 36, 8 );
|
||||
|
||||
|
||||
last if ($hour ge "$first");
|
||||
}
|
||||
$skip++;
|
||||
}
|
||||
$skip--;
|
||||
|
||||
#print"<hr>";
|
||||
foreach ($skip .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
$hour = substr( $lines[$_], 36, 8 );
|
||||
|
||||
last if ($hour ge "$last");
|
||||
}
|
||||
|
||||
|
||||
if ($keyword ne '') {
|
||||
if ($lines[$_] =~ /$keyword/) {
|
||||
$flag = 1;
|
||||
$hit++;
|
||||
}
|
||||
|
||||
push( @article, $lines[$_] );
|
||||
if ($lines[$_] =~ /<\/blockquote>/) {
|
||||
print @article if ($flag > 0);
|
||||
splice( @article, 0 );
|
||||
$flag = 0;
|
||||
}
|
||||
}
|
||||
|
||||
else { print $lines[$_]; }
|
||||
}
|
||||
|
||||
if ($COMMAND{'keyword'} ne '') {
|
||||
print "<hr>";
|
||||
if ( $hit > 0 ) { print "<h3>「$COMMAND{'keyword'}」は $hit件見つかりました。</h3>"; }
|
||||
else { print "<h3>「$COMMAND{'keyword'}」は見つかりませんでした。</h3>"; }
|
||||
}
|
||||
|
||||
|
||||
print "</body></html>";
|
||||
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
####################
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub error {
|
||||
|
||||
$error = $_[0];
|
||||
if ($error == 0) { $errmsg = 'ディレクトリが開けませんでした。'; }
|
||||
if ($error == 1) { $errmsg = 'ファイルが開けませんでした。'; }
|
||||
if ($error == 2) { $errmsg = 'キーワードが長すぎます。'; }
|
||||
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>エラー</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$errmsg</h1>";
|
||||
print "</body></html>";
|
||||
exit;
|
||||
}
|
||||
764
[1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/bbscgi.txt
Normal file
764
[1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/bbscgi.txt
Normal file
|
|
@ -0,0 +1,764 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#----------------#
|
||||
# 初期設定 #
|
||||
#----------------#
|
||||
|
||||
|
||||
# 掲示板の名前 --------------------------
|
||||
|
||||
|
||||
$title = 'あやしいわーるど＠はるな';
|
||||
|
||||
# 文字色や背景などの設定
|
||||
|
||||
# body部
|
||||
|
||||
$bgc = '007f7f';
|
||||
|
||||
$textc = 'ffffff';
|
||||
|
||||
$linkc = 'eeffee';
|
||||
|
||||
$vlinkc = 'dddddd';
|
||||
|
||||
$alinkc = 'ff0000';
|
||||
|
||||
# 題名の色
|
||||
|
||||
$subjc = 'ffffee';
|
||||
|
||||
|
||||
# --- 表示件数 --------------------------------------------
|
||||
# １ページに表示する件数のデフォルト値
|
||||
$def = 50;
|
||||
# １ページに表示する件数の最小値
|
||||
$defmin = 10;
|
||||
# この件数以上でリロード／書き込みしたときには次はこの件数にする。
|
||||
$defmax =500;
|
||||
|
||||
# --- ＵＲＬ ----------------------------------------------
|
||||
# このスクリプト
|
||||
$cgiurl = 'bbs.cgi';
|
||||
|
||||
|
||||
# 連絡先
|
||||
$mailadd = 'goodby@strangers.com';
|
||||
|
||||
# ログのＵＲＬ
|
||||
$loglog0 = 'log';
|
||||
$loglog1 = 'http://';
|
||||
|
||||
# ---------------------------------------- 書き込みチェック ----------------------------------------
|
||||
# 管理人名前チェック・メールアドレス・パスワード
|
||||
$namez = 'しば';
|
||||
$pass = 'chiba';
|
||||
|
||||
# ＮＧ名前（この名前で投稿するとブラウザがクラッシュ）
|
||||
#$nameng = "つばつば";
|
||||
# 書き込み最大量
|
||||
$maxlength = 1024*16;
|
||||
#投稿内容文字数
|
||||
$max_v = 6000;
|
||||
#投稿内容行数（上の文字数との兼ね合いを考えて）
|
||||
$max_line = 60;
|
||||
|
||||
# 二重書き込みチェック件数
|
||||
$check = 10;
|
||||
# 二重書き込みチェックバイト数
|
||||
$checklength = 10;
|
||||
# 書き込み件数の最大登録数の設定
|
||||
$max = '500';
|
||||
|
||||
# ------------------------------------ ディレクトリ・ファイル名 ------------------------------------
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
# 内容が書き込まれる記録ファイルのパスを設定
|
||||
$file = './loveyou.dat';
|
||||
# 別途とるログのファイル名先頭文字・拡張子の指定
|
||||
$logfile = "./log/";
|
||||
$logfiledat = ".html";
|
||||
|
||||
# -------------------------------------------- カウンタ --------------------------------------------
|
||||
# カウンタプラス値
|
||||
$countplus = "";
|
||||
# カウンタ開始日
|
||||
$countdate = '99/4/15';
|
||||
# カウンタファイルの先頭文字・拡張子の指定
|
||||
$countfile = './count/count';
|
||||
$countfiledat = '.txt';
|
||||
# カウンタ強度（０のときは使用しない）
|
||||
$countlevel = 5;
|
||||
|
||||
# --------------------------------------------- その他 ---------------------------------------------
|
||||
# 時差
|
||||
$tim =0*3600;
|
||||
# 入力形式の設定
|
||||
$method = 'post';
|
||||
|
||||
|
||||
# 時刻処理
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time + $tim );
|
||||
$month = ($mon + 1);
|
||||
|
||||
# 時刻のゼロサプレス
|
||||
if ($month < 10) { $month = "0$month"; }
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($sec < 10) { $sec = "0$sec"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
|
||||
# 曜日変換処理
|
||||
$y0="日"; $y1="月"; $y2="火"; $y3="水"; $y4="木"; $y5="金"; $y6="土";
|
||||
$youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6) [$wday];
|
||||
|
||||
# 時刻フォーマット
|
||||
$date_now = "$month月$mday日($youbi)$hour時$min分$sec秒";
|
||||
# ログファイル名取得
|
||||
$filedate = "$logfile$year$month$mday$logfiledat";
|
||||
$gesu = $ENV{'REMOTE_PORT'};
|
||||
# 投稿時のaction名
|
||||
$action = "regist";
|
||||
|
||||
# 追加対策 -------------------------------
|
||||
|
||||
# 外部投稿防止コード
|
||||
$protect_a = $gesu; # 4桁
|
||||
$protect_b = 55; # 2桁
|
||||
$protect_c = 112; # 3桁
|
||||
|
||||
# 過去ログの最大ファイルサイズ
|
||||
$maxoldlogsize = 3 * 1024 * 1024; # 3MB
|
||||
|
||||
###########################################################################################
|
||||
|
||||
# フォーム入力されたデータを$bufferに格納する（getかpostかによって取得方法が異なる）
|
||||
#if ($ENV{'REQUEST_METHOD'} eq "POST" && $ENV{'CONTENT_LENGTH'} < $maxlength) { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
#else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
if ($ENV{'CONTENT_LENGTH'} > $maxlength) {&error(5);}
|
||||
|
||||
# $bufferに格納されたFORM形式のデータを取り出す
|
||||
@pairs = split(/&/,$buffer);
|
||||
foreach $pair (@pairs) {
|
||||
|
||||
($name, $value) = split(/=/, $pair);
|
||||
$value =~ tr/+/ /;
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
|
||||
# 記録するデータはsjis
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
|
||||
#改行連打のいたずらを回避（３行以上何も書かずに改行のみの部分は改行無視）
|
||||
#スペース＋改行の連打を回避（上記を回避するためにスペースをいれて改行する悪戯の場合）
|
||||
if ($value =~ /\r\n/) { $value =~ s/\r\n/\r/g; }
|
||||
if ($value =~ /\n/) { $value =~ s/\n/\r/g; }
|
||||
|
||||
if ($value =~ / \r \r/) { $value =~ s/ \r \r//g; }
|
||||
if ($value =~ /\ \r\ \r/) { $value =~ s/\ \r\ \r//g; }
|
||||
if ($value =~ / \r/) { $value =~ s/ \r/\r/g; }
|
||||
if ($value =~ /\ \r/) { $value =~ s/\ \r/\r/g; }
|
||||
if ($value =~ /\r\r\r\r/) { $value =~ s/\r\r\r\r//g; }
|
||||
|
||||
|
||||
# 処理の都合上の処理
|
||||
$value =~ s/\n//g; # 改行文字は消去
|
||||
|
||||
if ($name eq 'value') { $value =~ s/&/&\;/g; $value =~ s/\,/\0/g; }
|
||||
elsif ($name ne 'page' && $name ne 'image') { $value =~ s/\,//g; $value =~ s/\;//g; $value =~ s/\://g; $value =~ s/\=//g; }
|
||||
|
||||
else { $value =~ s/\,//g; }
|
||||
|
||||
$value =~ s/</<\;/g; $value =~ s/>/>\;/g;
|
||||
|
||||
$FORM{$name} = $value;
|
||||
}
|
||||
|
||||
|
||||
# 表示ページ数の決定 ##################################################
|
||||
if ($FORM{'def'} ne '') { $def = $FORM{'def'}; }
|
||||
if ($def < $defmin) { $def = $defmin;}
|
||||
$defnext = $def;
|
||||
if ($defnext > $defmax) {$defnext = $defmax;}
|
||||
|
||||
# 表示色の決定 ########################################################
|
||||
if ($FORM{'bgcolor'} ne '') { $bgc = $FORM{'bgcolor'}; }
|
||||
$body = "<body bgcolor=\"#$bgc\" text=\"#$textc\" link=\"#$linkc\" vlink=\"#$vlinkc\" alink=\"#$alinkc\">";
|
||||
|
||||
# ポップアップウインドウの決定 ########################################################
|
||||
if ($FORM{'link'} eq '') { $checked1='checked'; }
|
||||
if ($FORM{'link'} eq '2') { $checked2='checked'; }
|
||||
if ($FORM{'link'} eq '3') { $checked3='checked'; }
|
||||
|
||||
if ($FORM{'link'} eq '') { $link='link'; }
|
||||
if ($FORM{'link'} eq '2'){ $link='$sec$min'; }
|
||||
if ($FORM{'link'} eq '3') { $link='_top'; }
|
||||
|
||||
|
||||
# 全体の流れを決定する（actionやpwdはフォーム入力されたデータを格納する名前）
|
||||
########################################################
|
||||
# action=regist --> 記事記録処理して通常画面へ
|
||||
# その他 --> 通常画面へ
|
||||
if ($FORM{'action'} eq "$action") { ®ist; }
|
||||
if ($FORM{'action'} eq 'search1') { &search1; }
|
||||
if ($FORM{'action'} eq 'search2') { &search2; }
|
||||
if ($FORM{'action'} eq 'search3') { &search3; }
|
||||
&html;
|
||||
|
||||
# メイン表示サブルーチン #######################################################
|
||||
sub html {
|
||||
|
||||
# プロテクトキー生成
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pkey ) = ( $ptime + $protect_a ) * $protect_b + $protect_c;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
# バナーはここ
|
||||
|
||||
print "<font color=ffffff size=+1>
|
||||
<b>$title</b></font> <font size=-1><b><a href=\"http://www.geocities.com/Tokyo/Subway/1282/front.html\">お知らせページ</b></a></font>\n";
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">\n";
|
||||
print "投稿者 <input type=text name=\"name\" size=20 maxlength=40 value=\"$FORM{'name'}\"><br>";
|
||||
print "メール <input type=text name=\"email\" size=30><br>\n";
|
||||
print "題名 <input type=text name=\"subject\" size=30 maxlength=60> \n";
|
||||
print "<input type=submit value=\"投稿／リロード\"><input type=reset value=\"消す\"><p>内容<i>（タグは使えません。内容を書かずに投稿ボタンを押すとリロードになります。）</i><br><textarea name=\"value\" rows=5 cols=70></textarea><input type=hidden name=\"page\" size=70 value=\"http://\"><p>\n";
|
||||
print "表\示件数\n";
|
||||
print "<input type=text name=\"def\" size=8 value=\"$defnext\">\n";
|
||||
print "バックグラウンドカラー<input type=text name=\"bgcolor\" size=6 value=\"$bgc\"><input type=hidden name=\"link\" value=\"$FORM{'link'}\">\n";
|
||||
|
||||
print "<input type=hidden name=\"link\" value=\"\" $checked1><input type=hidden name=\"link\" value=\"2\" $checked2><input type=hidden name=\"link\" value=\"3\" $checked3></font>\n";
|
||||
|
||||
print "<input type=hidden name=\"code\" value=\"$sec$min\@$pkey.com\">\n";
|
||||
|
||||
print "<hr>
|
||||
<font size=-1>過去ログは<a href=\"./getlog.cgi\" target=\"_top\">ここ</a>。\n";
|
||||
print "<input type=hidden name=\"image\" value=\"0\">\n";
|
||||
|
||||
|
||||
|
||||
# プロテクトコード出力
|
||||
print "<input type=hidden name=\"protect\" value=\"$pkey\">\n";
|
||||
|
||||
|
||||
|
||||
print "<font size=-1>\n";
|
||||
# print "<hr><i>新しい記事から表\示します。最高$max件の記事が記録され、それを超えると古い記事から削除されます。<br>\n";
|
||||
# print "１回の表\示で$def件を越える場合は、下のボタンを押すことで次の画面の記事を表\示します。</i>\n";
|
||||
|
||||
# サーチの注意書き
|
||||
print "投稿の削除は不可\能\なので、全ての行動は自己責任で行ってください。<br>■・・・返信 ★・・・投稿者検索 ◆・・・スレッド検索\n";
|
||||
|
||||
# カウンタ
|
||||
if ( $countlevel > 0 ){
|
||||
print "<font color=\"#$bgc\">$countdateから ";
|
||||
&counter; print "$countplus（こわれにくさレベル$countlevel）</font><br>\n";
|
||||
}
|
||||
|
||||
# リロード
|
||||
print "<p></font></font><input type=submit value=\"投稿／リロード\">\n";
|
||||
print "</form>\n";
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
if (!open(DB,"$file")) { &error(0); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
if ($FORM{'page'} eq '') { $page = 0; } else { $page = $FORM{'page'}; }
|
||||
|
||||
$accesses = @lines; $accesses--;
|
||||
$page_end = $page + $def - 1;
|
||||
if ($page_end > $accesses) { $page_end = $accesses; }
|
||||
|
||||
foreach ($page .. $page_end) {
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$lines[$_]);
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
chop($postid) if $postid =~ /\n/;
|
||||
&disp;
|
||||
}
|
||||
|
||||
#--- 改ページ処理 ------------------------------------#
|
||||
|
||||
print "</form><hr><p>\n";
|
||||
$page_next = $page_end + 1;
|
||||
$i = $page + 1; $j = $page_end + 1;
|
||||
if ($page_end ne $accesses) {
|
||||
print "<font size=-1><i>以上は、現在登録されている新着順$i番目から$j番目までの記事です。</i></font><p>\n";
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
print "<input type=hidden name=\"page\" value=\"$page_next\">\n";
|
||||
print "<input type=hidden name=\"def\" value=\"$def\">\n";
|
||||
print "<input type=hidden name=\"bgcolor\" value=\"$bgc\">\n";
|
||||
print "<input type=submit value=\"次のページ\"></form>\n";
|
||||
}
|
||||
else {
|
||||
|
||||
print "<font size=-1><i>以上は、現在登録されている新着順$i番目から$j番目までの記事です。";
|
||||
print "これ以下の記事はありません。</i></font>\n";
|
||||
}
|
||||
|
||||
# このスクリプトの著作権表示（かならず表示してください）
|
||||
print "<h4 align=right><hr size=5><a href=\"http://www.ask.or.jp/~rescue/\" target=\"$link\">MiniBBS v7.5</a> is Free.</h4>\n";
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
# 書き込み処理サブルーチン ############################################################
|
||||
sub regist {
|
||||
|
||||
# 内容がスペースならリロード
|
||||
if ($FORM{'value'} eq "") { &html; }
|
||||
|
||||
# 別のページからこのＣＧＩへの投稿を排除する処理
|
||||
$ref = $ENV{'HTTP_REFERER'};
|
||||
$ref_url = $cgiurl; $ref_url =~ s/\~/.*/g;
|
||||
if (!($ref =~ /$ref_url/i)) { &error(form); }
|
||||
|
||||
# 入力されたデータのチェック ##################################
|
||||
if ($FORM{'bgcolor'} eq "") { &error(1); }
|
||||
if ($FORM{'def'} eq "") { &error(1); }
|
||||
if ($FORM{'name'} eq "") { $FORM{'name'} = ''; }
|
||||
if ($FORM{'email'} =~ /,/) { &error(4); }
|
||||
if ($FORM{'email'} ne "") { if (!($FORM{'email'} =~ /(.*)\@(.*)\.(.*)/)) { &error(3); }}
|
||||
if ($FORM{'subject'} eq "") { $FORM{'subject'} = ' '; }
|
||||
|
||||
if ($FORM{'page'} eq "" || $FORM{'page'} eq "http://") { $FORM{'page'} = ''; }
|
||||
else{
|
||||
$FORM{'page'} =~ s/\s//g;$FORM{'page'} =~ s/\"//g;$FORM{'page'} =~ s/\'//g;
|
||||
$FORM{'page'} =~ s/http\:\/\/http\:\/\//http\:\/\//g;
|
||||
}
|
||||
# 行数制限
|
||||
if ($max_line) {
|
||||
$value_size = ($FORM{'value'} =~ tr/\r/\r/) + 1; # \r の数を数える
|
||||
if ($value_size > $max_line) { &error(1); }
|
||||
}
|
||||
# 文字数制限
|
||||
if ($max_v) {
|
||||
$value_size = length($FORM{'value'});
|
||||
if ($value_size > $max_v) { &error(1); }
|
||||
}
|
||||
|
||||
# プロテクトコードチェック
|
||||
if ( $FORM{'protect'} ne '' ) {
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pcheck ) = ( $FORM{'protect'} - $protect_c ) / $protect_b - $protect_a;
|
||||
|
||||
( $csec, $cmin, $chour, $cmday, $cmon, $cyear, $cwday, $cyday, $cisdat )
|
||||
= localtime ( $pcheck );
|
||||
$cyear += 1900;
|
||||
$cmon++;
|
||||
local ( $cnowdate ) = sprintf ( "%d/%02d/%02d(%s)%02d時%02d分%02d秒",
|
||||
$cyear, $cmon, $cmday,
|
||||
( '日', '月', '火', '水', '木', '金', '土' )[$cwday],
|
||||
$chour, $cmin, $csec );
|
||||
if (
|
||||
( $csec < 0 ) || ( $csec > 60 ) ||
|
||||
( $cmin < 0 ) || ( $cmin > 60 ) ||
|
||||
( $chour < 0 ) || ( $chour > 24 ) ||
|
||||
( ( $ptime - $pcheck ) > 1 * 60 * 60 ) ) { # １時間
|
||||
&error ( 'xxx' );
|
||||
}
|
||||
} else {
|
||||
&error ( 'xxx' );
|
||||
}
|
||||
|
||||
# 過去ログのファイルサイズチェック
|
||||
if ( ( -s $filedate ) > $maxoldlogsize ) {
|
||||
&error (0);
|
||||
}
|
||||
|
||||
# 投稿者名チェック
|
||||
$formname = $FORM{'name'};
|
||||
# if ($formname eq "$nameng"){ &error(xx); }
|
||||
if ($formname eq "$pass"){$formname = $namez; $FORM{'email'} = $mailadd;}
|
||||
else {
|
||||
$formname =~ s/$namez/<small>しば<\/small>/g;
|
||||
# $formname =~ s/しぱ/しは゜/g;
|
||||
}
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
open (DB,"+<$file") || &error (0);
|
||||
eval 'flock (DB, 2)';
|
||||
@lines = <DB>;
|
||||
|
||||
# 最大保持記録数の処理
|
||||
$i = 0;
|
||||
foreach $line (@lines) {
|
||||
$i++;
|
||||
if ($i == $max) { last; }
|
||||
push(@new,$line);
|
||||
}
|
||||
|
||||
# 連続同一内容書き込みチェック
|
||||
$i = 0; $j = 0;
|
||||
while ( ( $i < $check ) && ($j == 0) ) {
|
||||
($date0,$name0,$email0,$value0,$subject0,$hpage0,$himage0,$code0) = split(/\,/,$lines[$i]);
|
||||
if ( $FORM{'value'} eq $value0 ) { $j = 1; }
|
||||
# if (substr($FORM{'value'},0,$checklength) eq substr($value0,0,$checklength)){ $j = 1; }
|
||||
# if (substr($FORM{'value'},1-$checklength,$checklength) eq substr($value0,1-$checklength,$checklength)) { $j = 1; }
|
||||
$i++;
|
||||
}
|
||||
|
||||
# ID生成
|
||||
if ( $lines[0] =~ /^.*,.*,.*,.*,.*,.*,.*,.*,(.*)\n/ ) {
|
||||
$postid = $1 + 1;
|
||||
} else {
|
||||
$postid = 1;
|
||||
}
|
||||
|
||||
if ( $j == 0 ) {
|
||||
$value = "$date_now\,$formname\,$FORM{'email'}\,$FORM{'value'}\,$FORM{'subject'}\,$FORM{'page'}\,$FORM{'image'},$FORM{'code'},$postid\n";
|
||||
unshift(@new,$value);
|
||||
|
||||
seek (DB, 0, 0);
|
||||
print DB @new;
|
||||
eval 'flock (DB, 8)';
|
||||
close (DB);
|
||||
|
||||
# 過去ログ出力
|
||||
########################
|
||||
$FORM{'value'} =~ s/\0/\,/g;
|
||||
open(LOG,">>$filedate") || &error(0);
|
||||
eval 'flock (LOG, 2)';
|
||||
|
||||
|
||||
if (-z LOG) {
|
||||
# ファイルが空の場合はHTMLヘッダを付ける
|
||||
print LOG "<html>\n<body bgcolor=\"#007f7f\" text=\"#$textc\" link=\"#$linkc\" vlink=\"#$vlinkc\" alink=\"#$alinkc\">\n<hr>";
|
||||
|
||||
# 保存後５日を過ぎた過去ログファイルは削除
|
||||
( $oldsec, $oldmin, $oldhour, $oldmday, $oldmonth, $oldyear, $oldwday, $oldyday, $oldisdst )
|
||||
= localtime ( time + $tim - 5 * 60 * 60 * 24 );
|
||||
$oldmonth += 1;
|
||||
$oldlogfilename = sprintf ( "%s%d%02d%02d%s", $logfile, $oldyear, $oldmonth, $oldmday, $logfiledat );
|
||||
unlink $oldlogfilename;
|
||||
}
|
||||
|
||||
print LOG "<font size=+1 color=\"#$subjc\"><b>$FORM{'subject'}</b></font>";
|
||||
# メールアドレスが記録されているデータにはリンクを付ける
|
||||
if ($FORM{'email'} ne '') { print LOG " 投稿者：<b><a href=\"mailto:$FORM{'email'}\">$formname</a></b>\n"; }
|
||||
else { print LOG " 投稿者：<font color=\"#$subjc\"><b>$formname</b></font>\n"; }
|
||||
print LOG "<font size=-1> 投稿日：$date_now";
|
||||
|
||||
$FORM{'value'} =~ s/(https?|ftp|gopher|telnet|whois|news):\/\/([\w|\!\#\$\%\&\'\(\)\=\-\^\`\\\|\@\~\[\{\]\}\;\+\:\*\,\.\?\/]+)/<a href=\"$1:\/\/$2\" target=\"$jump\">$1:\/\/$2<\/a>/g;
|
||||
|
||||
|
||||
print LOG "</font><blockquote><pre>$FORM{'value'}</pre><p>\n\n";
|
||||
|
||||
# ＵＲＬが記録されているデータにはリンクを付ける
|
||||
if ($FORM{'page'} ne '') {
|
||||
$page0 = $FORM{'page'};
|
||||
$page0 =~ s/$cgiurl\?action=search1\&search=(.*)\&id=\d*/参考：$1/;
|
||||
if ( $FORM{'page'} eq $page0 ) {
|
||||
print LOG "<a href=\"$FORM{'page'}\" target=\"jump\">$page0</a><p>\n";
|
||||
} else {
|
||||
print LOG "<font color=\"#$linkc\"><u>$page0</u></font><p>\n";
|
||||
}
|
||||
}
|
||||
print LOG "</blockquote>\n<hr>";
|
||||
|
||||
eval 'flock (LOG, 8)';
|
||||
close(LOG);
|
||||
|
||||
# if (!open(BD,">>./0000.txt")) {error(0); }
|
||||
# print BD "$date_now\,$FORM{'subject'}\,$host\n";
|
||||
# while ( ($a,$b) = each %ENV) {print BD "$a=$b\,";}
|
||||
# print BD "\n";
|
||||
# close(BD);
|
||||
|
||||
} else {
|
||||
eval 'flock (LOG, 8)';
|
||||
close(LOG);
|
||||
}
|
||||
|
||||
# 記録処理後、再読み込みする
|
||||
if ( $FORM{'follow'} ne "on" ) { &html; }
|
||||
else {
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>かきこみ完了</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<h1>かきこみ完了</h1>\n";
|
||||
exit;
|
||||
}
|
||||
# print "Location: $cgiurl" . '?' . "\n\n";
|
||||
# exit;
|
||||
}
|
||||
|
||||
# フォロー投稿サブルーチン（search1） ############################################
|
||||
sub search1 {
|
||||
|
||||
#--- 入力フォーム画面 --------------------------------#
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$FORM{search}に返信</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
# バナーはここ
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
if (!open(DB,"$file")) { &error(0); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0; $i = 0;
|
||||
while (($f == 0) && ($i < $accesses)){
|
||||
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$lines[$i]);
|
||||
chop ($postid) if $postid =~ /\n/;
|
||||
if ($postid eq $FORM{id}) { $f = 1;}
|
||||
$i++;
|
||||
}
|
||||
|
||||
if ($f == 1){
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
|
||||
&disp;
|
||||
print "<hr>\n";
|
||||
|
||||
$value =~ s/\r/\r> /g;
|
||||
$value ="> $value";
|
||||
$value =~ s/> > >.*?\r//g;
|
||||
print "<p>\n";
|
||||
|
||||
|
||||
|
||||
# プロテクトキー生成
|
||||
local ( $ptime ) = time + $tim * 60 * 60;
|
||||
local ( $pkey ) = ( $ptime + $protect_a ) * $protect_b + $protect_c;
|
||||
|
||||
print "<form method=$method action=\"$cgiurl\">\n";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">\n";
|
||||
|
||||
if ($FORM{'link'} ne '') { $link = $FORM{'link'}; }
|
||||
|
||||
if ($FORM{'link'} ne '_top') { print "<input type=hidden name=\"follow\" value=\"on\">\n"; }
|
||||
print "投稿者 <input type=text name=\"name\" size=20 maxlength=20><br>";
|
||||
print "メール <input type=text name=\"email\" size=30><br>\n";
|
||||
print "題名 <input type=text name=\"subject\" size=30 value=\"＞$name\"> \n";
|
||||
print "<input type=submit value=\" 投稿 \"><input type=reset value=\"消す\"><p>\n";
|
||||
|
||||
|
||||
print "<input type=hidden name=\"def\" value=\"$defnext\">\n";
|
||||
print "<input type=hidden name=\"image\" value=\"$acid\">\n";
|
||||
print "<input type=hidden name=\"link\" value=\"$FORM{link} \">\n";
|
||||
|
||||
# プロテクトコード出力
|
||||
print "<input type=hidden name=\"protect\" value=\"$pkey\">\n";
|
||||
|
||||
print "内容<i>（タグは使えません。\n";
|
||||
print "内容を書かずに投稿ボタンを押すとリロードになります。）</i><br>\n";
|
||||
|
||||
print "<textarea name=\"value\" rows=5 cols=70>$value\r";
|
||||
|
||||
# if ($hpage ne '') { print ">\r> $hpage\r"; }
|
||||
|
||||
print "</textarea><p>\n";
|
||||
print "<input type=hidden name=\"code\" value=\"$code\">\n";
|
||||
print "<input type=hidden name=\"page\" size=70 value=\"$cgiurl\?action\=search1\&search\=$date\&id=$postid\">\n";
|
||||
print "<input type=hidden name=\"bgcolor\" value=\"$bgc\"></form><p>\n"; }
|
||||
else { print "みつかりません<br>";}
|
||||
|
||||
print "<hr></body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# 投稿者名サーチ用サブルーチン（search2） ############################################
|
||||
sub search2 {
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$FORM{search}の投稿一覧</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
# バナーはここ
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
if (!open(DB,"$file")) { &error(0); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0;
|
||||
foreach ( @lines ){
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$_);
|
||||
if ( $name eq $FORM{search} ) {
|
||||
$f = 1;
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
&disp;
|
||||
}
|
||||
}
|
||||
|
||||
if ($f == 0){ print "みつかりません<br>";}
|
||||
|
||||
print "<hr></body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# トピックサーチ用サブルーチン（search3） ############################################
|
||||
sub search3 {
|
||||
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>スレッド一覧</title></head>\n";
|
||||
print "$body\n";
|
||||
|
||||
|
||||
#--- 記録記事の出力 ----------------------------------#
|
||||
|
||||
# 記録ファイルを読み出しオープンして、配列<@lines>に格納する
|
||||
if (!open(DB,"$file")) { &error(0); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$accesses = @lines;
|
||||
$f = 0;
|
||||
foreach ( @lines ){
|
||||
# データを各変数に代入する
|
||||
($date,$name,$email,$value,$subject,$hpage,$himage,$code,$postid) = split(/\,/,$_);
|
||||
|
||||
if ( $code eq $FORM{search} ) {
|
||||
$f = 1;
|
||||
$value =~ s/\0/\,/g; # ヌルコードに変換記録した半角カンマを復帰させる
|
||||
chop($himage) if $himage =~ /\n/;
|
||||
chop($hpage) if $hpage =~ /\n/;
|
||||
&disp;
|
||||
}
|
||||
}
|
||||
|
||||
if ($f == 0){ print "みつかりません<br>";}
|
||||
|
||||
print "<hr></body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
# 各投稿表示用サブルーチン #############################################################
|
||||
sub disp {
|
||||
|
||||
$hpage0 =$hpage;
|
||||
$hpage0 =~ s/$cgiurl\?action=search1\&search=(.*)\&id=\d*/参考：$1/;
|
||||
print "<hr>";
|
||||
print "<font size=+1 color=\"#$subjc\"><b>$subject</b></font> ";
|
||||
|
||||
|
||||
if ($email ne '') { print "投稿者：<b><a href=\"mailto:$email\">$name</a></b>\n"; }
|
||||
else { print "投稿者：<b>$name</b></font>\n"; }
|
||||
|
||||
print "<font size=-1> 投稿日：$date";
|
||||
|
||||
print " <a href=\"$cgiurl\?bgcolor\=$bgc\&action\=search1\&search\=$date\&id=$postid\" target=\"$link\">■</a>";
|
||||
print " <a href=\"$cgiurl\?bgcolor\=$bgc\&action\=search2\&search\=$name\" target=\"$link\">★</a>";
|
||||
if ($himage ne '0') { print " <a href=\"$cgiurl\?bgcolor\=$bgc\&action\=search3\&search\=$code\" target=\"$link\">◆</a>\n"; }
|
||||
print "</font><p>\n";
|
||||
|
||||
if ($FORM{search} eq '') {
|
||||
$value =~ s/(https?|ftp|gopher|telnet|whois|news):\/\/([\w|\!\#\$\%\&\'\(\)\=\-\^\`\\\|\@\~\[\{\]\}\;\+\:\*\,\.\?\/]+)/<a href=\"$1:\/\/$2\" target=\"$link\">$1:\/\/$2<\/a>/g;
|
||||
|
||||
}
|
||||
|
||||
|
||||
print "<blockquote><pre>$value</pre><p>\n\n";
|
||||
|
||||
if ($hpage ne '') { print "<a href=\"$hpage\" target=\"$link\">$hpage0</a><p>\n"; }
|
||||
|
||||
print "</blockquote>\n";
|
||||
}
|
||||
|
||||
|
||||
# エラー処理サブルーチン ############################################################
|
||||
sub error {
|
||||
|
||||
# &error(xx); で呼び出されたルーチンは、()内の数字が $error に代入される。
|
||||
|
||||
$error = $_[0];
|
||||
|
||||
if ($error eq "0") { $error_msg = '記録ファイルの入出力にエラーが発生しました。'; }
|
||||
elsif ($error eq "2") { $error_msg = '内容が書かれていません。または記録禁止のタグが書かれています。'; }
|
||||
elsif ($error eq "3") { $error_msg = 'メールアドレスが正しく入力されていません。'; }
|
||||
elsif ($error eq "4") { $error_msg = 'メールアドレスは複数指定できません。'; }
|
||||
elsif ($error eq "5") { $error_msg = '投稿内容が大きすぎます。'; }
|
||||
elsif ($error eq "form") { $error_msg = "投稿画面のＵＲＬが<br>$cgiurl<br>" . '以外からの投稿はできません。'; }
|
||||
elsif ($error eq "x") { $error_msg = "以下の情報が記録されました。けけ"; }
|
||||
elsif ($error eq "xx") { $error_msg = "かわいそう"; }
|
||||
elsif ($error eq 'xxx') { $error_msg = ' '; }
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<h3>$error_msg</h3>\n";
|
||||
|
||||
if ($error eq "x") {
|
||||
while ( ($a,$b) = each %ENV) {
|
||||
print "$a=$b<br><br>\n";
|
||||
}
|
||||
}
|
||||
|
||||
if ($error eq "xx") {
|
||||
print "<table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td>\n";
|
||||
print "<table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td>\n";
|
||||
print "<table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td>\n";
|
||||
print "<table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td>\n";
|
||||
print "<table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td>\n";
|
||||
print "<table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td><table><tr><td>\n";
|
||||
print "</td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table>\n";
|
||||
print "</td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table>\n";
|
||||
print "</td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table>\n";
|
||||
print "</td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table>\n";
|
||||
print "</td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table>\n";
|
||||
print "</td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table></td></tr></table>\n";
|
||||
}
|
||||
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# カウンター処理サブルーチン #########################################################
|
||||
sub counter {
|
||||
|
||||
for( $i=0 ; $i < $countlevel ; $i++){
|
||||
open(IN,"$countfile$i$countfiledat");
|
||||
$count[$i] = <IN>;
|
||||
$filenumber[$count[$i]] = $i;
|
||||
close(IN);
|
||||
}
|
||||
@sortedcount = sort by_number @count;
|
||||
$maxcount = $sortedcount[$countlevel-1];
|
||||
$mincount = $sortedcount[0];
|
||||
|
||||
$maxcount++;
|
||||
print $maxcount;
|
||||
|
||||
open(OUT,">$countfile$filenumber[$mincount]$countfiledat");
|
||||
print OUT $maxcount;
|
||||
close(OUT);
|
||||
}
|
||||
|
||||
sub by_number {
|
||||
$a <=> $b;
|
||||
}
|
||||
|
||||
#end_of_script
|
||||
255
[1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/getlogcgi.txt
Normal file
255
[1999-01-24 - 1999-04-09] REBIRTH (aka Haruna)/getlogcgi.txt
Normal file
|
|
@ -0,0 +1,255 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#はじあや＠ふぁみーるのパソヲタさん、本当にありがとう
|
||||
|
||||
|
||||
#--------------------
|
||||
|
||||
$body = '<body bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">';
|
||||
$bbstitle ="あやしいわーるど＠はるな";
|
||||
|
||||
|
||||
$logdir = './log/';
|
||||
|
||||
$cgiurl = 'getlog.cgi';
|
||||
$action ='getlog';
|
||||
|
||||
$bbsurl = './bbs.cgi';
|
||||
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
|
||||
# キーワードの最大文字数（半角）
|
||||
$keylength = 64;
|
||||
|
||||
# 時差 サーバの時計がずれてる時や日本時間以外にしたい時に使う
|
||||
$tim = 0;
|
||||
|
||||
$\ = "\n";
|
||||
|
||||
#--------------------
|
||||
|
||||
#if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
#else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
|
||||
@argv = split(/&/,$buffer);
|
||||
foreach (@argv) {
|
||||
($name, $value) = split(/=/);
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
# 処理の都合上の処理
|
||||
$value =~ s/\\/\\\\/;
|
||||
$value =~ s/\[/\\[/;
|
||||
|
||||
$COMMAND{$name} = $value;
|
||||
}
|
||||
|
||||
|
||||
&error(2) if (length($COMMAND{'keyword'}) > $keylength);
|
||||
&viewlog if ($COMMAND{'action'} eq "$action");
|
||||
|
||||
|
||||
&list;
|
||||
|
||||
sub list {
|
||||
|
||||
&error(0) if(!opendir(DIR, $logdir));
|
||||
|
||||
@files=readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
@files = sort by_number @files;
|
||||
$end = @files;
|
||||
$end--;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<center><font size=+1><b>$bbstitle 過去ログ</b></font><hr>\n";
|
||||
|
||||
print "<form method=get action=\"$cgiurl\">";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">";
|
||||
print "<table>";
|
||||
#print "<tr><td></td><td>ファイル名</td><td align=right>サイズ</td><td align=center>日付</td></tr>";
|
||||
foreach (0 .. $end) {
|
||||
if (!($files[$_] eq "." or $files[$_] eq "..")) {
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$logdir$files[$_]";
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($mtime + 32400 + $tim);
|
||||
$mon++;
|
||||
$mon = "0$mon" if ($mon < 10);
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
$checked = ' checked' if ($_ == $end);
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$files[$_]\"$checked></td>";
|
||||
print "<td><a href=\"$logdir$files[$_]\">$files[$_]</a></td>";
|
||||
print "<td align=right>$size\ byte</td>";
|
||||
}
|
||||
}
|
||||
|
||||
print "<tr><td></td></tr><tr><td colspan=4>※ラジオボタンでファイル名を指定してください。</td></tr><tr><td></td></tr>\n";
|
||||
print "<tr><td colspan=4><select name=\"first\">";
|
||||
print "<option value=\"0\">最初";
|
||||
print "<option value=\"1\">1";
|
||||
print "<option value=\"2\">2";
|
||||
print "<option value=\"3\">3";
|
||||
print "<option value=\"4\">4";
|
||||
print "<option value=\"5\">5";
|
||||
print "<option value=\"6\">6";
|
||||
print "<option value=\"7\">7";
|
||||
print "<option value=\"8\">8";
|
||||
print "<option value=\"9\">9";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>から";
|
||||
print "<select name=\"last\">";
|
||||
print "<option value=\"24\">最後";
|
||||
print "<option value=\"1\">1";
|
||||
print "<option value=\"2\">2";
|
||||
print "<option value=\"3\">3";
|
||||
print "<option value=\"4\">4";
|
||||
print "<option value=\"5\">5";
|
||||
print "<option value=\"6\">6";
|
||||
print "<option value=\"7\">7";
|
||||
print "<option value=\"8\">8";
|
||||
print "<option value=\"9\">9";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>まで <input type=submit value=\"Get\"><p>";
|
||||
print "<select name=\"searchmode\">";
|
||||
print "<option value=\"name\">投稿者";
|
||||
print "<option value=\"keyword\">内容";
|
||||
print "<option value=\"subject\">題名\n</select>";
|
||||
print "：<input type=text name=\"keyword\" size=\"12\" maxlength=$keylength>";
|
||||
print "<input type=submit value=\"Search\"></td></tr></form>";
|
||||
print "</table>";
|
||||
print "<hr>";
|
||||
print "現在ベータテスト中です。バグを見つけたら掲示板に書いてね";
|
||||
print "<p align=center><a href=\"$bbsurl\">掲示板へ</a></p>";
|
||||
print "<h4 align=right>Getlog Ver0.3b3</h4>";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub viewlog {
|
||||
|
||||
if (!open(DB,"$logdir$COMMAND{'logfile'}")) { &error(1); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
$COMMAND{'last'} = $COMMAND{'first'} + 1 if ($COMMAND{'first'} >= $COMMAND{'last'});
|
||||
$first = $COMMAND{'first'};
|
||||
$last = $COMMAND{'last'};
|
||||
|
||||
$first = "0$COMMAND{'first'}" if ($first < 10);
|
||||
$last = "0$COMMAND{'last'}" if ($last < 10);
|
||||
|
||||
if ($COMMAND{'searchmode'} eq 'name') { $keyword = "投稿者：.*>${COMMAND{'keyword'}}<"; }
|
||||
elsif ($COMMAND{'searchmode'} eq 'subject') { $keyword = "color=\"#ffffee\"><b>${COMMAND{'keyword'}}</b></font>"; }
|
||||
else { $keyword = $COMMAND{'keyword'}; }
|
||||
|
||||
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ $COMMAND{'logfile'}</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$COMMAND{'logfile'} $first時～$last時</h1>";
|
||||
$end = @lines;
|
||||
$end--;
|
||||
foreach (0 .. $end) {
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
$hour = substr( $lines[$_], 36, 4 );
|
||||
last if ($hour ge "$first時");
|
||||
}
|
||||
$skip++;
|
||||
}
|
||||
$skip--;
|
||||
foreach ($skip .. $end) {
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
$hour = substr( $lines[$_], 36, 4 );
|
||||
last if ($hour ge "$last時");
|
||||
}
|
||||
|
||||
|
||||
if ($keyword ne '') {
|
||||
if ($lines[$_] =~ /$keyword/) {
|
||||
$flag = 1;
|
||||
$hit++;
|
||||
}
|
||||
push( @article, $lines[$_] );
|
||||
if ($lines[$_] =~ /<\/blockquote>/) {
|
||||
print @article if ($flag > 0);
|
||||
splice( @article, 0 );
|
||||
$flag = 0;
|
||||
}
|
||||
}
|
||||
else { print $lines[$_]; }
|
||||
|
||||
}
|
||||
if ($keyword ne '') {
|
||||
print "<hr>";
|
||||
$keyword =~ s/\\\\/\\/;
|
||||
$keyword =~ s/\\\[/\[/;
|
||||
if ( $hit > 0 ) { print "<h3>キーワード「$COMMAND{'keyword'}」は $hit件見つかりました。</h3>"; }
|
||||
else { print "<h3>キーワード「$COMMAND{'keyword'}」は見つかりませんでした。</h3>"; }
|
||||
}
|
||||
print "</body></html>";
|
||||
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub error {
|
||||
|
||||
$error = $_[0];
|
||||
if ($error == 0) { $errmsg = 'ディレクトリが開けませんでした。'; }
|
||||
if ($error == 1) { $errmsg = 'ファイルが開けませんでした。'; }
|
||||
if ($error == 2) { $errmsg = 'キーワードが長すぎます。'; }
|
||||
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>エラー</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$errmsg</h1>";
|
||||
print "</body></html>";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
sub by_number {
|
||||
$a <=> $b;
|
||||
}
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
#
|
||||
|
||||
#ろけーしょん
|
||||
|
||||
#1997.9.14製作
|
||||
|
||||
#すくりぷと ばい ゆいちゃっと
|
||||
|
||||
# Since 1996
|
||||
|
||||
#
|
||||
|
||||
|
||||
|
||||
&decode;
|
||||
|
||||
&html if($url);
|
||||
|
||||
&html2;
|
||||
|
||||
|
||||
|
||||
sub html{
|
||||
|
||||
|
||||
|
||||
print "Location: $url\n\n";
|
||||
|
||||
print "Pragma: no cache\n";
|
||||
|
||||
print "Expires: Thu, 16 Dec 1994 16:00:GMT\n\n";
|
||||
|
||||
exit;
|
||||
|
||||
}#html END
|
||||
|
||||
|
||||
|
||||
sub decode{ #一般的なデコード＆変数への代入
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
@pairs = split(/&/,$buffer);
|
||||
|
||||
foreach $pair (@pairs) {
|
||||
|
||||
($name, $value) = split(/=/, $pair);
|
||||
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
|
||||
$value =~ s/\n//g; $value =~ s/\r//g;
|
||||
|
||||
$FORM{$name} = $value;
|
||||
|
||||
}
|
||||
|
||||
$url = $FORM{'url'};
|
||||
|
||||
}#decode END
|
||||
|
||||
|
||||
|
||||
sub html2{
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
print <<"_HTML_";
|
||||
|
||||
<HTML><HEAD>
|
||||
|
||||
<TITLE>フォームで移動。</TITLE>
|
||||
|
||||
</HEAD></HTML>
|
||||
|
||||
_HTML_
|
||||
|
||||
exit;
|
||||
|
||||
}#html2 END
|
||||
|
||||
__END__
|
||||
1104
[1999-05-04 - present] REMIX/bbs.txt
Normal file
1104
[1999-05-04 - present] REMIX/bbs.txt
Normal file
File diff suppressed because it is too large
Load diff
326
[1999-05-04 - present] REMIX/getlog_m.txt
Normal file
326
[1999-05-04 - present] REMIX/getlog_m.txt
Normal file
|
|
@ -0,0 +1,326 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#はじあや＠ふぁみーるのパソヲタさん、本当にありがとう
|
||||
|
||||
|
||||
#--------------------
|
||||
|
||||
$body = '<body bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">';
|
||||
$bbstitle ="あやしいわーるどREMIX";
|
||||
|
||||
|
||||
$logdir = './log/';
|
||||
|
||||
$cgiurl = 'getlog_m.cgi';
|
||||
$action ='getlog';
|
||||
|
||||
$bbsurl = './bbs.cgi';
|
||||
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
|
||||
# キーワードの最大文字数（半角）
|
||||
$keylength = 64;
|
||||
|
||||
# 時差 サーバの時計がずれてる時や日本時間以外にしたい時に使う
|
||||
$tim = 0;
|
||||
|
||||
$\ = "\n";
|
||||
#--------------------
|
||||
#if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
#else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
|
||||
@argv = split(/&/,$buffer);
|
||||
foreach (@argv) {
|
||||
($name, $value) = split(/=/);
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
$COMMAND{$name} = $value;
|
||||
}
|
||||
|
||||
|
||||
&error(2) if (length($COMMAND{'keyword'}) > $keylength);
|
||||
&viewlog if ($COMMAND{'action'} eq "$action");
|
||||
|
||||
|
||||
&list;
|
||||
|
||||
sub list {
|
||||
|
||||
&error(0) if(!opendir(DIR, $logdir));
|
||||
|
||||
@files=readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
@files = sort by_number @files;
|
||||
$end = @files;
|
||||
$end--;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<center>\n";
|
||||
print "<table border=0 cellpadding=1 cellspacing=1 width=100%><tr>";
|
||||
print "<td bgcolor=007f7f align=center><font color=ffffff><b>$bbstitle 過去ログ一覧</b></font></td></tr></table>";
|
||||
print "<form method=get action=\"$cgiurl\">";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">";
|
||||
print "<table>";
|
||||
print "<tr><td></td><td>ファイル名</td><td align=right>サイズ</td><td align=center>日付</td></tr>";
|
||||
foreach (0 .. $end) {
|
||||
if (!($files[$_] eq "." or $files[$_] eq "..")) {
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$logdir$files[$_]";
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($mtime + 32400 + $tim);
|
||||
$mon++;
|
||||
$mon = "0$mon" if ($mon < 10);
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
$checked = ' checked' if ($_ == $end);
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$files[$_]\"$checked></td>";
|
||||
print "<td><a href=\"$logdir$files[$_]\">$files[$_]</a></td>";
|
||||
print "<td align=right>$size</td><td align=center>$mon/$mday $hour:$min</td></tr>";
|
||||
}
|
||||
}
|
||||
|
||||
print "<tr><td></td></tr><tr><td colspan=4>※ラジオボタンでファイル名を指定してください。</td></tr><tr><td></td></tr>\n";
|
||||
print "<tr><td colspan=4>日時指定：<select name=\"day1\">";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"26\">26";
|
||||
print "<option value=\"27\">27";
|
||||
print "<option value=\"28\">28";
|
||||
print "<option value=\"29\">29";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"31\">31";
|
||||
print "</select>日<select name=\"hour1\">";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時から";
|
||||
|
||||
print "<select name=\"day2\">";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"26\">26";
|
||||
print "<option value=\"27\">27";
|
||||
print "<option value=\"28\">28";
|
||||
print "<option value=\"29\">29";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"31\" selected>31";
|
||||
print "</select>日<select name=\"hour2\">";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時まで";
|
||||
|
||||
print "</td></tr><br>";
|
||||
print " <tr><td colspan=4> 検索 ：<select name=\"searchmode\">";
|
||||
print "<option value=\"keyword\">全文";
|
||||
print "<option value=\"bbs\">掲示板名";
|
||||
print "<option value=\"name\">投稿者名";
|
||||
print "<option value=\"subject\">題名\n</select>";
|
||||
print "<input type=text name=\"keyword\" size=\"24\" maxlength=$keylength></td></tr>";
|
||||
print "<tr><td colspan=4 align=center><input type=submit value=\"Get / Search\"></form></td></tr><br>";
|
||||
print "</table>";
|
||||
print "<hr>";
|
||||
print "<p align=center><a href=\"$bbsurl\">掲示板へ</a></p>";
|
||||
print "<h4 align=right>Getlog Ver0.3b4 月単位保存ログ対応版</h4>";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub viewlog {
|
||||
|
||||
if (!open(DB,"$logdir$COMMAND{'logfile'}")) { &error(1); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$COMMAND{'last'} = $COMMAND{'first'} + 1 if ($COMMAND{'first'} >= $COMMAND{'last'});
|
||||
$first = "$COMMAND{'day1'}日$COMMAND{'hour1'}時";
|
||||
$last = "$COMMAND{'day2'}日$COMMAND{'hour2'}時";
|
||||
|
||||
if ($COMMAND{'searchmode'} eq 'name') { $keyword = "投稿者：.*>${COMMAND{'keyword'}}<"; }
|
||||
|
||||
elsif ($COMMAND{'searchmode'} eq 'subject') { $keyword = "color=\"#ffffee\"><b>${COMMAND{'keyword'}}</b></font>"; }
|
||||
|
||||
elsif ($COMMAND{'searchmode'} eq 'bbs') { $keyword = "秒 .*>${COMMAND{'keyword'}}<"; }
|
||||
|
||||
else { $keyword = $COMMAND{'keyword'}; }
|
||||
if ($keyword ne '') {
|
||||
$keyword =~ s/\\/\\\\/;
|
||||
$keyword =~ s/\[/\\[/;
|
||||
}
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ $COMMAND{'logfile'}</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$COMMAND{'logfile'} $first～$last</h1>";
|
||||
$end = @lines;
|
||||
$end--;
|
||||
foreach (0 .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
substr( $hour = substr( $lines[$_], 28, 12 ), 4, 4 ) = "" ;
|
||||
last if ($hour ge "$first");
|
||||
}
|
||||
$skip++;
|
||||
}
|
||||
$skip--;
|
||||
# print"<hr>";
|
||||
$\ = '';
|
||||
foreach ($skip .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
substr( $hour = substr( $lines[$_], 28, 12 ), 4, 4 ) = "" ;
|
||||
|
||||
last if ($hour ge "$last");
|
||||
}
|
||||
|
||||
|
||||
if ($keyword ne '') {
|
||||
if ($lines[$_] =~ /$keyword/) {
|
||||
$flag = 1;
|
||||
$hit++;
|
||||
}
|
||||
push( @article, $lines[$_] );
|
||||
if ($lines[$_] =~ /<\/blockquote>/) {
|
||||
print @article if ($flag > 0);
|
||||
splice( @article, 0 );
|
||||
$flag = 0;
|
||||
}
|
||||
}
|
||||
else { print $lines[$_]; }
|
||||
|
||||
}
|
||||
$\ = "\n";
|
||||
if ($COMMAND{'keyword'} ne '') {
|
||||
print "<hr>";
|
||||
if ( $hit > 0 ) { print "<h3>「$COMMAND{'keyword'}」は $hit件見つかりました。</h3>"; }
|
||||
else { print "<h3>「$COMMAND{'keyword'}」は見つかりませんでした。</h3>"; }
|
||||
}
|
||||
print "</body></html>";
|
||||
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub error {
|
||||
|
||||
$error = $_[0];
|
||||
if ($error == 0) { $errmsg = 'ディレクトリが開けませんでした。'; }
|
||||
if ($error == 1) { $errmsg = 'ファイルが開けませんでした。'; }
|
||||
if ($error == 2) { $errmsg = 'キーワードが長すぎます。'; }
|
||||
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>エラー</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$errmsg</h1>";
|
||||
print "</body></html>";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
sub by_number {
|
||||
$a <=> $b;
|
||||
}
|
||||
618
[1999-05-04 - present] REMIX/jcode.txt
Normal file
618
[1999-05-04 - present] REMIX/jcode.txt
Normal file
|
|
@ -0,0 +1,618 @@
|
|||
package jcode;
|
||||
;######################################################################
|
||||
;#
|
||||
;# jcode.pl: Perl library for Japanese character code conversion
|
||||
;#
|
||||
;# Copyright (c) 1995,1996 Kazumasa Utashiro <utashiro@iij.ad.jp>
|
||||
;# Internet Initiative Japan Inc.
|
||||
;# 1-4 Sanban-cho, Chiyoda-ku, Tokyo 102, Japan
|
||||
;#
|
||||
;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
|
||||
;# Software Research Associates, Inc.
|
||||
;# Original by srekcah@sra.co.jp, Feb 1992
|
||||
;#
|
||||
;# Redistribution for any purpose, without significant modification,
|
||||
;# is granted as long as all copyright notices are retained. THIS
|
||||
;# SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
|
||||
;# IMPLIED WARRANTIES ARE DISCLAIMED.
|
||||
;#
|
||||
;; $rcsid = q$Id: jcode.pl,v 2.0 1996/10/02 16:02:38 utashiro Rel $;
|
||||
;#
|
||||
;######################################################################
|
||||
;#
|
||||
;# INTERFACE:
|
||||
;#
|
||||
;# &jcode'getcode(*line)
|
||||
;# Return 'jis', 'sjis', 'euc' or undef according to
|
||||
;# Japanese character code in $line. Return 'binary' if
|
||||
;# the data has non-character code.
|
||||
;#
|
||||
;# Code detection between euc and sjis is very difficult
|
||||
;# or sometimes impossible or even lead to wrong result
|
||||
;# when it's include JIS X0201 KANA characters. So JIS
|
||||
;# X0201 KANA is ignored for automatic code detection.
|
||||
;#
|
||||
;# &jcode'convert(*line, $ocode [, $icode [, $option]])
|
||||
;# Convert the line in any Japanese code to the specified
|
||||
;# code in the second argument $ocode. $ocode can be any
|
||||
;# of "jis", "sjis" or "euc", or use "noconv" when you
|
||||
;# don't want the code conversion. Input code is
|
||||
;# recognized automatically from the line itself when
|
||||
;# $icode is not supplied (JIS X0201 KANA is ignored.
|
||||
;# See above). $icode also can be specified, but xxx2yyy
|
||||
;# routine is more efficient when both codes are known.
|
||||
;#
|
||||
;# It returns a list of pointer of convert subroutine and
|
||||
;# input code. It means that this routine returns the
|
||||
;# input code of the line in scalar context.
|
||||
;#
|
||||
;# See next paragraph for $option parameter.
|
||||
;#
|
||||
;# &jcode'xxx2yyy(*line [, $option])
|
||||
;# Convert the Japanese code from xxx to yyy. String xxx
|
||||
;# and yyy are any convination from "jis", "euc" or
|
||||
;# "sjis". They return *approximate* number of converted
|
||||
;# bytes. So return value 0 means the line was not
|
||||
;# converted at all.
|
||||
;#
|
||||
;# Optional parameter $option is used to specify optional
|
||||
;# conversion method. String "z" is for JIS X0201 KANA
|
||||
;# to X0208 KANA, and "h" is for reverse.
|
||||
;#
|
||||
;# $jcode'convf{'xxx', 'yyy'}
|
||||
;# The value of this associative array is pointer to the
|
||||
;# subroutine jcode'xxx2yyy().
|
||||
;#
|
||||
;# &to($ocode, $line [, $icode [, $option]])
|
||||
;# &jis($line [, $icode [, $option]])
|
||||
;# &euc($line [, $icode [, $option]])
|
||||
;# &sjis($line [, $icode [, $option]])
|
||||
;# These functions are prepared for easy use of
|
||||
;# call/return-by-value interface. You can use these
|
||||
;# funcitons in s///e operation or any other place for
|
||||
;# convenience.
|
||||
;#
|
||||
;# &jcode'jis_inout($in, $out)
|
||||
;# Set or inquire JIS start and end sequences. Default
|
||||
;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
|
||||
;# character, "ESC-$" or "ESC-(" is added as a prefix
|
||||
;# for each character respectively. Acutually "ESC-(-B"
|
||||
;# is not a sequence to end JIS code but a sequence to
|
||||
;# start ASCII code set. So `in' and `out' are somewhat
|
||||
;# misleading.
|
||||
;#
|
||||
;# &jcode'get_inout($string)
|
||||
;# Get JIS start and end sequences from $string.
|
||||
;#
|
||||
;# &jcode'cache()
|
||||
;# &jcode'nocache()
|
||||
;# &jcode'flush()
|
||||
;# Usually, converted character is cached in memory to
|
||||
;# avoid same calculations have to be done many times.
|
||||
;# To disable this caching, call &jcode'nocache(). It
|
||||
;# can be revived by &jcode'cache() and cache is flushed
|
||||
;# by calling &jcode'flush(). &cache() and &nocache()
|
||||
;# functions return previous caching state.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'h2z_xxx(*line);
|
||||
;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
|
||||
;# (Zenkaku-KANA) code conversion routine. String xxx is
|
||||
;# any of "jis", "sjis" and "euc". From the difficulty
|
||||
;# of recognizing code set from 1-byte KATAKANA string,
|
||||
;# automatic code recognition is not supported.
|
||||
;#
|
||||
;# &jcode'z2h_xxx(*line);
|
||||
;# X0208 to X0201 KANA code conversion routine. String
|
||||
;# xxx is any of "jis", "sjis" and "euc".
|
||||
;#
|
||||
;# $jcode'z2hf{'xxx'}
|
||||
;# $jcode'h2zf{'xxx'}
|
||||
;# These are pointer to the corresponding function just
|
||||
;# as $jcode'convf.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'tr(*line, $from, $to [, $option]);
|
||||
;# &jcode'tr emulates tr operator for 2 byte code. This
|
||||
;# funciton is under construction and doesn't have full
|
||||
;# feature of tr. Range operator like a-z is partially
|
||||
;# supported: JIS or EUC and first byte should be same on
|
||||
;# first and last character (so HIRAGANA-KATAKANA
|
||||
;# conversion is possible). Only 'd' is interpreted as
|
||||
;# option.
|
||||
;#
|
||||
;# &jcode'trans($line, $from, $to [, $option);
|
||||
;# Same as &jcode'tr but accept string and return string
|
||||
;# after translation.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'init()
|
||||
;# Initialize the variables used in other functions. You
|
||||
;# don't have to call this when using jocde.pl by do or
|
||||
;# require. Call it first if you embedded the jcode.pl
|
||||
;# in your script.
|
||||
;#
|
||||
;######################################################################
|
||||
;#
|
||||
;# SAMPLES
|
||||
;#
|
||||
;# Convert any Kanji code to JIS and print each line with code name.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# $code = &jcode'convert(*_, 'jis');
|
||||
;# print $code, "\t", $_;
|
||||
;# }
|
||||
;#
|
||||
;# Convert all lines to JIS according to the first recognized line.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# print, next unless /[\033\200-\377]/;
|
||||
;# (*f, $icode) = &jcode'convert(*_, 'jis');
|
||||
;# print;
|
||||
;# defined(&f) || next;
|
||||
;# while (<>) { &f(*_); print; }
|
||||
;# last;
|
||||
;# }
|
||||
;#
|
||||
;# The safest way of JIS conversion.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# ($matched, $code) = &jcode'getcode(*_);
|
||||
;# print, next unless (@buf || $matched);
|
||||
;# push(@readahead, $_);
|
||||
;# next unless $code;
|
||||
;# eval "&jcode'${code}2jis(*_), print while (\$_ = shift(\@buf));";
|
||||
;# eval "&jcode'${code}2jis(*_), print while (\$_ = <>);";
|
||||
;# last;
|
||||
;# }
|
||||
;#
|
||||
;######################################################################
|
||||
|
||||
;#
|
||||
;# Call initialize function if it is not called yet. This may sound
|
||||
;# strange but it makes easy to embed the jcode.pl at the end of
|
||||
;# script. Call &jcode'init at the beginning of the script in that
|
||||
;# case.
|
||||
;#
|
||||
&init unless defined $version;
|
||||
|
||||
;#
|
||||
;# Initialize variables.
|
||||
;#
|
||||
sub init {
|
||||
$version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
|
||||
|
||||
$re_bin = '[\000-\006\177\377]';
|
||||
|
||||
$re_jp = '\e\$[\@B]';
|
||||
$re_asc = '\e\([BJ]';
|
||||
$re_kana = '\e\(I';
|
||||
($esc_jp, $esc_asc, $esc_kana) = ("\e\$B", "\e(B", "\e(I");
|
||||
|
||||
$re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
|
||||
$re_sjis_kana = '[\241-\337]';
|
||||
|
||||
$re_euc_c = '[\241-\376][\241-\376]';
|
||||
$re_euc_kana = '\216[\241-\337]';
|
||||
|
||||
# These variables are retained only for backward compatibility.
|
||||
$re_euc_s = "($re_euc_c)+";
|
||||
$re_sjis_s = "($re_sjis_c)+";
|
||||
|
||||
$cache = 1;
|
||||
|
||||
# X0201 -> X0208 KANA conversion table. Looks weird? Not that
|
||||
# much. This is simply JIS text without escape sequences.
|
||||
($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\021-\176/\221-\376/;
|
||||
! !# $ !" % !& " !V # !W
|
||||
^ !+ _ !, 0 !<
|
||||
' %! ( %# ) %% * %' + %)
|
||||
, %c - %e . %g / %C
|
||||
1 %" 2 %$ 3 %& 4 %( 5 %*
|
||||
6 %+ 7 %- 8 %/ 9 %1 : %3
|
||||
6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
|
||||
; %5 < %7 = %9 > %; ? %=
|
||||
;^ %6 <^ %8 =^ %: >^ %< ?^ %>
|
||||
@ %? A %A B %D C %F D %H
|
||||
@^ %@ A^ %B B^ %E C^ %G D^ %I
|
||||
E %J F %K G %L H %M I %N
|
||||
J %O K %R L %U M %X N %[
|
||||
J^ %P K^ %S L^ %V M^ %Y N^ %\
|
||||
J_ %Q K_ %T L_ %W M_ %Z N_ %]
|
||||
O %^ P %_ Q %` R %a S %b
|
||||
T %d U %f V %h
|
||||
W %i X %j Y %k Z %l [ %m
|
||||
\ %o ] %s & %r 3^ %t
|
||||
__TABLE_END__
|
||||
%h2z = split(/\s+/, $h2z . $h2z_high);
|
||||
%z2h = reverse %h2z;
|
||||
|
||||
$_ = '';
|
||||
for $f ('jis', 'sjis', 'euc') {
|
||||
for $t ('jis', 'sjis', 'euc') {
|
||||
$_ .= "\$convf{'$f', '$t'} = *${f}2${t};\n";
|
||||
}
|
||||
$_ .= "\$h2zf{'$f'} = *h2z_${f};\n\$z2hf{'$f'} = *z2h_${f};\n";
|
||||
}
|
||||
eval $_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Set escape sequences which should be put before and after Japanese
|
||||
;# (JIS X0208) string.
|
||||
;#
|
||||
sub jis_inout {
|
||||
$esc_jp = shift || $esc_jp;
|
||||
$esc_jp = "\e\$$esc_jp" if length($esc_jp) == 1;
|
||||
$esc_asc = shift || $esc_asc;
|
||||
$esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
|
||||
($esc_jp, $esc_asc);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Get JIS in and out sequences from the string.
|
||||
;#
|
||||
sub get_inout {
|
||||
local($esc_jp, $esc_asc);
|
||||
$_[$[] =~ /$re_jp/o && ($esc_jp = $&);
|
||||
$_[$[] =~ /$re_asc/o && ($esc_asc = $&);
|
||||
($esc_jp, $esc_asc);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Recognize character code.
|
||||
;#
|
||||
sub getcode {
|
||||
local(*_) = @_;
|
||||
return undef unless /[\e\200-\377]/;
|
||||
return 'jis' if /$re_jp|$re_asc|$re_kana/o;
|
||||
return 'binary' if /$re_bin/o;
|
||||
|
||||
local($sjis, $euc);
|
||||
$sjis += length($&) while /($re_sjis_c)+/go;
|
||||
$euc += length($&) while /($re_euc_c)+/go;
|
||||
(&max($sjis, $euc), ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1]);
|
||||
}
|
||||
sub max { $_[ $[ + ($_[$[] < $_[$[+1]) ]; }
|
||||
|
||||
;#
|
||||
;# Convert any code to specified code.
|
||||
;#
|
||||
sub convert {
|
||||
local(*_, $ocode, $icode, $opt) = @_;
|
||||
return (undef, undef) unless $icode = $icode || &getcode(*_);
|
||||
return (undef, $icode) if $icode eq 'binary';
|
||||
$ocode = 'jis' unless $ocode;
|
||||
$ocode = $icode if $ocode eq 'noconv';
|
||||
local(*convf) = $convf{$icode, $ocode};
|
||||
do convf(*_, $opt);
|
||||
(*convf, $icode);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Easy return-by-value interfaces.
|
||||
;#
|
||||
sub jis { &to('jis', @_); }
|
||||
sub euc { &to('euc', @_); }
|
||||
sub sjis { &to('sjis', @_); }
|
||||
sub to {
|
||||
local($ocode, $_, $icode, $opt) = @_;
|
||||
&convert(*_, $ocode, $icode, $opt);
|
||||
$_;
|
||||
}
|
||||
sub what {
|
||||
local($_) = @_;
|
||||
&getcode(*_);
|
||||
}
|
||||
sub trans {
|
||||
local($_) = shift;
|
||||
&tr(*_, @_);
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# SJIS to JIS
|
||||
;#
|
||||
sub sjis2jis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&sjis2sjis(*_, $opt) if $opt;
|
||||
if (s/($re_sjis_kana)+|($re_sjis_c)+/&_sjis2jis($&)/geo) {
|
||||
s/$re_asc($re_jp|$re_kana)/$1/go;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _sjis2jis {
|
||||
local($_) = @_;
|
||||
if (/^$re_sjis_kana/o) {
|
||||
$n += tr/\241-\337/\041-\137/;
|
||||
$esc_kana . $_ . $esc_asc;
|
||||
} else {
|
||||
$n += s/$re_sjis_c/$s2e{$&}||&s2e($&)/geo;
|
||||
tr/\241-\376/\041-\176/;
|
||||
$esc_jp . $_ . $esc_asc;
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# EUC to JIS
|
||||
;#
|
||||
sub euc2jis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
if (s/($re_euc_kana)+|($re_euc_c)+/&_euc2jis($&)/geo) {
|
||||
s/$re_asc($re_jp|$re_kana)/$1/go;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _euc2jis {
|
||||
local($_) = @_;
|
||||
local($esc) = tr/\216//d ? $esc_kana : $esc_jp;
|
||||
$n += tr/\241-\376/\041-\176/;
|
||||
$esc . $_ . $esc_asc;
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to EUC
|
||||
;#
|
||||
sub jis2euc {
|
||||
local(*_, $opt, $n) = @_;
|
||||
s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n;
|
||||
}
|
||||
sub _jis2euc {
|
||||
local($esc, $_) = @_;
|
||||
if ($esc !~ /$re_asc/o) {
|
||||
$n += tr/\041-\176/\241-\376/;
|
||||
s/[\241-\337]/\216$&/g if $esc =~ /$re_kana/o;
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to SJIS
|
||||
;#
|
||||
sub jis2sjis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&jis2jis(*_, $opt) if $opt;
|
||||
s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
|
||||
$n;
|
||||
}
|
||||
sub _jis2sjis {
|
||||
local($esc, $_) = @_;
|
||||
if ($esc !~ /$re_asc/o) {
|
||||
$n += tr/\041-\176/\241-\376/;
|
||||
s/$re_euc_c/$e2s{$&}||&e2s($&)/geo if $esc =~ /$re_jp/o;
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# SJIS to EUC
|
||||
;#
|
||||
sub sjis2euc {
|
||||
local(*_, $opt,$n) = @_;
|
||||
$n = s/$re_sjis_kana|$re_sjis_c/$s2e{$&}||&s2e($&)/geo;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n;
|
||||
}
|
||||
sub s2e {
|
||||
local($c1, $c2, $code);
|
||||
($c1, $c2) = unpack('CC', $code = shift);
|
||||
|
||||
if (0xa1 <= $c1 && $c1 <= 0xdf) {
|
||||
$c2 = $c1;
|
||||
$c1 = 0x8e;
|
||||
} elsif (0x9f <= $c2) {
|
||||
$c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
|
||||
$c2 += 2;
|
||||
} else {
|
||||
$c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
|
||||
$c2 += 0x60 + ($c2 < 0x7f);
|
||||
}
|
||||
if ($cache) {
|
||||
$s2e{$code} = pack('CC', $c1, $c2);
|
||||
} else {
|
||||
pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# EUC to SJIS
|
||||
;#
|
||||
sub euc2sjis {
|
||||
local(*_, $opt,$n) = @_;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n = s/$re_euc_c|$re_euc_kana/$e2s{$&}||&e2s($&)/geo;
|
||||
}
|
||||
sub e2s {
|
||||
local($c1, $c2, $code);
|
||||
($c1, $c2) = unpack('CC', $code = shift);
|
||||
|
||||
if ($c1 == 0x8e) {
|
||||
return substr($code, 1, 1);
|
||||
} elsif ($c1 % 2) {
|
||||
$c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
|
||||
$c2 -= 0x60 + ($c2 < 0xe0);
|
||||
} else {
|
||||
$c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
|
||||
$c2 -= 2;
|
||||
}
|
||||
if ($cache) {
|
||||
$e2s{$code} = pack('CC', $c1, $c2);
|
||||
} else {
|
||||
pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to JIS, SJIS to SJIS, EUC to EUC
|
||||
;#
|
||||
sub jis2jis {
|
||||
local(*_, $opt) = @_;
|
||||
s/$re_jp/$esc_jp/go;
|
||||
s/$re_asc/$esc_asc/go;
|
||||
&h2z_jis(*_) if $opt =~ /z/;
|
||||
&z2h_jis(*_) if $opt =~ /h/;
|
||||
}
|
||||
sub sjis2sjis {
|
||||
local(*_, $opt) = @_;
|
||||
&h2z_sjis(*_) if $opt =~ /z/;
|
||||
&z2h_sjis(*_) if $opt =~ /h/;
|
||||
}
|
||||
sub euc2euc {
|
||||
local(*_, $opt) = @_;
|
||||
&h2z_euc(*_) if $opt =~ /z/;
|
||||
&z2h_euc(*_) if $opt =~ /h/;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Cache control functions
|
||||
;#
|
||||
sub cache {
|
||||
($cache, $cache = 1)[$[];
|
||||
}
|
||||
sub nocache {
|
||||
($cache, $cache = 0)[$[];
|
||||
}
|
||||
sub flushcache {
|
||||
undef %e2s;
|
||||
undef %s2e;
|
||||
}
|
||||
|
||||
;#
|
||||
;# X0201 -> X0208 KANA conversion routine
|
||||
;#
|
||||
sub h2z_jis {
|
||||
local(*_, $n) = @_;
|
||||
if (s/$re_kana([^\e]*)/$esc_jp . &_h2z_jis($1)/geo) {
|
||||
1 while s/($re_jp[^\e]*)$re_jp/$1/o;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _h2z_jis {
|
||||
local($_) = @_;
|
||||
$n += s/[\41-\137]([\136\137])?/$h2z{$&}/g;
|
||||
$_;
|
||||
}
|
||||
|
||||
sub h2z_euc {
|
||||
local(*_) = @_;
|
||||
s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
|
||||
}
|
||||
|
||||
sub h2z_sjis {
|
||||
local(*_, $n) = @_;
|
||||
s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
|
||||
$1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
;#
|
||||
;# X0208 -> X0201 KANA conversion routine
|
||||
;#
|
||||
sub z2h_jis {
|
||||
local(*_, $n) = @_;
|
||||
s/$re_jp([^\e]+)/&_z2h_jis($1)/geo;
|
||||
$n;
|
||||
}
|
||||
sub _z2h_jis {
|
||||
local($_) = @_;
|
||||
s/(\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+/&__z2h_jis($&)/ge;
|
||||
$_;
|
||||
}
|
||||
sub __z2h_jis {
|
||||
local($_) = @_;
|
||||
return $esc_jp . $_ unless /^%/ || /^![\#\"&VW+,<]/;
|
||||
$n += length($_) / 2;
|
||||
s/../$z2h{$&}/g;
|
||||
$esc_kana . $_;
|
||||
}
|
||||
|
||||
sub z2h_euc {
|
||||
local(*_, $n) = @_;
|
||||
&init_z2h_euc unless defined %z2h_euc;
|
||||
s/$re_euc_c|$re_euc_kana/$z2h_euc{$&} ? ($n++, $z2h_euc{$&}) : $&/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
sub z2h_sjis {
|
||||
local(*_, $n) = @_;
|
||||
&init_z2h_sjis unless defined %z2h_sjis;
|
||||
s/$re_sjis_c/$z2h_sjis{$&} ? ($n++, $z2h_sjis{$&}) : $&/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
|
||||
;# can be done in &init but it's not worth doing. Similarly,
|
||||
;# precalculated table is not worth to occupy the file space and
|
||||
;# reduce the readability. The author personnaly discourages to use
|
||||
;# X0201 Kana character in the any situation.
|
||||
;#
|
||||
sub init_z2h_euc {
|
||||
local($k, $_);
|
||||
s/[\241-\337]/\216$&/g && ($z2h_euc{$k} = $_) while ($k, $_) = each %z2h;
|
||||
}
|
||||
sub init_z2h_sjis {
|
||||
local($_, $v);
|
||||
/[\200-\377]/ && ($z2h_sjis{&e2s($_)} = $v) while ($_, $v) = each %z2h;
|
||||
}
|
||||
|
||||
;#
|
||||
;# TR function for 2-byte code
|
||||
;#
|
||||
sub tr {
|
||||
local(*_, $from, $to, $opt) = @_;
|
||||
local(@from, @to, %table);
|
||||
local($jis, $n) = (0, 0);
|
||||
local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
|
||||
|
||||
&jis2euc(*_), $jis++ if $_ =~ /$re_jp/o;
|
||||
&jis2euc(*to), $jis++ if $to =~ /$re_jp/o;
|
||||
&jis2euc(*from) if $from =~ /$re_jp/o;
|
||||
|
||||
grep(s/([\200-\377])[\200-\377]-\1[\200-\377]/&_expnd2($&)/ge, $from, $to);
|
||||
grep(s/$ascii-$ascii/&_expnd1($&)/geo, $from, $to);
|
||||
|
||||
@to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
|
||||
@from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
|
||||
push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
|
||||
@table{@from} = @to;
|
||||
|
||||
s/[\200-\377][\000-\377]|[\000-\377]/
|
||||
defined($table{$&}) && ++$n ? $table{$&} : $&/ge;
|
||||
|
||||
&euc2jis(*_) if $jis;
|
||||
|
||||
$n;
|
||||
}
|
||||
|
||||
sub _expnd1 {
|
||||
local($_) = @_;
|
||||
s/\\(.)/$1/g;
|
||||
local($c1, $c2) = unpack('CxC', $_);
|
||||
if ($c1 <= $c2) {
|
||||
for ($_ = ''; $c1 <= $c2; $c1++) {
|
||||
$_ .= pack('C', $c1);
|
||||
}
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
sub _expnd2 {
|
||||
local($_) = @_;
|
||||
local($c1, $c2, $c3, $c4) = unpack('CCxCC', $_);
|
||||
if ($c1 == $c3 && $c2 <= $c4) {
|
||||
for ($_ = ''; $c2 <= $c4; $c2++) {
|
||||
$_ .= pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
85
[1999-05-04 - present] REMIX/location.txt
Normal file
85
[1999-05-04 - present] REMIX/location.txt
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
#
|
||||
|
||||
#ろけーしょん
|
||||
|
||||
#1997.9.14製作
|
||||
|
||||
#すくりぷと ばい ゆいちゃっと
|
||||
|
||||
# Since 1996
|
||||
|
||||
#
|
||||
|
||||
|
||||
|
||||
&decode;
|
||||
|
||||
&html if($url);
|
||||
|
||||
&html2;
|
||||
|
||||
|
||||
|
||||
sub html{
|
||||
|
||||
|
||||
|
||||
print "Location: $url\n\n";
|
||||
|
||||
print "Pragma: no cache\n";
|
||||
|
||||
print "Expires: Thu, 16 Dec 1994 16:00:GMT\n\n";
|
||||
|
||||
exit;
|
||||
|
||||
}#html END
|
||||
|
||||
|
||||
|
||||
sub decode{ #一般的なデコード＆変数への代入
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
@pairs = split(/&/,$buffer);
|
||||
|
||||
foreach $pair (@pairs) {
|
||||
|
||||
($name, $value) = split(/=/, $pair);
|
||||
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
|
||||
$value =~ s/\n//g; $value =~ s/\r//g;
|
||||
|
||||
$FORM{$name} = $value;
|
||||
|
||||
}
|
||||
|
||||
$url = $FORM{'url'};
|
||||
|
||||
}#decode END
|
||||
|
||||
|
||||
|
||||
sub html2{
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
print <<"_HTML_";
|
||||
|
||||
<HTML><HEAD>
|
||||
|
||||
<TITLE>フォームで移動。</TITLE>
|
||||
|
||||
</HEAD></HTML>
|
||||
|
||||
_HTML_
|
||||
|
||||
exit;
|
||||
|
||||
}#html2 END
|
||||
|
||||
__END__
|
||||
0
[1999-05-04 - present] REMIX/loveyou.dat
Normal file
0
[1999-05-04 - present] REMIX/loveyou.dat
Normal file
1024
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/bbs.txt
Normal file
1024
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/bbs.txt
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -0,0 +1 @@
|
|||
1
|
||||
232
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/delete.txt
Normal file
232
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/delete.txt
Normal file
|
|
@ -0,0 +1,232 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
;# ↑このパスはプロバイダによって違うので調べて設定する
|
||||
;# (これはこのスクリプトの最初の１行になければならず、それより上に空行があってもいけません。)
|
||||
;# (この設定が必要ないサーバもあります。一般的な場合を想定して解説を入れています。)
|
||||
;# (他に、プロバイダからアナウンスされている情報を十分理解しておいてください。)
|
||||
;#
|
||||
;# 簡易ＢＢＳ version 7.5（フリーソフト）
|
||||
;#
|
||||
;# Script written by Kazu.Y
|
||||
;# Created on: 02/05/96
|
||||
;# Last Modified on: 11/06/97
|
||||
;# I can be reached at: rescue@ask.or.jp
|
||||
;# Scripts Found at: http://www.ask.or.jp/~rescue/
|
||||
;#
|
||||
;# <利用規定の抜粋>
|
||||
;# 1.このスクリプトは自分で使うために承諾なしに自由に改造することができます。
|
||||
;# 2.改造の有無にかかわらず、このスクリプトを再配布することはできません。
|
||||
;# 3.このシステムを有償で他人に設置してあげたりする行為は無断ではできません。
|
||||
|
||||
#--- 必ずあなたの環境に合わせて書き替える項目 --------------------------------------------#
|
||||
|
||||
# 削除モード移行パスワードの設定（''内に任意のパスワードを記述する）
|
||||
$password = '適当に決めてね';
|
||||
|
||||
# 掲示板の名前
|
||||
$title = '（掲示板の名前）削除画面';
|
||||
|
||||
# このスクリプトをＵＲＬで設定（勝手に決めてね）
|
||||
$reload = 'delete.cgi';
|
||||
|
||||
#--- 必要に応じて設定する項目 ------------------------------------------------------------#
|
||||
|
||||
# 文字色や背景などの設定（通常の<body>タグ）
|
||||
# 題名と投稿者色はスクリプト内の<font color>タグを探して設定してください。
|
||||
$body = '<body bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">';
|
||||
|
||||
# 日本語コード変換ライブラリ
|
||||
# この jcode.pl を minibbs.cgi と違うディレクトリに設置する場合は相対的に設定すること
|
||||
require './jcode.pl';
|
||||
|
||||
# 内容が書き込まれる記録ファイルのパスを設定
|
||||
# この minibbs.dat を minibbs.cgi と違うディレクトリに設置する場合は相対的に設定すること
|
||||
$file = './loveyou.dat';
|
||||
|
||||
# 海外サーバ等で時差が生じる場合は修正します
|
||||
# 海外時間に＋９時間する場合 = localtime(time + 9*60*60);
|
||||
# 海外時間に－９時間する場合 = localtime(time - 9*60*60);
|
||||
# （参考）timeには1970年からの秒数が入っています
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
|
||||
|
||||
# 入力形式の設定 標準入力:post その他:get
|
||||
# 投稿ボタンを押して Method not implemented.. というエラーが出る場合は get で試すこと
|
||||
$method = 'post';
|
||||
|
||||
###########################################################################################
|
||||
#
|
||||
# ・記録ファイルには処理の都合上特殊コードが記録されますので、直接編集はできません。
|
||||
# ・スクリプトの中身を書き替える場合は、perlやCGIやHTMLなどのそれなりの知識が必要です。
|
||||
# ・設置に関する質問はチャレンジＣＧＩ専用掲示板をご利用ください。改造の質問は受けません。
|
||||
# http://www2r.meshnet.or.jp/~rescue/webboard/
|
||||
#
|
||||
###########################################################################################
|
||||
|
||||
# 上記のlocaltimeで取得した$monには0から11までの数字が入るので修正処理
|
||||
$month = ($mon + 1);
|
||||
|
||||
# 時刻を２桁に統一する処理（削除処理に関係するので書き替えないこと）
|
||||
if ($month < 10) { $month = "0$month"; }
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($sec < 10) { $sec = "0$sec"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
|
||||
# 曜日変換処理
|
||||
# $wdayには0から6までの数字が入り曜日に対応している
|
||||
$y0="日"; $y1="月"; $y2="火"; $y3="水"; $y4="木"; $y5="金"; $y6="土";
|
||||
$youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6) [$wday];
|
||||
|
||||
# 時刻フォーマット（削除処理に関係するので書き替えないこと）
|
||||
$date_now = "$month月$mday日($youbi)$hour時$min分$sec秒";
|
||||
|
||||
# フォーム入力されたデータを$bufferに格納する（getかpostかによって取得方法が異なる）
|
||||
if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
|
||||
# $bufferに格納されたFORM形式のデータを取り出す
|
||||
|
||||
@pairs = split(/&/,$buffer);
|
||||
foreach $pair (@pairs) {
|
||||
|
||||
($name, $value) = split(/=/, $pair);
|
||||
$value =~ tr/+/ /;
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
|
||||
# 記録するデータはsjisに統一する
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
# 処理の都合上の処理
|
||||
$value =~ s/\n//g; # 改行文字はデータの記録に影響があるので消去する
|
||||
|
||||
$value =~ s/</</g; $value =~ s/>/>/g;
|
||||
$value =~ s/\,//g;
|
||||
|
||||
if ($name eq "target") { push(@RM,$value); }
|
||||
else { $FORM{$name} = $value; }
|
||||
}
|
||||
|
||||
# 全体の流れを決定する（actionやpwdはフォーム入力されたデータを格納する名前）
|
||||
# action=remove かつ pwd=設定パスワード --> 削除処理して通常画面へ
|
||||
# action=remove --> 削除記事選択画面へ
|
||||
# action=regist --> 記事記録処理して通常画面へ
|
||||
# その他 --> 通常画面へ
|
||||
if ($FORM{'action'} eq 'remove' && $FORM{'pwd'} eq $password) { &remove2; &remove1; exit; }
|
||||
elsif ($FORM{'pwd'} eq $password) { &remove1; exit; }
|
||||
&html;
|
||||
|
||||
sub html {
|
||||
|
||||
#--- 入力フォーム画面 --------------------------------#
|
||||
|
||||
# ＣＧＩで出力されたデータをＨＴＭＬとして認識させるヘッダの出力
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "<body text=#ffffff link=#eeffee alink=#ff0000 vlink=#dddddd bgcolor=#004040>\n";
|
||||
|
||||
|
||||
print "<font size=+1><b>$title</b></font><p>\n";
|
||||
|
||||
print "<form method=$method action=\"$reload\">\n";
|
||||
print "<hr size=5><p>パスワード <input type=password name=\"pwd\" size=10>\n";
|
||||
print "<input type=submit value=\"管理者削除\"></form>\n";
|
||||
|
||||
# このスクリプトの著作権表示（かならず表示してください）
|
||||
print "<h4 align=right><hr size=5><a href=\"http://www.ask.or.jp/~rescue/\" target=\"_top\">MiniBBS v7.5</a> is Free.</h4>\n";
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
sub error {
|
||||
|
||||
# &error(xx); で呼び出されたルーチンは、()内の数字が $error に代入される。
|
||||
|
||||
$error = $_[0];
|
||||
|
||||
if ($error eq "0") { $error_msg = '記録ファイルの入出力にエラーが発生しました。'; }
|
||||
elsif ($error eq "1") { $error_msg = '投稿者名が記入されていません。'; }
|
||||
elsif ($error eq "2") { $error_msg = '内容が書かれていません。または記録禁止のタグが書かれています。'; }
|
||||
elsif ($error eq "3") { $error_msg = 'メールアドレスが正しく入力されていません。'; }
|
||||
elsif ($error eq "4") { $error_msg = 'メールアドレスは複数指定できません。'; }
|
||||
elsif ($error eq "tag") { $error_msg = '利用ができないタグが記述されていますので投稿できません。'; }
|
||||
elsif ($error eq "form") { $error_msg = "投稿画面のＵＲＬが<br>$reload<br>" . '以外からの投稿はできません。'; }
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<h3>$error_msg</h3>\n";
|
||||
print "</body></html>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
sub remove1 {
|
||||
|
||||
if (!open(DB,"$file")) { &error(0); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$title</title></head>\n";
|
||||
print "<body text=#ffffff link=#eeffee alink=#ff0000 vlink=#dddddd bgcolor=#007f7f>\n";
|
||||
print "<font size=+2><b>削除モード</b></font> [<a href=\"$reload\">戻る</a>] [<a href=\"bbs.cgi\">掲示板に戻る</a>]<p>\n";
|
||||
|
||||
print "<form method=$method action=\"$reload\">\n";
|
||||
print "<input type=hidden name=\"action\" value=\"remove\">\n";
|
||||
print "<input type=hidden name=\"pwd\" value=\"$FORM{'pwd'}\">\n";
|
||||
print "<input type=submit value=\" 削除 \"><input type=reset value=\"リセット\"><br>\n";
|
||||
print "<pre>";
|
||||
print " 登録日 投稿者 タイトル 内容<hr>\n";
|
||||
|
||||
foreach $line (@lines) {
|
||||
|
||||
($date,$name,$email,$value,$subject) = split(/\,/,$line);
|
||||
|
||||
$name =~ s/</</g; $name =~ s/>/>/g;
|
||||
$value =~ s/</</g; $value =~ s/>/>/g;
|
||||
$subject =~ s/</</g; $subject =~ s/>/>/g;
|
||||
|
||||
|
||||
$value =~ s/\0/\,/g;
|
||||
chop($subject) if $subject =~ /\n/;
|
||||
$value =~ s/<!--.*-->//ig; $value =~ s/</</ig; $value =~ s/>/>/ig; $value =~ s/\n/./g; $value =~ s/\r/./g;
|
||||
|
||||
$i1 = length($subject);
|
||||
if ($i1 > 20) { $subject = substr($subject,0,18); $subject = $subject . '..'; }
|
||||
elsif ($i1 < 20) { $blank = ' ' x (20 - $i1); $subject = $subject . $blank; }
|
||||
|
||||
$i2 = length($name);
|
||||
if ($i2 > 20) { $name = substr($name,0,18); $name = $name . '..'; }
|
||||
elsif ($i2 < 20) { $blank = ' ' x (20 - $i2); $name = $name . $blank; }
|
||||
|
||||
if (length($value) > 40) { $value = substr($value,0,40); }
|
||||
print "<input type=checkbox name=\"target\" value=\"$date\">";
|
||||
print "$date $name $subject $value \n";
|
||||
}
|
||||
|
||||
print "</pre><p>\n";
|
||||
print "</form><p>\n";
|
||||
print "</body></html>\n";
|
||||
}
|
||||
|
||||
sub remove2 {
|
||||
|
||||
if (!open(DB,"$file")) { &error(0); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
foreach $line (@lines) {
|
||||
|
||||
($date,$name,$email,$value,$subject) = split(/\,/,$line);
|
||||
$del = 0;
|
||||
foreach $target (@RM) { if ($target eq $date) { $del = 1; } }
|
||||
if ($del == 0) { push(@new,$line); }
|
||||
}
|
||||
|
||||
if (!open(DB,">$file")) { &error(0); }
|
||||
print DB @new;
|
||||
close(DB);
|
||||
}
|
||||
|
||||
#end_of_script
|
||||
303
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/getlog.txt
Normal file
303
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/getlog.txt
Normal file
|
|
@ -0,0 +1,303 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#はじあや＠ふぁみーるのパソヲタさん、本当にありがとう
|
||||
|
||||
|
||||
#--------------------
|
||||
|
||||
$body = '<body bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">';
|
||||
$bbstitle ="あやしいわーるどREQUIEM";
|
||||
|
||||
|
||||
$logdir = './log/';
|
||||
|
||||
$cgiurl = 'getlog.cgi';
|
||||
$action ='getlog';
|
||||
|
||||
$bbsurl = './bbs.cgi';
|
||||
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
|
||||
# キーワードの最大文字数（半角）
|
||||
$keylength = 64;
|
||||
|
||||
# 時差 サーバの時計がずれてる時や日本時間以外にしたい時に使う
|
||||
$tim = 0;
|
||||
|
||||
$\ = "\n";
|
||||
|
||||
#--------------------
|
||||
|
||||
#if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
#else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
|
||||
@argv = split(/&/,$buffer);
|
||||
foreach (@argv) {
|
||||
($name, $value) = split(/=/);
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
$COMMAND{$name} = $value;
|
||||
}
|
||||
|
||||
|
||||
&error(2) if (length($COMMAND{'keyword'}) > $keylength);
|
||||
&viewlog if ($COMMAND{'action'} eq "$action");
|
||||
|
||||
|
||||
&list;
|
||||
|
||||
sub list {
|
||||
|
||||
&error(0) if(!opendir(DIR, $logdir));
|
||||
|
||||
@files=readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
@files = sort by_number @files;
|
||||
$end = @files;
|
||||
$end--;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ</title></head>\n";
|
||||
print "<form method=get action=\"$cgiurl\">";
|
||||
print "$body\n";
|
||||
#&location;
|
||||
print "<center><font size=+1><b>$bbstitle 過去ログ一覧</b></font><br>\n";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">";
|
||||
print "<table>";
|
||||
print "<tr><td></td><td>ファイル名</td><td align=right>サイズ</td><td align=center>日付</td></tr>";
|
||||
foreach (0 .. $end) {
|
||||
if (!($files[$_] eq "." or $files[$_] eq "..")) {
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$logdir$files[$_]";
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($mtime + 32400 + $tim);
|
||||
$mon++;
|
||||
$mon = "0$mon" if ($mon < 10);
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
$checked = ' checked' if ($_ == $end);
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$files[$_]\"$checked></td>";
|
||||
print "<td><a href=\"$logdir$files[$_]\">$files[$_]</a></td>";
|
||||
print "<td align=right>$size</td><td align=center>$mon/$mday $hour:$min</td></tr>";
|
||||
}
|
||||
}
|
||||
|
||||
print "<tr><td></td></tr><tr><td colspan=4>※ラジオボタンでファイル名を指定してください。</td></tr><tr><td></td></tr>\n";
|
||||
print "<tr><td colspan=4><select name=\"hour1\">";
|
||||
print "<option value=\"00\">0";
|
||||
print "<option value=\"01\">1";
|
||||
print "<option value=\"02\">2";
|
||||
print "<option value=\"03\">3";
|
||||
print "<option value=\"04\">4";
|
||||
print "<option value=\"05\">5";
|
||||
print "<option value=\"06\">6";
|
||||
print "<option value=\"07\">7";
|
||||
print "<option value=\"08\">8";
|
||||
print "<option value=\"09\">9";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時";
|
||||
print"<select name=\"min1\">";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"35\">35";
|
||||
print "<option value=\"40\">40";
|
||||
print "<option value=\"45\">45";
|
||||
print "<option value=\"50\">50";
|
||||
print "<option value=\"55\">55";
|
||||
print "</select>分から";
|
||||
|
||||
print "<select name=\"hour2\">";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"00\">0";
|
||||
print "<option value=\"01\">1";
|
||||
print "<option value=\"02\">2";
|
||||
print "<option value=\"03\">3";
|
||||
print "<option value=\"04\">4";
|
||||
print "<option value=\"05\">5";
|
||||
print "<option value=\"06\">6";
|
||||
print "<option value=\"07\">7";
|
||||
print "<option value=\"08\">8";
|
||||
print "<option value=\"09\">9";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時";
|
||||
print"<select name=\"min2\">";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"35\">35";
|
||||
print "<option value=\"40\">40";
|
||||
print "<option value=\"45\">45";
|
||||
print "<option value=\"50\">50";
|
||||
print "<option value=\"55\">55";
|
||||
print "</select>分まで";
|
||||
|
||||
print "</td></tr><br>";
|
||||
print " <tr><td colspan=4>検索：";
|
||||
print "<select name=\"searchmode\">";
|
||||
print "<option value=\"keyword\">全文";
|
||||
print "<option value=\"name\">投稿者名";
|
||||
print "<option value=\"subject\">題名\n</select>";
|
||||
print "<input type=text name=\"keyword\" size=\"24\" maxlength=$keylength></td></tr><tr><td colspan=4 align=center>";
|
||||
print "<input type=submit value=\"Get / Search\"></form></td></tr>";
|
||||
print "</table>";
|
||||
print "<hr>";
|
||||
#print "現在ベータテスト中です。バグを見つけたら掲示板に書いてね";
|
||||
print "<p align=center><a href=\"$bbsurl\">掲示板へ</a></p>";
|
||||
print "<h4 align=right><a href=\"http://logshonin.virtualave.net/\">Getlog Ver0.3b4</a></h4>";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub viewlog {
|
||||
|
||||
if (!open(DB,"$logdir$COMMAND{'logfile'}")) { &error(1); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
$COMMAND{'last'} = $COMMAND{'first'} + 1 if ($COMMAND{'first'} >= $COMMAND{'last'});
|
||||
$first = "$COMMAND{'hour1'}時$COMMAND{'min1'}分";
|
||||
$last = "$COMMAND{'hour2'}時$COMMAND{'min2'}分";
|
||||
|
||||
if ($COMMAND{'searchmode'} eq 'name') { $keyword = "投稿者：.*>${COMMAND{'keyword'}}<"; }
|
||||
elsif ($COMMAND{'searchmode'} eq 'subject') { $keyword = "color=\"#ffffee\"><b>${COMMAND{'keyword'}}</b></font>"; }
|
||||
else { $keyword = $COMMAND{'keyword'}; }
|
||||
if ($keyword ne '') {
|
||||
$keyword =~ s/\\/\\\\/;
|
||||
$keyword =~ s/\[/\\[/;
|
||||
}
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ $COMMAND{'logfile'}</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$COMMAND{'logfile'} $first～$last</h1>";
|
||||
$end = @lines;
|
||||
$end--;
|
||||
foreach (0 .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
$hour = substr( $lines[$_], 36, 8 );
|
||||
|
||||
# あやしいわーるど＠ふぁみーる オリジナル掲示板スクリプト
|
||||
# if ($lines[$_] =~ /<font size="-1"> 投稿日：/) {
|
||||
# $hour = substr( $lines[$_], 40, 8 );
|
||||
|
||||
last if ($hour ge "$first");
|
||||
}
|
||||
$skip++;
|
||||
}
|
||||
$skip--;
|
||||
#print"<hr>";
|
||||
foreach ($skip .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
$hour = substr( $lines[$_], 36, 8 );
|
||||
|
||||
# あやしいわーるど＠ふぁみーる オリジナル掲示板スクリプト
|
||||
# if ($lines[$_] =~ /<font size="-1"> 投稿日：/) {
|
||||
# $hour = substr( $lines[$_], 40, 8 );
|
||||
|
||||
last if ($hour ge "$last");
|
||||
}
|
||||
|
||||
|
||||
if ($keyword ne '') {
|
||||
if ($lines[$_] =~ /$keyword/) {
|
||||
$flag = 1;
|
||||
$hit++;
|
||||
}
|
||||
push( @article, $lines[$_] );
|
||||
if ($lines[$_] =~ /<\/blockquote>/) {
|
||||
print @article if ($flag > 0);
|
||||
splice( @article, 0 );
|
||||
$flag = 0;
|
||||
}
|
||||
}
|
||||
else { print $lines[$_]; }
|
||||
|
||||
}
|
||||
if ($COMMAND{'keyword'} ne '') {
|
||||
print "<hr>";
|
||||
if ( $hit > 0 ) { print "<h3>「$COMMAND{'keyword'}」は $hit件見つかりました。</h3>"; }
|
||||
else { print "<h3>「$COMMAND{'keyword'}」は見つかりませんでした。</h3>"; }
|
||||
}
|
||||
print "</body></html>";
|
||||
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub error {
|
||||
|
||||
$error = $_[0];
|
||||
if ($error == 0) { $errmsg = 'ディレクトリが開けませんでした。'; }
|
||||
if ($error == 1) { $errmsg = 'ファイルが開けませんでした。'; }
|
||||
if ($error == 2) { $errmsg = 'キーワードが長すぎます。'; }
|
||||
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>エラー</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$errmsg</h1>";
|
||||
print "</body></html>";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
sub by_number {
|
||||
$a <=> $b;
|
||||
}
|
||||
|
||||
|
||||
sub location {
|
||||
|
||||
print <<"EOF";
|
||||
<center>
|
||||
<font size=+1><b>$bbstitle 過去ログ一覧</b></font>
|
||||
EOF
|
||||
}
|
||||
618
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/jcode.txt
Normal file
618
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/jcode.txt
Normal file
|
|
@ -0,0 +1,618 @@
|
|||
package jcode;
|
||||
;######################################################################
|
||||
;#
|
||||
;# jcode.pl: Perl library for Japanese character code conversion
|
||||
;#
|
||||
;# Copyright (c) 1995,1996 Kazumasa Utashiro <utashiro@iij.ad.jp>
|
||||
;# Internet Initiative Japan Inc.
|
||||
;# 1-4 Sanban-cho, Chiyoda-ku, Tokyo 102, Japan
|
||||
;#
|
||||
;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
|
||||
;# Software Research Associates, Inc.
|
||||
;# Original by srekcah@sra.co.jp, Feb 1992
|
||||
;#
|
||||
;# Redistribution for any purpose, without significant modification,
|
||||
;# is granted as long as all copyright notices are retained. THIS
|
||||
;# SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
|
||||
;# IMPLIED WARRANTIES ARE DISCLAIMED.
|
||||
;#
|
||||
;; $rcsid = q$Id: jcode.pl,v 2.0 1996/10/02 16:02:38 utashiro Rel $;
|
||||
;#
|
||||
;######################################################################
|
||||
;#
|
||||
;# INTERFACE:
|
||||
;#
|
||||
;# &jcode'getcode(*line)
|
||||
;# Return 'jis', 'sjis', 'euc' or undef according to
|
||||
;# Japanese character code in $line. Return 'binary' if
|
||||
;# the data has non-character code.
|
||||
;#
|
||||
;# Code detection between euc and sjis is very difficult
|
||||
;# or sometimes impossible or even lead to wrong result
|
||||
;# when it's include JIS X0201 KANA characters. So JIS
|
||||
;# X0201 KANA is ignored for automatic code detection.
|
||||
;#
|
||||
;# &jcode'convert(*line, $ocode [, $icode [, $option]])
|
||||
;# Convert the line in any Japanese code to the specified
|
||||
;# code in the second argument $ocode. $ocode can be any
|
||||
;# of "jis", "sjis" or "euc", or use "noconv" when you
|
||||
;# don't want the code conversion. Input code is
|
||||
;# recognized automatically from the line itself when
|
||||
;# $icode is not supplied (JIS X0201 KANA is ignored.
|
||||
;# See above). $icode also can be specified, but xxx2yyy
|
||||
;# routine is more efficient when both codes are known.
|
||||
;#
|
||||
;# It returns a list of pointer of convert subroutine and
|
||||
;# input code. It means that this routine returns the
|
||||
;# input code of the line in scalar context.
|
||||
;#
|
||||
;# See next paragraph for $option parameter.
|
||||
;#
|
||||
;# &jcode'xxx2yyy(*line [, $option])
|
||||
;# Convert the Japanese code from xxx to yyy. String xxx
|
||||
;# and yyy are any convination from "jis", "euc" or
|
||||
;# "sjis". They return *approximate* number of converted
|
||||
;# bytes. So return value 0 means the line was not
|
||||
;# converted at all.
|
||||
;#
|
||||
;# Optional parameter $option is used to specify optional
|
||||
;# conversion method. String "z" is for JIS X0201 KANA
|
||||
;# to X0208 KANA, and "h" is for reverse.
|
||||
;#
|
||||
;# $jcode'convf{'xxx', 'yyy'}
|
||||
;# The value of this associative array is pointer to the
|
||||
;# subroutine jcode'xxx2yyy().
|
||||
;#
|
||||
;# &to($ocode, $line [, $icode [, $option]])
|
||||
;# &jis($line [, $icode [, $option]])
|
||||
;# &euc($line [, $icode [, $option]])
|
||||
;# &sjis($line [, $icode [, $option]])
|
||||
;# These functions are prepared for easy use of
|
||||
;# call/return-by-value interface. You can use these
|
||||
;# funcitons in s///e operation or any other place for
|
||||
;# convenience.
|
||||
;#
|
||||
;# &jcode'jis_inout($in, $out)
|
||||
;# Set or inquire JIS start and end sequences. Default
|
||||
;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
|
||||
;# character, "ESC-$" or "ESC-(" is added as a prefix
|
||||
;# for each character respectively. Acutually "ESC-(-B"
|
||||
;# is not a sequence to end JIS code but a sequence to
|
||||
;# start ASCII code set. So `in' and `out' are somewhat
|
||||
;# misleading.
|
||||
;#
|
||||
;# &jcode'get_inout($string)
|
||||
;# Get JIS start and end sequences from $string.
|
||||
;#
|
||||
;# &jcode'cache()
|
||||
;# &jcode'nocache()
|
||||
;# &jcode'flush()
|
||||
;# Usually, converted character is cached in memory to
|
||||
;# avoid same calculations have to be done many times.
|
||||
;# To disable this caching, call &jcode'nocache(). It
|
||||
;# can be revived by &jcode'cache() and cache is flushed
|
||||
;# by calling &jcode'flush(). &cache() and &nocache()
|
||||
;# functions return previous caching state.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'h2z_xxx(*line);
|
||||
;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
|
||||
;# (Zenkaku-KANA) code conversion routine. String xxx is
|
||||
;# any of "jis", "sjis" and "euc". From the difficulty
|
||||
;# of recognizing code set from 1-byte KATAKANA string,
|
||||
;# automatic code recognition is not supported.
|
||||
;#
|
||||
;# &jcode'z2h_xxx(*line);
|
||||
;# X0208 to X0201 KANA code conversion routine. String
|
||||
;# xxx is any of "jis", "sjis" and "euc".
|
||||
;#
|
||||
;# $jcode'z2hf{'xxx'}
|
||||
;# $jcode'h2zf{'xxx'}
|
||||
;# These are pointer to the corresponding function just
|
||||
;# as $jcode'convf.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'tr(*line, $from, $to [, $option]);
|
||||
;# &jcode'tr emulates tr operator for 2 byte code. This
|
||||
;# funciton is under construction and doesn't have full
|
||||
;# feature of tr. Range operator like a-z is partially
|
||||
;# supported: JIS or EUC and first byte should be same on
|
||||
;# first and last character (so HIRAGANA-KATAKANA
|
||||
;# conversion is possible). Only 'd' is interpreted as
|
||||
;# option.
|
||||
;#
|
||||
;# &jcode'trans($line, $from, $to [, $option);
|
||||
;# Same as &jcode'tr but accept string and return string
|
||||
;# after translation.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'init()
|
||||
;# Initialize the variables used in other functions. You
|
||||
;# don't have to call this when using jocde.pl by do or
|
||||
;# require. Call it first if you embedded the jcode.pl
|
||||
;# in your script.
|
||||
;#
|
||||
;######################################################################
|
||||
;#
|
||||
;# SAMPLES
|
||||
;#
|
||||
;# Convert any Kanji code to JIS and print each line with code name.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# $code = &jcode'convert(*_, 'jis');
|
||||
;# print $code, "\t", $_;
|
||||
;# }
|
||||
;#
|
||||
;# Convert all lines to JIS according to the first recognized line.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# print, next unless /[\033\200-\377]/;
|
||||
;# (*f, $icode) = &jcode'convert(*_, 'jis');
|
||||
;# print;
|
||||
;# defined(&f) || next;
|
||||
;# while (<>) { &f(*_); print; }
|
||||
;# last;
|
||||
;# }
|
||||
;#
|
||||
;# The safest way of JIS conversion.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# ($matched, $code) = &jcode'getcode(*_);
|
||||
;# print, next unless (@buf || $matched);
|
||||
;# push(@readahead, $_);
|
||||
;# next unless $code;
|
||||
;# eval "&jcode'${code}2jis(*_), print while (\$_ = shift(\@buf));";
|
||||
;# eval "&jcode'${code}2jis(*_), print while (\$_ = <>);";
|
||||
;# last;
|
||||
;# }
|
||||
;#
|
||||
;######################################################################
|
||||
|
||||
;#
|
||||
;# Call initialize function if it is not called yet. This may sound
|
||||
;# strange but it makes easy to embed the jcode.pl at the end of
|
||||
;# script. Call &jcode'init at the beginning of the script in that
|
||||
;# case.
|
||||
;#
|
||||
&init unless defined $version;
|
||||
|
||||
;#
|
||||
;# Initialize variables.
|
||||
;#
|
||||
sub init {
|
||||
$version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
|
||||
|
||||
$re_bin = '[\000-\006\177\377]';
|
||||
|
||||
$re_jp = '\e\$[\@B]';
|
||||
$re_asc = '\e\([BJ]';
|
||||
$re_kana = '\e\(I';
|
||||
($esc_jp, $esc_asc, $esc_kana) = ("\e\$B", "\e(B", "\e(I");
|
||||
|
||||
$re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
|
||||
$re_sjis_kana = '[\241-\337]';
|
||||
|
||||
$re_euc_c = '[\241-\376][\241-\376]';
|
||||
$re_euc_kana = '\216[\241-\337]';
|
||||
|
||||
# These variables are retained only for backward compatibility.
|
||||
$re_euc_s = "($re_euc_c)+";
|
||||
$re_sjis_s = "($re_sjis_c)+";
|
||||
|
||||
$cache = 1;
|
||||
|
||||
# X0201 -> X0208 KANA conversion table. Looks weird? Not that
|
||||
# much. This is simply JIS text without escape sequences.
|
||||
($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\021-\176/\221-\376/;
|
||||
! !# $ !" % !& " !V # !W
|
||||
^ !+ _ !, 0 !<
|
||||
' %! ( %# ) %% * %' + %)
|
||||
, %c - %e . %g / %C
|
||||
1 %" 2 %$ 3 %& 4 %( 5 %*
|
||||
6 %+ 7 %- 8 %/ 9 %1 : %3
|
||||
6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
|
||||
; %5 < %7 = %9 > %; ? %=
|
||||
;^ %6 <^ %8 =^ %: >^ %< ?^ %>
|
||||
@ %? A %A B %D C %F D %H
|
||||
@^ %@ A^ %B B^ %E C^ %G D^ %I
|
||||
E %J F %K G %L H %M I %N
|
||||
J %O K %R L %U M %X N %[
|
||||
J^ %P K^ %S L^ %V M^ %Y N^ %\
|
||||
J_ %Q K_ %T L_ %W M_ %Z N_ %]
|
||||
O %^ P %_ Q %` R %a S %b
|
||||
T %d U %f V %h
|
||||
W %i X %j Y %k Z %l [ %m
|
||||
\ %o ] %s & %r 3^ %t
|
||||
__TABLE_END__
|
||||
%h2z = split(/\s+/, $h2z . $h2z_high);
|
||||
%z2h = reverse %h2z;
|
||||
|
||||
$_ = '';
|
||||
for $f ('jis', 'sjis', 'euc') {
|
||||
for $t ('jis', 'sjis', 'euc') {
|
||||
$_ .= "\$convf{'$f', '$t'} = *${f}2${t};\n";
|
||||
}
|
||||
$_ .= "\$h2zf{'$f'} = *h2z_${f};\n\$z2hf{'$f'} = *z2h_${f};\n";
|
||||
}
|
||||
eval $_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Set escape sequences which should be put before and after Japanese
|
||||
;# (JIS X0208) string.
|
||||
;#
|
||||
sub jis_inout {
|
||||
$esc_jp = shift || $esc_jp;
|
||||
$esc_jp = "\e\$$esc_jp" if length($esc_jp) == 1;
|
||||
$esc_asc = shift || $esc_asc;
|
||||
$esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
|
||||
($esc_jp, $esc_asc);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Get JIS in and out sequences from the string.
|
||||
;#
|
||||
sub get_inout {
|
||||
local($esc_jp, $esc_asc);
|
||||
$_[$[] =~ /$re_jp/o && ($esc_jp = $&);
|
||||
$_[$[] =~ /$re_asc/o && ($esc_asc = $&);
|
||||
($esc_jp, $esc_asc);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Recognize character code.
|
||||
;#
|
||||
sub getcode {
|
||||
local(*_) = @_;
|
||||
return undef unless /[\e\200-\377]/;
|
||||
return 'jis' if /$re_jp|$re_asc|$re_kana/o;
|
||||
return 'binary' if /$re_bin/o;
|
||||
|
||||
local($sjis, $euc);
|
||||
$sjis += length($&) while /($re_sjis_c)+/go;
|
||||
$euc += length($&) while /($re_euc_c)+/go;
|
||||
(&max($sjis, $euc), ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1]);
|
||||
}
|
||||
sub max { $_[ $[ + ($_[$[] < $_[$[+1]) ]; }
|
||||
|
||||
;#
|
||||
;# Convert any code to specified code.
|
||||
;#
|
||||
sub convert {
|
||||
local(*_, $ocode, $icode, $opt) = @_;
|
||||
return (undef, undef) unless $icode = $icode || &getcode(*_);
|
||||
return (undef, $icode) if $icode eq 'binary';
|
||||
$ocode = 'jis' unless $ocode;
|
||||
$ocode = $icode if $ocode eq 'noconv';
|
||||
local(*convf) = $convf{$icode, $ocode};
|
||||
do convf(*_, $opt);
|
||||
(*convf, $icode);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Easy return-by-value interfaces.
|
||||
;#
|
||||
sub jis { &to('jis', @_); }
|
||||
sub euc { &to('euc', @_); }
|
||||
sub sjis { &to('sjis', @_); }
|
||||
sub to {
|
||||
local($ocode, $_, $icode, $opt) = @_;
|
||||
&convert(*_, $ocode, $icode, $opt);
|
||||
$_;
|
||||
}
|
||||
sub what {
|
||||
local($_) = @_;
|
||||
&getcode(*_);
|
||||
}
|
||||
sub trans {
|
||||
local($_) = shift;
|
||||
&tr(*_, @_);
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# SJIS to JIS
|
||||
;#
|
||||
sub sjis2jis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&sjis2sjis(*_, $opt) if $opt;
|
||||
if (s/($re_sjis_kana)+|($re_sjis_c)+/&_sjis2jis($&)/geo) {
|
||||
s/$re_asc($re_jp|$re_kana)/$1/go;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _sjis2jis {
|
||||
local($_) = @_;
|
||||
if (/^$re_sjis_kana/o) {
|
||||
$n += tr/\241-\337/\041-\137/;
|
||||
$esc_kana . $_ . $esc_asc;
|
||||
} else {
|
||||
$n += s/$re_sjis_c/$s2e{$&}||&s2e($&)/geo;
|
||||
tr/\241-\376/\041-\176/;
|
||||
$esc_jp . $_ . $esc_asc;
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# EUC to JIS
|
||||
;#
|
||||
sub euc2jis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
if (s/($re_euc_kana)+|($re_euc_c)+/&_euc2jis($&)/geo) {
|
||||
s/$re_asc($re_jp|$re_kana)/$1/go;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _euc2jis {
|
||||
local($_) = @_;
|
||||
local($esc) = tr/\216//d ? $esc_kana : $esc_jp;
|
||||
$n += tr/\241-\376/\041-\176/;
|
||||
$esc . $_ . $esc_asc;
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to EUC
|
||||
;#
|
||||
sub jis2euc {
|
||||
local(*_, $opt, $n) = @_;
|
||||
s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n;
|
||||
}
|
||||
sub _jis2euc {
|
||||
local($esc, $_) = @_;
|
||||
if ($esc !~ /$re_asc/o) {
|
||||
$n += tr/\041-\176/\241-\376/;
|
||||
s/[\241-\337]/\216$&/g if $esc =~ /$re_kana/o;
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to SJIS
|
||||
;#
|
||||
sub jis2sjis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&jis2jis(*_, $opt) if $opt;
|
||||
s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
|
||||
$n;
|
||||
}
|
||||
sub _jis2sjis {
|
||||
local($esc, $_) = @_;
|
||||
if ($esc !~ /$re_asc/o) {
|
||||
$n += tr/\041-\176/\241-\376/;
|
||||
s/$re_euc_c/$e2s{$&}||&e2s($&)/geo if $esc =~ /$re_jp/o;
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# SJIS to EUC
|
||||
;#
|
||||
sub sjis2euc {
|
||||
local(*_, $opt,$n) = @_;
|
||||
$n = s/$re_sjis_kana|$re_sjis_c/$s2e{$&}||&s2e($&)/geo;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n;
|
||||
}
|
||||
sub s2e {
|
||||
local($c1, $c2, $code);
|
||||
($c1, $c2) = unpack('CC', $code = shift);
|
||||
|
||||
if (0xa1 <= $c1 && $c1 <= 0xdf) {
|
||||
$c2 = $c1;
|
||||
$c1 = 0x8e;
|
||||
} elsif (0x9f <= $c2) {
|
||||
$c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
|
||||
$c2 += 2;
|
||||
} else {
|
||||
$c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
|
||||
$c2 += 0x60 + ($c2 < 0x7f);
|
||||
}
|
||||
if ($cache) {
|
||||
$s2e{$code} = pack('CC', $c1, $c2);
|
||||
} else {
|
||||
pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# EUC to SJIS
|
||||
;#
|
||||
sub euc2sjis {
|
||||
local(*_, $opt,$n) = @_;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n = s/$re_euc_c|$re_euc_kana/$e2s{$&}||&e2s($&)/geo;
|
||||
}
|
||||
sub e2s {
|
||||
local($c1, $c2, $code);
|
||||
($c1, $c2) = unpack('CC', $code = shift);
|
||||
|
||||
if ($c1 == 0x8e) {
|
||||
return substr($code, 1, 1);
|
||||
} elsif ($c1 % 2) {
|
||||
$c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
|
||||
$c2 -= 0x60 + ($c2 < 0xe0);
|
||||
} else {
|
||||
$c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
|
||||
$c2 -= 2;
|
||||
}
|
||||
if ($cache) {
|
||||
$e2s{$code} = pack('CC', $c1, $c2);
|
||||
} else {
|
||||
pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to JIS, SJIS to SJIS, EUC to EUC
|
||||
;#
|
||||
sub jis2jis {
|
||||
local(*_, $opt) = @_;
|
||||
s/$re_jp/$esc_jp/go;
|
||||
s/$re_asc/$esc_asc/go;
|
||||
&h2z_jis(*_) if $opt =~ /z/;
|
||||
&z2h_jis(*_) if $opt =~ /h/;
|
||||
}
|
||||
sub sjis2sjis {
|
||||
local(*_, $opt) = @_;
|
||||
&h2z_sjis(*_) if $opt =~ /z/;
|
||||
&z2h_sjis(*_) if $opt =~ /h/;
|
||||
}
|
||||
sub euc2euc {
|
||||
local(*_, $opt) = @_;
|
||||
&h2z_euc(*_) if $opt =~ /z/;
|
||||
&z2h_euc(*_) if $opt =~ /h/;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Cache control functions
|
||||
;#
|
||||
sub cache {
|
||||
($cache, $cache = 1)[$[];
|
||||
}
|
||||
sub nocache {
|
||||
($cache, $cache = 0)[$[];
|
||||
}
|
||||
sub flushcache {
|
||||
undef %e2s;
|
||||
undef %s2e;
|
||||
}
|
||||
|
||||
;#
|
||||
;# X0201 -> X0208 KANA conversion routine
|
||||
;#
|
||||
sub h2z_jis {
|
||||
local(*_, $n) = @_;
|
||||
if (s/$re_kana([^\e]*)/$esc_jp . &_h2z_jis($1)/geo) {
|
||||
1 while s/($re_jp[^\e]*)$re_jp/$1/o;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _h2z_jis {
|
||||
local($_) = @_;
|
||||
$n += s/[\41-\137]([\136\137])?/$h2z{$&}/g;
|
||||
$_;
|
||||
}
|
||||
|
||||
sub h2z_euc {
|
||||
local(*_) = @_;
|
||||
s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
|
||||
}
|
||||
|
||||
sub h2z_sjis {
|
||||
local(*_, $n) = @_;
|
||||
s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
|
||||
$1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
;#
|
||||
;# X0208 -> X0201 KANA conversion routine
|
||||
;#
|
||||
sub z2h_jis {
|
||||
local(*_, $n) = @_;
|
||||
s/$re_jp([^\e]+)/&_z2h_jis($1)/geo;
|
||||
$n;
|
||||
}
|
||||
sub _z2h_jis {
|
||||
local($_) = @_;
|
||||
s/(\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+/&__z2h_jis($&)/ge;
|
||||
$_;
|
||||
}
|
||||
sub __z2h_jis {
|
||||
local($_) = @_;
|
||||
return $esc_jp . $_ unless /^%/ || /^![\#\"&VW+,<]/;
|
||||
$n += length($_) / 2;
|
||||
s/../$z2h{$&}/g;
|
||||
$esc_kana . $_;
|
||||
}
|
||||
|
||||
sub z2h_euc {
|
||||
local(*_, $n) = @_;
|
||||
&init_z2h_euc unless defined %z2h_euc;
|
||||
s/$re_euc_c|$re_euc_kana/$z2h_euc{$&} ? ($n++, $z2h_euc{$&}) : $&/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
sub z2h_sjis {
|
||||
local(*_, $n) = @_;
|
||||
&init_z2h_sjis unless defined %z2h_sjis;
|
||||
s/$re_sjis_c/$z2h_sjis{$&} ? ($n++, $z2h_sjis{$&}) : $&/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
|
||||
;# can be done in &init but it's not worth doing. Similarly,
|
||||
;# precalculated table is not worth to occupy the file space and
|
||||
;# reduce the readability. The author personnaly discourages to use
|
||||
;# X0201 Kana character in the any situation.
|
||||
;#
|
||||
sub init_z2h_euc {
|
||||
local($k, $_);
|
||||
s/[\241-\337]/\216$&/g && ($z2h_euc{$k} = $_) while ($k, $_) = each %z2h;
|
||||
}
|
||||
sub init_z2h_sjis {
|
||||
local($_, $v);
|
||||
/[\200-\377]/ && ($z2h_sjis{&e2s($_)} = $v) while ($_, $v) = each %z2h;
|
||||
}
|
||||
|
||||
;#
|
||||
;# TR function for 2-byte code
|
||||
;#
|
||||
sub tr {
|
||||
local(*_, $from, $to, $opt) = @_;
|
||||
local(@from, @to, %table);
|
||||
local($jis, $n) = (0, 0);
|
||||
local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
|
||||
|
||||
&jis2euc(*_), $jis++ if $_ =~ /$re_jp/o;
|
||||
&jis2euc(*to), $jis++ if $to =~ /$re_jp/o;
|
||||
&jis2euc(*from) if $from =~ /$re_jp/o;
|
||||
|
||||
grep(s/([\200-\377])[\200-\377]-\1[\200-\377]/&_expnd2($&)/ge, $from, $to);
|
||||
grep(s/$ascii-$ascii/&_expnd1($&)/geo, $from, $to);
|
||||
|
||||
@to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
|
||||
@from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
|
||||
push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
|
||||
@table{@from} = @to;
|
||||
|
||||
s/[\200-\377][\000-\377]|[\000-\377]/
|
||||
defined($table{$&}) && ++$n ? $table{$&} : $&/ge;
|
||||
|
||||
&euc2jis(*_) if $jis;
|
||||
|
||||
$n;
|
||||
}
|
||||
|
||||
sub _expnd1 {
|
||||
local($_) = @_;
|
||||
s/\\(.)/$1/g;
|
||||
local($c1, $c2) = unpack('CxC', $_);
|
||||
if ($c1 <= $c2) {
|
||||
for ($_ = ''; $c1 <= $c2; $c1++) {
|
||||
$_ .= pack('C', $c1);
|
||||
}
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
sub _expnd2 {
|
||||
local($_) = @_;
|
||||
local($c1, $c2, $c3, $c4) = unpack('CCxCC', $_);
|
||||
if ($c1 == $c3 && $c2 <= $c4) {
|
||||
for ($_ = ''; $c2 <= $c4; $c2++) {
|
||||
$_ .= pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
85
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/location.txt
Normal file
85
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/location.txt
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
#
|
||||
|
||||
#ろけーしょん
|
||||
|
||||
#1997.9.14製作
|
||||
|
||||
#すくりぷと ばい ゆいちゃっと
|
||||
|
||||
# Since 1996
|
||||
|
||||
#
|
||||
|
||||
|
||||
|
||||
&decode;
|
||||
|
||||
&html if($url);
|
||||
|
||||
&html2;
|
||||
|
||||
|
||||
|
||||
sub html{
|
||||
|
||||
|
||||
|
||||
print "Location: $url\n\n";
|
||||
|
||||
print "Pragma: no cache\n";
|
||||
|
||||
print "Expires: Thu, 16 Dec 1994 16:00:GMT\n\n";
|
||||
|
||||
exit;
|
||||
|
||||
}#html END
|
||||
|
||||
|
||||
|
||||
sub decode{ #一般的なデコード＆変数への代入
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
@pairs = split(/&/,$buffer);
|
||||
|
||||
foreach $pair (@pairs) {
|
||||
|
||||
($name, $value) = split(/=/, $pair);
|
||||
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
|
||||
$value =~ s/\n//g; $value =~ s/\r//g;
|
||||
|
||||
$FORM{$name} = $value;
|
||||
|
||||
}
|
||||
|
||||
$url = $FORM{'url'};
|
||||
|
||||
}#decode END
|
||||
|
||||
|
||||
|
||||
sub html2{
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
print <<"_HTML_";
|
||||
|
||||
<HTML><HEAD>
|
||||
|
||||
<TITLE>フォームで移動。</TITLE>
|
||||
|
||||
</HEAD></HTML>
|
||||
|
||||
_HTML_
|
||||
|
||||
exit;
|
||||
|
||||
}#html2 END
|
||||
|
||||
__END__
|
||||
163
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/readme.html
Normal file
163
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/readme.html
Normal file
|
|
@ -0,0 +1,163 @@
|
|||
<html>
|
||||
<head><script src="//archive.org/includes/analytics.js?v=cf34f82" type="text/javascript"></script>
|
||||
<script type="text/javascript">window.addEventListener('DOMContentLoaded',function(){var v=archive_analytics.values;v.service='wb';v.server_name='wwwb-app204.us.archive.org';v.server_ms=501;archive_analytics.send_pageview({});});</script>
|
||||
<script type="text/javascript" src="/_static/js/bundle-playback.js?v=UfTkgsKx" charset="utf-8"></script>
|
||||
<script type="text/javascript" src="/_static/js/wombat.js?v=UHAOicsW" charset="utf-8"></script>
|
||||
<script type="text/javascript">
|
||||
__wm.init("https://web.archive.org/web");
|
||||
__wm.wombat("http://www.bea.hi-ho.ne.jp:80/strangeworld/recycle/readme.html","20030212205601","https://web.archive.org/","web","/_static/",
|
||||
"1045083361");
|
||||
</script>
|
||||
<link rel="stylesheet" type="text/css" href="/_static/css/banner-styles.css?v=omkqRugM" />
|
||||
<link rel="stylesheet" type="text/css" href="/_static/css/iconochive.css?v=qtvMKcIJ" />
|
||||
<!-- End Wayback Rewrite JS Include -->
|
||||
|
||||
<meta name="GENERATOR" content="Adobe PageMill 2.0J Mac">
|
||||
<meta http-equiv="Content-Type" content="text/html;CHARSET=x-sjis">
|
||||
<title>MiniBBS v7.5 REQUIEMについてのお知らせ</title>
|
||||
</head>
|
||||
<body text="#ffffff" bgcolor="#004040" link="#ffffee" vlink="#ffffee">
|
||||
<font size="+1"><b>MiniBBS v7.5 REQUIEMについてのお知らせ</b></font>
|
||||
</head>
|
||||
<font size="-1">
|
||||
<p>最終更新日：99.7.01<p>
|
||||
・<a href="https://web.archive.org/web/20030212205601/http://www.rescue.ne.jp/">
|
||||
ネットサーフレスキュー[Ｗｅｂ裏技]</a>で公開されているスクリプトを改造したものを公開しています。<br>
|
||||
・配布に際しては、<a href="https://web.archive.org/web/20030212205601/http://www.ask.ne.jp/~rescue/support/arrange.html">再配布規定</a>に従って、配布していません。<br>
|
||||
・利用に際しては、<a href="https://web.archive.org/web/20030212205601/http://www.rescue.ne.jp/cgi-rescue/cgi?kitei">本家の利用規定</a>に準拠すれば、こちらの規定は無視していいです。勝手に改良して使ってください。ただ、よろしかったら改良したスクリプトを公開してくださるとうれしいです。<hr>
|
||||
・このスクリプトはあやしいわーるどメイン掲示板で使われていたMiniBBS7.5の改良版（<a href="https://web.archive.org/web/20030212205601/http://members.tripod.com/~fumufumu/cgiset.html">こちら</a>にあります）に、いくつか手を加えたものです。<br>
|
||||
<hr>
|
||||
設置サンプルは<a href="https://web.archive.org/web/20030212205601/http://www4.famille.ne.jp/~haruna/requiem/bbs.cgi">こちら</a>です。スクリプトへの質問や意見は<a href="https://web.archive.org/web/20030212205601/http://www4.famille.ne.jp/~haruna/aya3/aya.cgi">こちら</a>で承ります。<p></font>
|
||||
|
||||
|
||||
|
||||
<table border="0" cellpadding="1" cellspacing="1" width="100%">
|
||||
<tr>
|
||||
<td colspan="2" bgcolor="lavender">
|
||||
<p><center><b><font color="#004080" size="+1">MiniBBS v7.5からの変更点</font></b>
|
||||
</center>
|
||||
</td></tr></table>
|
||||
<font size="-1">
|
||||
<p><pre>
|
||||
あやしいわーるどメイン掲示板仕様における変更
|
||||
|
||||
・フォロー投稿機能および、投稿者検索機能
|
||||
・同一投稿内容制限・投稿文字数制限
|
||||
・HTML形式で過去ログを自動出力
|
||||
・カウンターCGIを内蔵（オンオフ可）
|
||||
・管理者名のパスワードとNGワードの設定
|
||||
・登録内容の表示件数と、背景色のカスタマイズ
|
||||
・削除スクリプトを独立
|
||||
・投稿者のリモートホスト取得を廃止
|
||||
|
||||
（注1：NGワードの設定は現在のバージョンでは機能しません。）
|
||||
（注2：削除スクリプトは現在のバージョンではサポートしていません。）
|
||||
</pre>
|
||||
<hr><pre>
|
||||
あやしいわーるどメイン掲示板仕様を改良した点
|
||||
|
||||
・投稿者名および、題名を入れなくても記入可能に
|
||||
・過去ログを時間により切り取ったり、単語検索できる機能（ログ商人）
|
||||
・同一時刻の投稿に対するフォロー投稿が重複しない（くずは）
|
||||
・簡単なPerlDUKE・GabiriDUKE対策（くずは）
|
||||
・一日の過去ログが一定量を超すと書き込み不能に（くずは）
|
||||
・一定期間たった過去ログを自動削除（くずは）
|
||||
・過去ログでの参考記事の記載がシンプルに（くずは）
|
||||
・投稿記事内のURLに自動でリンクを張る
|
||||
・スレッド上の投稿の一括表示機能
|
||||
・行数および改行連打の投稿制限
|
||||
・他のURLのリンクをセレクタにまとめる
|
||||
・0件リロードで未読メッセージのみ表示
|
||||
・カウンター制御式の、DUKE対策
|
||||
</pre>
|
||||
<hr><pre>
|
||||
今後の改良予定
|
||||
|
||||
・NGワードと、過去ログ削除のバグ取り
|
||||
・同一フォームからの手動荒らし対策
|
||||
・ツリー表示
|
||||
・返信等のスイッチをボタンに変更可能に
|
||||
・ポップアップウインドウの設定を変更可能に
|
||||
・過去ログ・投稿の削除スクリプト
|
||||
|
||||
</pre>
|
||||
<p>
|
||||
|
||||
|
||||
<table border="0" cellpadding="1" cellspacing="1" width="100%">
|
||||
<tr bgcolor="#ffffffff"><td align="center" height="20"><font color="#004080"><b>準備</b>（必要ファイルをダウンロードして下さい）</font></td></tr></table>
|
||||
<br><font size="-1">
|
||||
<a href="bbs.txt">bbs.txt</a>、<a href="jcode.txt">jcode.txt</a>
|
||||
<a href="getlog.txt">getlog.txt</a>、<a href="location.txt">location.txt</a>はテキストで保存して名称をbbs.cgi、jcode.pl
|
||||
、getlog.cgi、location.cgiにそれぞれ変えて下さい。（jcode.plはすでに持っていればそれでも構いません）<br>
|
||||
それからエディターで中身が空っぽのテキストファイルと、
|
||||
1とだけ書かれたテキストファイルを用意してください。（ここでダウンロードもできます）<p><font size="+0">
|
||||
<br>ダウンロードするファイル<p><a href="bbs.txt">bbs.txt</a> <a href="jcode.txt">jcode.txt</a> <a href="getlog.txt">getlog.txt</a> <a href="location.txt">location.txt</a> <a href="delete.txt">delete.txt</a><p>
|
||||
自分で用意するファイル<p><a href="loveyou.dat">loveyou.dat</a>、<a href="count0.txt">count0.txt</a><br></font><p>
|
||||
|
||||
|
||||
<table border="0" cellpadding="1" cellspacing="1" width="100%">
|
||||
<tr>
|
||||
<td colspan="2" bgcolor="lavender">
|
||||
<p><center><b><font size="+1" color="#004080">基本構成</font></b><font color="#004080">（初期設定はこの構成を前提に解説します）</font>
|
||||
</center>
|
||||
</td></tr></table>
|
||||
<pre><br><font size="-1">
|
||||
<p>public_html（ホームディレクトリ）
|
||||
|
|
||||
|-- cgi-bin（任意）
|
||||
|
|
||||
|-- bbs.cgi (755) メインのスクリプト。
|
||||
|-- getlog.cgi (755) 過去ログ切り取り用のスクリプト
|
||||
|-- location.cgi (755) URL移動用スクリプト
|
||||
|-- delete.cgi (755) 投稿削除スクリプト
|
||||
|-- jcode.pl (755) CGIが使用するライブラリ
|
||||
|-- loveyou.dat (666) データが記録されるファイル
|
||||
|
|
||||
|-- log (フォルダ 777) 記録されたログをためるフォルダ（空でいいです）
|
||||
|
|
||||
|-- count (フォルダ 777) カウンターをためるフォルダ
|
||||
|
|
||||
|-- count0.txt (755) 最初に入れるカウンター
|
||||
|
||||
|
||||
( )内はパーミッション値
|
||||
|
||||
|
||||
・bbs.cgi、getlog.cgiはアップ前に中を開いて説明に従って設定を書き換えること。
|
||||
|
||||
・loveyou.datは中身が空っぽのファイルをそのままアップ
|
||||
※悪戯されない為にも必ず名前を違う名前に書き換えて下さい。
|
||||
（その際、bbs.cgiの中の設定も書き換えるのを忘れずに！）
|
||||
|
||||
・jcode.plは中身を全くいじらずにそのままアスキー転送する
|
||||
|
||||
・これら７つのファイルはアスキーモードで転送すること
|
||||
|
||||
・counter0.txtは中身が空っぽのファイルに1とだけ入れて転送すること
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
<!--
|
||||
FILE ARCHIVED ON 20:56:01 Feb 12, 2003 AND RETRIEVED FROM THE
|
||||
INTERNET ARCHIVE ON 03:23:41 Oct 05, 2021.
|
||||
JAVASCRIPT APPENDED BY WAYBACK MACHINE, COPYRIGHT INTERNET ARCHIVE.
|
||||
|
||||
ALL OTHER CONTENT MAY ALSO BE PROTECTED BY COPYRIGHT (17 U.S.C.
|
||||
SECTION 108(a)(3)).
|
||||
-->
|
||||
<!--
|
||||
playback timings (ms):
|
||||
captures_list: 285.759
|
||||
exclusion.robots: 107.161
|
||||
exclusion.robots.policy: 107.15
|
||||
xauthn.identify: 59.205
|
||||
xauthn.chkprivs: 47.719
|
||||
RedisCDXSource: 1.5
|
||||
esindex: 0.008
|
||||
LoadShardBlock: 159.904 (3)
|
||||
PetaboxLoader3.datanode: 168.004 (4)
|
||||
CDXLines.iter: 15.05 (3)
|
||||
load_resource: 210.677
|
||||
PetaboxLoader3.resolve: 186.039
|
||||
-->
|
||||
61
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/update.html
Normal file
61
[1999-06-20 - 1999-07-12] REQUIEM (aka RECYCLE)/update.html
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
<html><script src="//archive.org/includes/analytics.js?v=cf34f82" type="text/javascript"></script>
|
||||
<script type="text/javascript">window.addEventListener('DOMContentLoaded',function(){var v=archive_analytics.values;v.service='wb';v.server_name='wwwb-app209.us.archive.org';v.server_ms=300;archive_analytics.send_pageview({});});</script>
|
||||
<script type="text/javascript" src="/_static/js/bundle-playback.js?v=UfTkgsKx" charset="utf-8"></script>
|
||||
<script type="text/javascript" src="/_static/js/wombat.js?v=UHAOicsW" charset="utf-8"></script>
|
||||
<script type="text/javascript">
|
||||
__wm.init("https://web.archive.org/web");
|
||||
__wm.wombat("http://www.bea.hi-ho.ne.jp:80/strangeworld/recycle/update.html","20030212205712","https://web.archive.org/","web","/_static/",
|
||||
"1045083432");
|
||||
</script>
|
||||
<link rel="stylesheet" type="text/css" href="/_static/css/banner-styles.css?v=omkqRugM" />
|
||||
<link rel="stylesheet" type="text/css" href="/_static/css/iconochive.css?v=qtvMKcIJ" />
|
||||
<!-- End Wayback Rewrite JS Include -->
|
||||
<pre>
|
||||
更新状況
|
||||
|
||||
99/07/01
|
||||
|
||||
同一カウンターの投稿があると書き込めないエラーの修正。
|
||||
スレッド表示で自動リンクしないエラーの修正。
|
||||
0件リロードの時にゴミは表示しないようにする。
|
||||
|
||||
99/06/27
|
||||
|
||||
カウンター制御式の、DUKE対策を追加。
|
||||
|
||||
99/6/25
|
||||
|
||||
0件リロードで未読メッセージのみ表示。
|
||||
自動リンクのON・OFFをチェックボックスで選択。
|
||||
|
||||
|
||||
99/6/20
|
||||
|
||||
フォロー投稿時に、>>のみで改行にならないようにする。
|
||||
過去ログの背景色がデフォルトの設定と同一になるようにする。
|
||||
|
||||
99/6/19
|
||||
|
||||
MiniBBS 7.5REQUIEMに改名。</pre></html><!--
|
||||
FILE ARCHIVED ON 20:57:12 Feb 12, 2003 AND RETRIEVED FROM THE
|
||||
INTERNET ARCHIVE ON 04:10:42 Oct 05, 2021.
|
||||
JAVASCRIPT APPENDED BY WAYBACK MACHINE, COPYRIGHT INTERNET ARCHIVE.
|
||||
|
||||
ALL OTHER CONTENT MAY ALSO BE PROTECTED BY COPYRIGHT (17 U.S.C.
|
||||
SECTION 108(a)(3)).
|
||||
-->
|
||||
<!--
|
||||
playback timings (ms):
|
||||
captures_list: 186.889
|
||||
exclusion.robots: 127.871
|
||||
exclusion.robots.policy: 127.852
|
||||
xauthn.identify: 93.847
|
||||
xauthn.chkprivs: 33.575
|
||||
RedisCDXSource: 1.108
|
||||
esindex: 0.015
|
||||
LoadShardBlock: 34.455 (3)
|
||||
PetaboxLoader3.datanode: 97.012 (4)
|
||||
CDXLines.iter: 19.725 (3)
|
||||
load_resource: 106.09
|
||||
PetaboxLoader3.resolve: 31.426
|
||||
-->
|
||||
1079
[1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/bbs.cgi
Normal file
1079
[1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/bbs.cgi
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -0,0 +1,326 @@
|
|||
#! /usr/local/bin/perl
|
||||
|
||||
|
||||
#はじあや＠ふぁみーるのパソヲタさん、本当にありがとう
|
||||
|
||||
|
||||
#--------------------
|
||||
|
||||
$body = '<body bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">';
|
||||
$bbstitle ="あやしいわーるどREFLEX";
|
||||
|
||||
|
||||
$logdir = './log/';
|
||||
|
||||
$cgiurl = 'getlog_m.cgi';
|
||||
$action ='getlog';
|
||||
|
||||
$bbsurl = './bbs.cgi';
|
||||
|
||||
# 日本語コード変換ライブラリjocde.plのパス
|
||||
require './jcode.pl';
|
||||
|
||||
# キーワードの最大文字数（半角）
|
||||
$keylength = 64;
|
||||
|
||||
# 時差 サーバの時計がずれてる時や日本時間以外にしたい時に使う
|
||||
$tim = 0;
|
||||
|
||||
$\ = "\n";
|
||||
#--------------------
|
||||
#if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
#else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
|
||||
|
||||
$buffer = $ENV{'QUERY_STRING'};
|
||||
|
||||
|
||||
@argv = split(/&/,$buffer);
|
||||
foreach (@argv) {
|
||||
($name, $value) = split(/=/);
|
||||
$value =~ tr/+/ /;
|
||||
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
&jcode'convert(*value,'sjis');
|
||||
|
||||
$COMMAND{$name} = $value;
|
||||
}
|
||||
|
||||
|
||||
&error(2) if (length($COMMAND{'keyword'}) > $keylength);
|
||||
&viewlog if ($COMMAND{'action'} eq "$action");
|
||||
|
||||
|
||||
&list;
|
||||
|
||||
sub list {
|
||||
|
||||
&error(0) if(!opendir(DIR, $logdir));
|
||||
|
||||
@files=readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
@files = sort by_number @files;
|
||||
$end = @files;
|
||||
$end--;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ</title></head>\n";
|
||||
print "$body\n";
|
||||
print "<center>\n";
|
||||
print "<table border=0 cellpadding=1 cellspacing=1 width=100%><tr>";
|
||||
print "<td bgcolor=007f7f align=center><font color=ffffff><b>$bbstitle 過去ログ一覧</b></font></td></tr></table>";
|
||||
print "<form method=get action=\"$cgiurl\">";
|
||||
print "<input type=hidden name=\"action\" value=\"$action\">";
|
||||
print "<table>";
|
||||
print "<tr><td></td><td>ファイル名</td><td align=right>サイズ</td><td align=center>日付</td></tr>";
|
||||
foreach (0 .. $end) {
|
||||
if (!($files[$_] eq "." or $files[$_] eq "..")) {
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$logdir$files[$_]";
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($mtime + 32400 + $tim);
|
||||
$mon++;
|
||||
$mon = "0$mon" if ($mon < 10);
|
||||
if ($mday < 10) { $mday = "0$mday"; }
|
||||
if ($min < 10) { $min = "0$min"; }
|
||||
if ($hour < 10) { $hour = "0$hour"; }
|
||||
$checked = ' checked' if ($_ == $end);
|
||||
print "<tr><td><input type=\"radio\" name=\"logfile\" value=\"$files[$_]\"$checked></td>";
|
||||
print "<td><a href=\"$logdir$files[$_]\">$files[$_]</a></td>";
|
||||
print "<td align=right>$size</td><td align=center>$mon/$mday $hour:$min</td></tr>";
|
||||
}
|
||||
}
|
||||
|
||||
print "<tr><td></td></tr><tr><td colspan=4>※ラジオボタンでファイル名を指定してください。</td></tr><tr><td></td></tr>\n";
|
||||
print "<tr><td colspan=4>日時指定：<select name=\"day1\">";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"26\">26";
|
||||
print "<option value=\"27\">27";
|
||||
print "<option value=\"28\">28";
|
||||
print "<option value=\"29\">29";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"31\">31";
|
||||
print "</select>日<select name=\"hour1\">";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時から";
|
||||
|
||||
print "<select name=\"day2\">";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"25\">25";
|
||||
print "<option value=\"26\">26";
|
||||
print "<option value=\"27\">27";
|
||||
print "<option value=\"28\">28";
|
||||
print "<option value=\"29\">29";
|
||||
print "<option value=\"30\">30";
|
||||
print "<option value=\"31\" selected>31";
|
||||
print "</select>日<select name=\"hour2\">";
|
||||
print "<option value=\"24\">24";
|
||||
print "<option value=\"00\">00";
|
||||
print "<option value=\"01\">01";
|
||||
print "<option value=\"02\">02";
|
||||
print "<option value=\"03\">03";
|
||||
print "<option value=\"04\">04";
|
||||
print "<option value=\"05\">05";
|
||||
print "<option value=\"06\">06";
|
||||
print "<option value=\"07\">07";
|
||||
print "<option value=\"08\">08";
|
||||
print "<option value=\"09\">09";
|
||||
print "<option value=\"10\">10";
|
||||
print "<option value=\"11\">11";
|
||||
print "<option value=\"12\">12";
|
||||
print "<option value=\"13\">13";
|
||||
print "<option value=\"14\">14";
|
||||
print "<option value=\"15\">15";
|
||||
print "<option value=\"16\">16";
|
||||
print "<option value=\"17\">17";
|
||||
print "<option value=\"18\">18";
|
||||
print "<option value=\"19\">19";
|
||||
print "<option value=\"20\">20";
|
||||
print "<option value=\"21\">21";
|
||||
print "<option value=\"22\">22";
|
||||
print "<option value=\"23\">23";
|
||||
print "</select>時まで";
|
||||
|
||||
print "</td></tr><br>";
|
||||
print " <tr><td colspan=4> 検索 ：<select name=\"searchmode\">";
|
||||
print "<option value=\"keyword\">全文";
|
||||
print "<option value=\"bbs\">掲示板名";
|
||||
print "<option value=\"name\">投稿者名";
|
||||
print "<option value=\"subject\">題名\n</select>";
|
||||
print "<input type=text name=\"keyword\" size=\"24\" maxlength=$keylength></td></tr>";
|
||||
print "<tr><td colspan=4 align=center><input type=submit value=\"Get / Search\"></form></td></tr><br>";
|
||||
print "</table>";
|
||||
print "<hr>";
|
||||
print "<p align=center><a href=\"$bbsurl\">掲示板へ</a></p>";
|
||||
print "<h4 align=right>Getlog Ver0.3b4 月単位保存ログ対応版</h4>";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub viewlog {
|
||||
|
||||
if (!open(DB,"$logdir$COMMAND{'logfile'}")) { &error(1); }
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
|
||||
$COMMAND{'last'} = $COMMAND{'first'} + 1 if ($COMMAND{'first'} >= $COMMAND{'last'});
|
||||
$first = "$COMMAND{'day1'}日$COMMAND{'hour1'}時";
|
||||
$last = "$COMMAND{'day2'}日$COMMAND{'hour2'}時";
|
||||
|
||||
if ($COMMAND{'searchmode'} eq 'name') { $keyword = "投稿者：.*>${COMMAND{'keyword'}}<"; }
|
||||
|
||||
elsif ($COMMAND{'searchmode'} eq 'subject') { $keyword = "color=\"#ffffee\"><b>${COMMAND{'keyword'}}</b></font>"; }
|
||||
|
||||
elsif ($COMMAND{'searchmode'} eq 'bbs') { $keyword = "秒 .*>${COMMAND{'keyword'}}<"; }
|
||||
|
||||
else { $keyword = $COMMAND{'keyword'}; }
|
||||
if ($keyword ne '') {
|
||||
$keyword =~ s/\\/\\\\/;
|
||||
$keyword =~ s/\[/\\[/;
|
||||
}
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>$bbstitle 過去ログ $COMMAND{'logfile'}</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$COMMAND{'logfile'} $first～$last</h1>";
|
||||
$end = @lines;
|
||||
$end--;
|
||||
foreach (0 .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
substr( $hour = substr( $lines[$_], 28, 12 ), 4, 4 ) = "" ;
|
||||
last if ($hour ge "$first");
|
||||
}
|
||||
$skip++;
|
||||
}
|
||||
$skip--;
|
||||
# print"<hr>";
|
||||
$\ = '';
|
||||
foreach ($skip .. $end) {
|
||||
# MiniBBS7.5あやしいわーるど仕様
|
||||
if ($lines[$_] =~ /<font size=-1> 投稿日：/) {
|
||||
substr( $hour = substr( $lines[$_], 28, 12 ), 4, 4 ) = "" ;
|
||||
|
||||
last if ($hour ge "$last");
|
||||
}
|
||||
|
||||
|
||||
if ($keyword ne '') {
|
||||
if ($lines[$_] =~ /$keyword/) {
|
||||
$flag = 1;
|
||||
$hit++;
|
||||
}
|
||||
push( @article, $lines[$_] );
|
||||
if ($lines[$_] =~ /<\/blockquote>/) {
|
||||
print @article if ($flag > 0);
|
||||
splice( @article, 0 );
|
||||
$flag = 0;
|
||||
}
|
||||
}
|
||||
else { print $lines[$_]; }
|
||||
|
||||
}
|
||||
$\ = "\n";
|
||||
if ($COMMAND{'keyword'} ne '') {
|
||||
print "<hr>";
|
||||
if ( $hit > 0 ) { print "<h3>「$COMMAND{'keyword'}」は $hit件見つかりました。</h3>"; }
|
||||
else { print "<h3>「$COMMAND{'keyword'}」は見つかりませんでした。</h3>"; }
|
||||
}
|
||||
print "</body></html>";
|
||||
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub error {
|
||||
|
||||
$error = $_[0];
|
||||
if ($error == 0) { $errmsg = 'ディレクトリが開けませんでした。'; }
|
||||
if ($error == 1) { $errmsg = 'ファイルが開けませんでした。'; }
|
||||
if ($error == 2) { $errmsg = 'キーワードが長すぎます。'; }
|
||||
|
||||
print "Content-type: text/html\n";
|
||||
print "<html><head><title>エラー</title></head>";
|
||||
print "$body";
|
||||
print "<h1>$errmsg</h1>";
|
||||
print "</body></html>";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
sub by_number {
|
||||
$a <=> $b;
|
||||
}
|
||||
618
[1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/jcode.pl
Normal file
618
[1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/jcode.pl
Normal file
|
|
@ -0,0 +1,618 @@
|
|||
package jcode;
|
||||
;######################################################################
|
||||
;#
|
||||
;# jcode.pl: Perl library for Japanese character code conversion
|
||||
;#
|
||||
;# Copyright (c) 1995,1996 Kazumasa Utashiro <utashiro@iij.ad.jp>
|
||||
;# Internet Initiative Japan Inc.
|
||||
;# 1-4 Sanban-cho, Chiyoda-ku, Tokyo 102, Japan
|
||||
;#
|
||||
;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
|
||||
;# Software Research Associates, Inc.
|
||||
;# Original by srekcah@sra.co.jp, Feb 1992
|
||||
;#
|
||||
;# Redistribution for any purpose, without significant modification,
|
||||
;# is granted as long as all copyright notices are retained. THIS
|
||||
;# SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
|
||||
;# IMPLIED WARRANTIES ARE DISCLAIMED.
|
||||
;#
|
||||
;; $rcsid = q$Id: jcode.pl,v 2.0 1996/10/02 16:02:38 utashiro Rel $;
|
||||
;#
|
||||
;######################################################################
|
||||
;#
|
||||
;# INTERFACE:
|
||||
;#
|
||||
;# &jcode'getcode(*line)
|
||||
;# Return 'jis', 'sjis', 'euc' or undef according to
|
||||
;# Japanese character code in $line. Return 'binary' if
|
||||
;# the data has non-character code.
|
||||
;#
|
||||
;# Code detection between euc and sjis is very difficult
|
||||
;# or sometimes impossible or even lead to wrong result
|
||||
;# when it's include JIS X0201 KANA characters. So JIS
|
||||
;# X0201 KANA is ignored for automatic code detection.
|
||||
;#
|
||||
;# &jcode'convert(*line, $ocode [, $icode [, $option]])
|
||||
;# Convert the line in any Japanese code to the specified
|
||||
;# code in the second argument $ocode. $ocode can be any
|
||||
;# of "jis", "sjis" or "euc", or use "noconv" when you
|
||||
;# don't want the code conversion. Input code is
|
||||
;# recognized automatically from the line itself when
|
||||
;# $icode is not supplied (JIS X0201 KANA is ignored.
|
||||
;# See above). $icode also can be specified, but xxx2yyy
|
||||
;# routine is more efficient when both codes are known.
|
||||
;#
|
||||
;# It returns a list of pointer of convert subroutine and
|
||||
;# input code. It means that this routine returns the
|
||||
;# input code of the line in scalar context.
|
||||
;#
|
||||
;# See next paragraph for $option parameter.
|
||||
;#
|
||||
;# &jcode'xxx2yyy(*line [, $option])
|
||||
;# Convert the Japanese code from xxx to yyy. String xxx
|
||||
;# and yyy are any convination from "jis", "euc" or
|
||||
;# "sjis". They return *approximate* number of converted
|
||||
;# bytes. So return value 0 means the line was not
|
||||
;# converted at all.
|
||||
;#
|
||||
;# Optional parameter $option is used to specify optional
|
||||
;# conversion method. String "z" is for JIS X0201 KANA
|
||||
;# to X0208 KANA, and "h" is for reverse.
|
||||
;#
|
||||
;# $jcode'convf{'xxx', 'yyy'}
|
||||
;# The value of this associative array is pointer to the
|
||||
;# subroutine jcode'xxx2yyy().
|
||||
;#
|
||||
;# &to($ocode, $line [, $icode [, $option]])
|
||||
;# &jis($line [, $icode [, $option]])
|
||||
;# &euc($line [, $icode [, $option]])
|
||||
;# &sjis($line [, $icode [, $option]])
|
||||
;# These functions are prepared for easy use of
|
||||
;# call/return-by-value interface. You can use these
|
||||
;# funcitons in s///e operation or any other place for
|
||||
;# convenience.
|
||||
;#
|
||||
;# &jcode'jis_inout($in, $out)
|
||||
;# Set or inquire JIS start and end sequences. Default
|
||||
;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
|
||||
;# character, "ESC-$" or "ESC-(" is added as a prefix
|
||||
;# for each character respectively. Acutually "ESC-(-B"
|
||||
;# is not a sequence to end JIS code but a sequence to
|
||||
;# start ASCII code set. So `in' and `out' are somewhat
|
||||
;# misleading.
|
||||
;#
|
||||
;# &jcode'get_inout($string)
|
||||
;# Get JIS start and end sequences from $string.
|
||||
;#
|
||||
;# &jcode'cache()
|
||||
;# &jcode'nocache()
|
||||
;# &jcode'flush()
|
||||
;# Usually, converted character is cached in memory to
|
||||
;# avoid same calculations have to be done many times.
|
||||
;# To disable this caching, call &jcode'nocache(). It
|
||||
;# can be revived by &jcode'cache() and cache is flushed
|
||||
;# by calling &jcode'flush(). &cache() and &nocache()
|
||||
;# functions return previous caching state.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'h2z_xxx(*line);
|
||||
;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
|
||||
;# (Zenkaku-KANA) code conversion routine. String xxx is
|
||||
;# any of "jis", "sjis" and "euc". From the difficulty
|
||||
;# of recognizing code set from 1-byte KATAKANA string,
|
||||
;# automatic code recognition is not supported.
|
||||
;#
|
||||
;# &jcode'z2h_xxx(*line);
|
||||
;# X0208 to X0201 KANA code conversion routine. String
|
||||
;# xxx is any of "jis", "sjis" and "euc".
|
||||
;#
|
||||
;# $jcode'z2hf{'xxx'}
|
||||
;# $jcode'h2zf{'xxx'}
|
||||
;# These are pointer to the corresponding function just
|
||||
;# as $jcode'convf.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'tr(*line, $from, $to [, $option]);
|
||||
;# &jcode'tr emulates tr operator for 2 byte code. This
|
||||
;# funciton is under construction and doesn't have full
|
||||
;# feature of tr. Range operator like a-z is partially
|
||||
;# supported: JIS or EUC and first byte should be same on
|
||||
;# first and last character (so HIRAGANA-KATAKANA
|
||||
;# conversion is possible). Only 'd' is interpreted as
|
||||
;# option.
|
||||
;#
|
||||
;# &jcode'trans($line, $from, $to [, $option);
|
||||
;# Same as &jcode'tr but accept string and return string
|
||||
;# after translation.
|
||||
;#
|
||||
;# ---------------------------------------------------------------
|
||||
;#
|
||||
;# &jcode'init()
|
||||
;# Initialize the variables used in other functions. You
|
||||
;# don't have to call this when using jocde.pl by do or
|
||||
;# require. Call it first if you embedded the jcode.pl
|
||||
;# in your script.
|
||||
;#
|
||||
;######################################################################
|
||||
;#
|
||||
;# SAMPLES
|
||||
;#
|
||||
;# Convert any Kanji code to JIS and print each line with code name.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# $code = &jcode'convert(*_, 'jis');
|
||||
;# print $code, "\t", $_;
|
||||
;# }
|
||||
;#
|
||||
;# Convert all lines to JIS according to the first recognized line.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# print, next unless /[\033\200-\377]/;
|
||||
;# (*f, $icode) = &jcode'convert(*_, 'jis');
|
||||
;# print;
|
||||
;# defined(&f) || next;
|
||||
;# while (<>) { &f(*_); print; }
|
||||
;# last;
|
||||
;# }
|
||||
;#
|
||||
;# The safest way of JIS conversion.
|
||||
;#
|
||||
;# while (<>) {
|
||||
;# ($matched, $code) = &jcode'getcode(*_);
|
||||
;# print, next unless (@buf || $matched);
|
||||
;# push(@readahead, $_);
|
||||
;# next unless $code;
|
||||
;# eval "&jcode'${code}2jis(*_), print while (\$_ = shift(\@buf));";
|
||||
;# eval "&jcode'${code}2jis(*_), print while (\$_ = <>);";
|
||||
;# last;
|
||||
;# }
|
||||
;#
|
||||
;######################################################################
|
||||
|
||||
;#
|
||||
;# Call initialize function if it is not called yet. This may sound
|
||||
;# strange but it makes easy to embed the jcode.pl at the end of
|
||||
;# script. Call &jcode'init at the beginning of the script in that
|
||||
;# case.
|
||||
;#
|
||||
&init unless defined $version;
|
||||
|
||||
;#
|
||||
;# Initialize variables.
|
||||
;#
|
||||
sub init {
|
||||
$version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
|
||||
|
||||
$re_bin = '[\000-\006\177\377]';
|
||||
|
||||
$re_jp = '\e\$[\@B]';
|
||||
$re_asc = '\e\([BJ]';
|
||||
$re_kana = '\e\(I';
|
||||
($esc_jp, $esc_asc, $esc_kana) = ("\e\$B", "\e(B", "\e(I");
|
||||
|
||||
$re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
|
||||
$re_sjis_kana = '[\241-\337]';
|
||||
|
||||
$re_euc_c = '[\241-\376][\241-\376]';
|
||||
$re_euc_kana = '\216[\241-\337]';
|
||||
|
||||
# These variables are retained only for backward compatibility.
|
||||
$re_euc_s = "($re_euc_c)+";
|
||||
$re_sjis_s = "($re_sjis_c)+";
|
||||
|
||||
$cache = 1;
|
||||
|
||||
# X0201 -> X0208 KANA conversion table. Looks weird? Not that
|
||||
# much. This is simply JIS text without escape sequences.
|
||||
($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\021-\176/\221-\376/;
|
||||
! !# $ !" % !& " !V # !W
|
||||
^ !+ _ !, 0 !<
|
||||
' %! ( %# ) %% * %' + %)
|
||||
, %c - %e . %g / %C
|
||||
1 %" 2 %$ 3 %& 4 %( 5 %*
|
||||
6 %+ 7 %- 8 %/ 9 %1 : %3
|
||||
6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
|
||||
; %5 < %7 = %9 > %; ? %=
|
||||
;^ %6 <^ %8 =^ %: >^ %< ?^ %>
|
||||
@ %? A %A B %D C %F D %H
|
||||
@^ %@ A^ %B B^ %E C^ %G D^ %I
|
||||
E %J F %K G %L H %M I %N
|
||||
J %O K %R L %U M %X N %[
|
||||
J^ %P K^ %S L^ %V M^ %Y N^ %\
|
||||
J_ %Q K_ %T L_ %W M_ %Z N_ %]
|
||||
O %^ P %_ Q %` R %a S %b
|
||||
T %d U %f V %h
|
||||
W %i X %j Y %k Z %l [ %m
|
||||
\ %o ] %s & %r 3^ %t
|
||||
__TABLE_END__
|
||||
%h2z = split(/\s+/, $h2z . $h2z_high);
|
||||
%z2h = reverse %h2z;
|
||||
|
||||
$_ = '';
|
||||
for $f ('jis', 'sjis', 'euc') {
|
||||
for $t ('jis', 'sjis', 'euc') {
|
||||
$_ .= "\$convf{'$f', '$t'} = *${f}2${t};\n";
|
||||
}
|
||||
$_ .= "\$h2zf{'$f'} = *h2z_${f};\n\$z2hf{'$f'} = *z2h_${f};\n";
|
||||
}
|
||||
eval $_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Set escape sequences which should be put before and after Japanese
|
||||
;# (JIS X0208) string.
|
||||
;#
|
||||
sub jis_inout {
|
||||
$esc_jp = shift || $esc_jp;
|
||||
$esc_jp = "\e\$$esc_jp" if length($esc_jp) == 1;
|
||||
$esc_asc = shift || $esc_asc;
|
||||
$esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
|
||||
($esc_jp, $esc_asc);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Get JIS in and out sequences from the string.
|
||||
;#
|
||||
sub get_inout {
|
||||
local($esc_jp, $esc_asc);
|
||||
$_[$[] =~ /$re_jp/o && ($esc_jp = $&);
|
||||
$_[$[] =~ /$re_asc/o && ($esc_asc = $&);
|
||||
($esc_jp, $esc_asc);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Recognize character code.
|
||||
;#
|
||||
sub getcode {
|
||||
local(*_) = @_;
|
||||
return undef unless /[\e\200-\377]/;
|
||||
return 'jis' if /$re_jp|$re_asc|$re_kana/o;
|
||||
return 'binary' if /$re_bin/o;
|
||||
|
||||
local($sjis, $euc);
|
||||
$sjis += length($&) while /($re_sjis_c)+/go;
|
||||
$euc += length($&) while /($re_euc_c)+/go;
|
||||
(&max($sjis, $euc), ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1]);
|
||||
}
|
||||
sub max { $_[ $[ + ($_[$[] < $_[$[+1]) ]; }
|
||||
|
||||
;#
|
||||
;# Convert any code to specified code.
|
||||
;#
|
||||
sub convert {
|
||||
local(*_, $ocode, $icode, $opt) = @_;
|
||||
return (undef, undef) unless $icode = $icode || &getcode(*_);
|
||||
return (undef, $icode) if $icode eq 'binary';
|
||||
$ocode = 'jis' unless $ocode;
|
||||
$ocode = $icode if $ocode eq 'noconv';
|
||||
local(*convf) = $convf{$icode, $ocode};
|
||||
do convf(*_, $opt);
|
||||
(*convf, $icode);
|
||||
}
|
||||
|
||||
;#
|
||||
;# Easy return-by-value interfaces.
|
||||
;#
|
||||
sub jis { &to('jis', @_); }
|
||||
sub euc { &to('euc', @_); }
|
||||
sub sjis { &to('sjis', @_); }
|
||||
sub to {
|
||||
local($ocode, $_, $icode, $opt) = @_;
|
||||
&convert(*_, $ocode, $icode, $opt);
|
||||
$_;
|
||||
}
|
||||
sub what {
|
||||
local($_) = @_;
|
||||
&getcode(*_);
|
||||
}
|
||||
sub trans {
|
||||
local($_) = shift;
|
||||
&tr(*_, @_);
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# SJIS to JIS
|
||||
;#
|
||||
sub sjis2jis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&sjis2sjis(*_, $opt) if $opt;
|
||||
if (s/($re_sjis_kana)+|($re_sjis_c)+/&_sjis2jis($&)/geo) {
|
||||
s/$re_asc($re_jp|$re_kana)/$1/go;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _sjis2jis {
|
||||
local($_) = @_;
|
||||
if (/^$re_sjis_kana/o) {
|
||||
$n += tr/\241-\337/\041-\137/;
|
||||
$esc_kana . $_ . $esc_asc;
|
||||
} else {
|
||||
$n += s/$re_sjis_c/$s2e{$&}||&s2e($&)/geo;
|
||||
tr/\241-\376/\041-\176/;
|
||||
$esc_jp . $_ . $esc_asc;
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# EUC to JIS
|
||||
;#
|
||||
sub euc2jis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
if (s/($re_euc_kana)+|($re_euc_c)+/&_euc2jis($&)/geo) {
|
||||
s/$re_asc($re_jp|$re_kana)/$1/go;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _euc2jis {
|
||||
local($_) = @_;
|
||||
local($esc) = tr/\216//d ? $esc_kana : $esc_jp;
|
||||
$n += tr/\241-\376/\041-\176/;
|
||||
$esc . $_ . $esc_asc;
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to EUC
|
||||
;#
|
||||
sub jis2euc {
|
||||
local(*_, $opt, $n) = @_;
|
||||
s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n;
|
||||
}
|
||||
sub _jis2euc {
|
||||
local($esc, $_) = @_;
|
||||
if ($esc !~ /$re_asc/o) {
|
||||
$n += tr/\041-\176/\241-\376/;
|
||||
s/[\241-\337]/\216$&/g if $esc =~ /$re_kana/o;
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to SJIS
|
||||
;#
|
||||
sub jis2sjis {
|
||||
local(*_, $opt, $n) = @_;
|
||||
&jis2jis(*_, $opt) if $opt;
|
||||
s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
|
||||
$n;
|
||||
}
|
||||
sub _jis2sjis {
|
||||
local($esc, $_) = @_;
|
||||
if ($esc !~ /$re_asc/o) {
|
||||
$n += tr/\041-\176/\241-\376/;
|
||||
s/$re_euc_c/$e2s{$&}||&e2s($&)/geo if $esc =~ /$re_jp/o;
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
;#
|
||||
;# SJIS to EUC
|
||||
;#
|
||||
sub sjis2euc {
|
||||
local(*_, $opt,$n) = @_;
|
||||
$n = s/$re_sjis_kana|$re_sjis_c/$s2e{$&}||&s2e($&)/geo;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n;
|
||||
}
|
||||
sub s2e {
|
||||
local($c1, $c2, $code);
|
||||
($c1, $c2) = unpack('CC', $code = shift);
|
||||
|
||||
if (0xa1 <= $c1 && $c1 <= 0xdf) {
|
||||
$c2 = $c1;
|
||||
$c1 = 0x8e;
|
||||
} elsif (0x9f <= $c2) {
|
||||
$c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
|
||||
$c2 += 2;
|
||||
} else {
|
||||
$c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
|
||||
$c2 += 0x60 + ($c2 < 0x7f);
|
||||
}
|
||||
if ($cache) {
|
||||
$s2e{$code} = pack('CC', $c1, $c2);
|
||||
} else {
|
||||
pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# EUC to SJIS
|
||||
;#
|
||||
sub euc2sjis {
|
||||
local(*_, $opt,$n) = @_;
|
||||
&euc2euc(*_, $opt) if $opt;
|
||||
$n = s/$re_euc_c|$re_euc_kana/$e2s{$&}||&e2s($&)/geo;
|
||||
}
|
||||
sub e2s {
|
||||
local($c1, $c2, $code);
|
||||
($c1, $c2) = unpack('CC', $code = shift);
|
||||
|
||||
if ($c1 == 0x8e) {
|
||||
return substr($code, 1, 1);
|
||||
} elsif ($c1 % 2) {
|
||||
$c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
|
||||
$c2 -= 0x60 + ($c2 < 0xe0);
|
||||
} else {
|
||||
$c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
|
||||
$c2 -= 2;
|
||||
}
|
||||
if ($cache) {
|
||||
$e2s{$code} = pack('CC', $c1, $c2);
|
||||
} else {
|
||||
pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
|
||||
;#
|
||||
;# JIS to JIS, SJIS to SJIS, EUC to EUC
|
||||
;#
|
||||
sub jis2jis {
|
||||
local(*_, $opt) = @_;
|
||||
s/$re_jp/$esc_jp/go;
|
||||
s/$re_asc/$esc_asc/go;
|
||||
&h2z_jis(*_) if $opt =~ /z/;
|
||||
&z2h_jis(*_) if $opt =~ /h/;
|
||||
}
|
||||
sub sjis2sjis {
|
||||
local(*_, $opt) = @_;
|
||||
&h2z_sjis(*_) if $opt =~ /z/;
|
||||
&z2h_sjis(*_) if $opt =~ /h/;
|
||||
}
|
||||
sub euc2euc {
|
||||
local(*_, $opt) = @_;
|
||||
&h2z_euc(*_) if $opt =~ /z/;
|
||||
&z2h_euc(*_) if $opt =~ /h/;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Cache control functions
|
||||
;#
|
||||
sub cache {
|
||||
($cache, $cache = 1)[$[];
|
||||
}
|
||||
sub nocache {
|
||||
($cache, $cache = 0)[$[];
|
||||
}
|
||||
sub flushcache {
|
||||
undef %e2s;
|
||||
undef %s2e;
|
||||
}
|
||||
|
||||
;#
|
||||
;# X0201 -> X0208 KANA conversion routine
|
||||
;#
|
||||
sub h2z_jis {
|
||||
local(*_, $n) = @_;
|
||||
if (s/$re_kana([^\e]*)/$esc_jp . &_h2z_jis($1)/geo) {
|
||||
1 while s/($re_jp[^\e]*)$re_jp/$1/o;
|
||||
}
|
||||
$n;
|
||||
}
|
||||
sub _h2z_jis {
|
||||
local($_) = @_;
|
||||
$n += s/[\41-\137]([\136\137])?/$h2z{$&}/g;
|
||||
$_;
|
||||
}
|
||||
|
||||
sub h2z_euc {
|
||||
local(*_) = @_;
|
||||
s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
|
||||
}
|
||||
|
||||
sub h2z_sjis {
|
||||
local(*_, $n) = @_;
|
||||
s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
|
||||
$1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
;#
|
||||
;# X0208 -> X0201 KANA conversion routine
|
||||
;#
|
||||
sub z2h_jis {
|
||||
local(*_, $n) = @_;
|
||||
s/$re_jp([^\e]+)/&_z2h_jis($1)/geo;
|
||||
$n;
|
||||
}
|
||||
sub _z2h_jis {
|
||||
local($_) = @_;
|
||||
s/(\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+/&__z2h_jis($&)/ge;
|
||||
$_;
|
||||
}
|
||||
sub __z2h_jis {
|
||||
local($_) = @_;
|
||||
return $esc_jp . $_ unless /^%/ || /^![\#\"&VW+,<]/;
|
||||
$n += length($_) / 2;
|
||||
s/../$z2h{$&}/g;
|
||||
$esc_kana . $_;
|
||||
}
|
||||
|
||||
sub z2h_euc {
|
||||
local(*_, $n) = @_;
|
||||
&init_z2h_euc unless defined %z2h_euc;
|
||||
s/$re_euc_c|$re_euc_kana/$z2h_euc{$&} ? ($n++, $z2h_euc{$&}) : $&/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
sub z2h_sjis {
|
||||
local(*_, $n) = @_;
|
||||
&init_z2h_sjis unless defined %z2h_sjis;
|
||||
s/$re_sjis_c/$z2h_sjis{$&} ? ($n++, $z2h_sjis{$&}) : $&/geo;
|
||||
$n;
|
||||
}
|
||||
|
||||
;#
|
||||
;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
|
||||
;# can be done in &init but it's not worth doing. Similarly,
|
||||
;# precalculated table is not worth to occupy the file space and
|
||||
;# reduce the readability. The author personnaly discourages to use
|
||||
;# X0201 Kana character in the any situation.
|
||||
;#
|
||||
sub init_z2h_euc {
|
||||
local($k, $_);
|
||||
s/[\241-\337]/\216$&/g && ($z2h_euc{$k} = $_) while ($k, $_) = each %z2h;
|
||||
}
|
||||
sub init_z2h_sjis {
|
||||
local($_, $v);
|
||||
/[\200-\377]/ && ($z2h_sjis{&e2s($_)} = $v) while ($_, $v) = each %z2h;
|
||||
}
|
||||
|
||||
;#
|
||||
;# TR function for 2-byte code
|
||||
;#
|
||||
sub tr {
|
||||
local(*_, $from, $to, $opt) = @_;
|
||||
local(@from, @to, %table);
|
||||
local($jis, $n) = (0, 0);
|
||||
local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
|
||||
|
||||
&jis2euc(*_), $jis++ if $_ =~ /$re_jp/o;
|
||||
&jis2euc(*to), $jis++ if $to =~ /$re_jp/o;
|
||||
&jis2euc(*from) if $from =~ /$re_jp/o;
|
||||
|
||||
grep(s/([\200-\377])[\200-\377]-\1[\200-\377]/&_expnd2($&)/ge, $from, $to);
|
||||
grep(s/$ascii-$ascii/&_expnd1($&)/geo, $from, $to);
|
||||
|
||||
@to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
|
||||
@from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
|
||||
push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
|
||||
@table{@from} = @to;
|
||||
|
||||
s/[\200-\377][\000-\377]|[\000-\377]/
|
||||
defined($table{$&}) && ++$n ? $table{$&} : $&/ge;
|
||||
|
||||
&euc2jis(*_) if $jis;
|
||||
|
||||
$n;
|
||||
}
|
||||
|
||||
sub _expnd1 {
|
||||
local($_) = @_;
|
||||
s/\\(.)/$1/g;
|
||||
local($c1, $c2) = unpack('CxC', $_);
|
||||
if ($c1 <= $c2) {
|
||||
for ($_ = ''; $c1 <= $c2; $c1++) {
|
||||
$_ .= pack('C', $c1);
|
||||
}
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
sub _expnd2 {
|
||||
local($_) = @_;
|
||||
local($c1, $c2, $c3, $c4) = unpack('CCxCC', $_);
|
||||
if ($c1 == $c3 && $c2 <= $c4) {
|
||||
for ($_ = ''; $c2 <= $c4; $c2++) {
|
||||
$_ .= pack('CC', $c1, $c2);
|
||||
}
|
||||
}
|
||||
$_;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
206
[1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/list.cgi
Normal file
206
[1999-11-03 - 2000-05-02] REFLEX (aka AGStar no Yabou)/list.cgi
Normal file
|
|
@ -0,0 +1,206 @@
|
|||
#! /usr/local/bin/perl
|
||||
#
|
||||
#ゆいぽすと1.1(list.cgi)
|
||||
#
|
||||
|
||||
require './jcodeLE.pl';
|
||||
&init;&decode;
|
||||
if ($make ne 'on'){
|
||||
$page = 0 if ($page eq '');
|
||||
$page2 = $page*$lmax;
|
||||
|
||||
&html; exit;
|
||||
}else{
|
||||
&make
|
||||
; exit;
|
||||
}
|
||||
##################################################
|
||||
sub init{
|
||||
($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime(time);
|
||||
$min = "0$min" if ($min < 10); $month++;
|
||||
$youbi = ('日','月','火','水','木','金','土') [$wday];
|
||||
$date = "$month月$mday日（$youbi）$hour時$min分$sec秒";
|
||||
$today = "$month/$mday";
|
||||
$chat_file = './den/log.000.dat';
|
||||
$roommax = 300;#設置できる最大の私書箱数
|
||||
$cgidir = 'http://www.plumfield.ne.jp/~neu/reflex/yuipost/';#postというディレクトリ内にCGIを置く場合
|
||||
if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
|
||||
else { $buffer = $ENV{'QUERY_STRING'}; }
|
||||
}#init END
|
||||
##################################################
|
||||
sub html {
|
||||
print "Content-type: text/html\n\n";
|
||||
print <<"_HTML_";
|
||||
<HTML><HEAD><TITLE>あやしいわーるどREFLEX 新規掲示板作成</TITLE></HEAD>
|
||||
<BODY bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">
|
||||
|
||||
_HTML_
|
||||
|
||||
|
||||
|
||||
print <<"_HTML_";
|
||||
</ul>
|
||||
<FONT size=+1><B><A NAME="make">あやしいわーるどREFLEX 新規掲示板作成</A></B></FONT> <font size=-1><b><a href=\"bbs.cgi\">リスト一覧</a></font></b> <font size=-1><b><a href=\"bbs.cgi\?area\=read\">最新投稿一覧</a></b></font><BR><p>
|
||||
<FORM method="GET" ACTION="./list.cgi"><INPUT TYPE=hidden NAME="make" value="on">
|
||||
タイトル <INPUT TYPE=text NAME="title" SIZE="30"><BR>
|
||||
ID <INPUT TYPE=text NAME="id" SIZE="7">(半角英数字を必ず記入)<BR>
|
||||
パスワード <INPUT TYPE=text NAME="pass" SIZE="7">(半角英数字を必ず記入)<p>
|
||||
背景色 <INPUT TYPE=text NAME="bgcolor" SIZE="7" VALUE="004040"><BR>
|
||||
文字色 <INPUT TYPE=text NAME="mgcolor" SIZE="7" VALUE="ffffff"><BR>
|
||||
リンク色 <INPUT TYPE=text NAME="lkcolor" SIZE="7" VALUE="eeffee">
|
||||
<br>
|
||||
既読リンク色 <input type=text name="vlinkcolor" size=7 value="dddddd"><br>
|
||||
題名色 <input type=text name="sbcolor" size=7 value="ffffee"><br>
|
||||
背景画像 <input type=text name="backimage" size=30 value="http://">
|
||||
<p>
|
||||
<INPUT type=submit value="新規作成／設定変更"></FORM><hr><font size=-1>
|
||||
設定を変更するときには、IDとパスワードは前と同じものを使用してください。<br>
|
||||
</font><hr>
|
||||
|
||||
<H5 align=right><A HREF="http://www.cup.com/yui/index.html">ゆいぽすと(Free)</A></H5></BODY></HTML>
|
||||
_HTML_
|
||||
}#html END
|
||||
##################################################
|
||||
sub listing{
|
||||
|
||||
}#listing END
|
||||
|
||||
##################################################
|
||||
sub decode {
|
||||
@pairs = split(/&/,$buffer);
|
||||
foreach $pair (@pairs)
|
||||
{
|
||||
($name, $value) = split(/=/, $pair);
|
||||
$value =~ tr/+/ /;
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
&jcode'convert(*value,'sjis');
|
||||
$value =~ s/\n//g;$value =~ s/\r//g;$value =~ s/:#//g;
|
||||
$value =~ s/<//g;$value =~ s/>//g;
|
||||
$value =~ s/>//g;$value =~ s/\x00-\x1f//g;
|
||||
$value =~ s/$//g;$value =~ s/%//g;$value =~ s/|//g;
|
||||
$FORM{$name} = $value;
|
||||
}
|
||||
|
||||
$id=$FORM{'id'};
|
||||
$pass = $FORM{'pass'};
|
||||
$title = $FORM{'title'};
|
||||
$page = $FORM{'page'};
|
||||
$make = $FORM{'make'};
|
||||
$amode = $FORM{'amode'};
|
||||
$bmode = $FORM{'bmode'};
|
||||
$bgcolor = $FORM{'bgcolor'};
|
||||
$mgcolor = $FORM{'mgcolor'};
|
||||
$lkcolor = $FORM{'lkcolor'};
|
||||
$vlkcolor = $FORM{'lkcolor'};
|
||||
$subcolor = $FORM{'sbcolor'};
|
||||
$bimage = $FORM{'backimage'};
|
||||
|
||||
|
||||
|
||||
if($FORM{'chg'}){
|
||||
$hotlist = $FORM{'h'}; $rev = $FORM{'r'}; $lmax = $FORM{'lm'};
|
||||
}else{ &getcookie;}
|
||||
$option = $FORM{'op'};
|
||||
$lmax = '2' if($lmax eq '');
|
||||
$rev = 'on' if($rev eq '');$hotlist = '0' if($hotlist eq '');
|
||||
&setcookie;
|
||||
}#decode END
|
||||
##################################################
|
||||
sub make {#新規話題ルームを設置
|
||||
#タイトルチェック。
|
||||
#&err(3) if(length($title) < 3);
|
||||
#&err(4) unless(($ENV{'HTTP_REFERER'} eq '') || ($ENV{'HTTP_REFERER'}=~/$cgidir\/list.cgi/) );
|
||||
|
||||
$chat_file="./pref/bbb.dat";
|
||||
$chat_file =~ s/bbb/$id/g;
|
||||
|
||||
$data_file="./data/bbb.dat";
|
||||
$data_file =~ s/bbb/$id/g;
|
||||
|
||||
|
||||
open(DB, $chat_file);
|
||||
@lines = <DB>;
|
||||
close(DB);
|
||||
$set=shift(@lines);
|
||||
($idd,$passd,$dum) = split(/:#/,$set);
|
||||
if(($idd eq $id)&&($passd ne $pass)){&err(1);}
|
||||
|
||||
|
||||
$value = "$id:#$pass:#$title:#$amode:#$bmode:#$bgcolor:#$mgcolor:#$lkcolor:#$vlkcolor:#$subcolor:#$bimage:#\n";
|
||||
|
||||
|
||||
open(DB,">$chat_file");
|
||||
print DB $value; print DB @lines;
|
||||
close(DB);
|
||||
|
||||
|
||||
|
||||
if (!open(DB,"$data_file"))
|
||||
|
||||
{
|
||||
open(OUT,">$data_file");
|
||||
print OUT $none;
|
||||
close(OUT);
|
||||
}
|
||||
|
||||
close(DB);
|
||||
|
||||
|
||||
chmod 0600, "./pref/$id.dat";#0666でないとダメかも。
|
||||
chmod 0666, "./data/$id.dat";#0666でないとダメかも。
|
||||
|
||||
$buffer=~s/&title=/&name2=/;
|
||||
&locate;
|
||||
}#make END
|
||||
#################################################
|
||||
sub locate{ #移動します。
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print <<"_HTML_";
|
||||
<HTML><HEAD><TITLE>$title</TITLE>
|
||||
</HEAD><BODY bgcolor="#004040" text="#ffffff" link="#eeffee" vlink="#dddddd" alink="#ff0000">
|
||||
<H1>
|
||||
作成完了。</H1>
|
||||
<HR><BR>
|
||||
<a href="bbs.cgi?area=$id">
|
||||
こちらに移動します。</a><BR>何か投稿をするとリストに追加されます。<BR>
|
||||
<BR><BR><BR><BR><BR>
|
||||
<H5 ALIGN=right><A HREF="http://www.cup.com/yui/index.html">ゆいぽすと(Free)</A></H5></BODY></HTML>
|
||||
_HTML_
|
||||
exit;
|
||||
}#make END
|
||||
|
||||
#################################################
|
||||
|
||||
|
||||
sub getcookie{ #くっきーを頂きます。
|
||||
$cooks = $ENV{'HTTP_COOKIE'};
|
||||
$cooks = '' unless($cooks =~s/.*yuipost=(.*)yuipostend.*/$1/) ;
|
||||
($hotlist,$rev,$lmax) = split(/\t/, $cooks);
|
||||
}#getcookie END
|
||||
|
||||
sub setcookie{ #くっきーをブラウザにプレゼントします。
|
||||
$data = "$hotlist\t$rev\t$lmax\tyuipostend";
|
||||
print "Set-Cookie: yuipost=$data; expires=Wednesday, 09-Nov-1999 00:00:00 GMT\n" unless ($ENV{'HTTP_COOKIE'}=~/$data/);
|
||||
}#このクッキーは1999/11/9まで有効です。それを過ぎたら、日付をもっと先にして。
|
||||
sub err{
|
||||
$error = $_[0];
|
||||
print "Content-type: text/html\n\n";
|
||||
print <<"_HTML_";
|
||||
<HTML><HEAD><TITLE>$title</TITLE>
|
||||
</HEAD><BODY BGCOLOR="#A1FE9F" TEXT="#000000" LINK="#ff0000" VLINK="#ff0000" ALINK="#FF0000">
|
||||
<H1>
|
||||
タイプ $error のエラーが発生しました。</H1>
|
||||
<HR><BR>
|
||||
エラータイプの説明<BR><BR>
|
||||
タイプ0：ログファイルが開けません。<BR>
|
||||
タイプ1：私書箱設定の修正時に必要となるパスワードが間違っています。<BR>
|
||||
タイプ3：私書箱のタイトルが短いです。<BR>
|
||||
タイプ4：予期せぬエラーです。<BR>
|
||||
タイプ5：設置数が最大設定値$roommaxを越えるため、新規に設置ができません。<BR>
|
||||
<BR><BR><BR><BR><BR>
|
||||
<H5 ALIGN=right><A HREF="http://www.cup.com/yui/index.html">ゆいぽすと(Free)</A></H5></BODY></HTML>
|
||||
_HTML_
|
||||
exit;
|
||||
}
|
||||
__END__
|
||||
|
|
@ -0,0 +1 @@
|
|||
REFLEXのスクリプトです。まだ作成途中のα版のため暫定公開です。<br>
bbs.cgi、list.cgi、getlog_m.cgi、jcode.pl、loveyou.dat（空ファイル）は同じディレクトリに置きます。<br>
counters,data,pref,logのディレクトリを777で作ってください。<br>
prefとdataのディレクトリの中に、.htaccessを入れて下さい。<br>
そしてlist.cgiの実行が確認できたら、
リスト一覧と最新投稿一覧の設定をするために
list.cgiでIDの所を空欄とreadで背景などの設定をすれば完了です。<br>
|
||||
3
source.txt
Normal file
3
source.txt
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
https://web.archive.org/web/20011202000316/http://www.bea.hi-ho.ne.jp/strangeworld/
|
||||
|
||||
https://web.archive.org/web/20030202120105/http://www.bea.hi-ho.ne.jp/strangeworld/
|
||||
Loading…
Reference in a new issue