| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
### read.cgi ver 2.05 (2001/08/22) editted (2001/08/27) |
| 4 |
### onpuch original (2003/03/19) version (2004/05/15) |
| 5 |
# ----------------------------------------------------------- |
| 6 |
use strict; |
| 7 |
require 'jcode.pl'; |
| 8 |
use CGI::Carp qw/fatalsToBrowser/; |
| 9 |
|
| 10 |
use vars qw($hannyou); |
| 11 |
use vars qw($hyoujun); |
| 12 |
use vars qw($ver); |
| 13 |
use vars qw($gzip_path); |
| 14 |
use vars qw($gzip_enable); |
| 15 |
|
| 16 |
$hyoujun = "http://suika.fam.cx".$ENV{'REQUEST_URI'}; |
| 17 |
$hyoujun =~ s/\/test\/.*/\/test\//g; |
| 18 |
# ���̂܂܂̐ݒ�œ��삵�Ȃ��ꍇ�́A����#������Đ��m�ȃx�[�XURL�������B��Fhttp://pc.2ch.net/test/ |
| 19 |
#$hyoujun = 'http://onpumoe.hp.infoseek.co.jp/cgi-bin/test/'; |
| 20 |
|
| 21 |
$ver='read.cgi ver4.20 by <a href="http://onpumoe.hp.infoseek.co.jp/script/">GlobalNoteScript</a> (2004/09/05)'; |
| 22 |
$gzip_path = "/bin/gzip"; |
| 23 |
$gzip_enable = 1; |
| 24 |
|
| 25 |
|
| 26 |
#================================================== |
| 27 |
#�@�������̎擾�iPOST�j |
| 28 |
#================================================== |
| 29 |
|
| 30 |
{ |
| 31 |
use vars qw(%FORM); |
| 32 |
my ($buffer, @pairs, $name, $value, $path_info, $res, $ls); |
| 33 |
$path_info = $ENV{'PATH_INFO'}; |
| 34 |
# if ($ENV{'REQUEST_METHOD'} eq "GET") { |
| 35 |
if ($ENV{'PATH_INFO'} eq "") { |
| 36 |
$buffer = $ENV{'QUERY_STRING'}; |
| 37 |
@pairs = split(/&/,$buffer); |
| 38 |
foreach (@pairs) { |
| 39 |
($name, $value) = split /=/; |
| 40 |
$value =~ tr/+/ /; |
| 41 |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg; |
| 42 |
$FORM{$name} = $value; |
| 43 |
} |
| 44 |
} else { |
| 45 |
($FORM{dummy},$FORM{bbs},$FORM{key},$res,$ls) = split /\//, $path_info; |
| 46 |
|
| 47 |
if ($res =~ /-/) { |
| 48 |
($FORM{st}, $FORM{to}) = split /-/, $res; |
| 49 |
} else { |
| 50 |
$FORM{st} = $res; |
| 51 |
$FORM{to} = $res; |
| 52 |
} |
| 53 |
if ($res =~ /n/) { |
| 54 |
$FORM{nofirst} = "true"; |
| 55 |
$FORM{st} =~ s/n//g; |
| 56 |
$FORM{to} =~ s/n//g; |
| 57 |
} else { |
| 58 |
$FORM{nofirst} = "false"; |
| 59 |
} |
| 60 |
|
| 61 |
if ($res =~ /l/) { |
| 62 |
$ls = $FORM{to}; |
| 63 |
$ls =~ s/l//g; |
| 64 |
$ls =~ s/n//g; |
| 65 |
$ls =~ s/i//g; |
| 66 |
$FORM{ls} = $ls; |
| 67 |
$FORM{st} = ""; |
| 68 |
$FORM{to} = ""; |
| 69 |
} |
| 70 |
|
| 71 |
# if ($res =~ /i/) { |
| 72 |
if (($ENV{'HTTP_USER_AGENT'} =~ /DoCoMo\//) && ($res =~ /i/)) { |
| 73 |
$FORM{imode} = "true"; |
| 74 |
$FORM{nofirst} = "true"; |
| 75 |
} |
| 76 |
|
| 77 |
$FORM{to} =~ s/i//g; |
| 78 |
$FORM{to} =~ s/n//g; |
| 79 |
|
| 80 |
} |
| 81 |
} |
| 82 |
|
| 83 |
|
| 84 |
#================================================== |
| 85 |
#�@�G���[���X�|���X�iBBS���j |
| 86 |
#================================================== |
| 87 |
|
| 88 |
{ |
| 89 |
if(!-e "../$FORM{'bbs'}/dat/$FORM{'key'}.dat" || $FORM{'bbs'} =~ /(\.|\/)/){ |
| 90 |
DispError("����Ȕ�or�X���b�h�Ȃ��ł��B"); |
| 91 |
} |
| 92 |
if(-s "../$FORM{'bbs'}/dat/$FORM{'key'}.dat" > 550000) { |
| 93 |
DispError("���̃X���b�h�傫�����܂��B"); |
| 94 |
} |
| 95 |
} |
| 96 |
|
| 97 |
|
| 98 |
#================================================== |
| 99 |
#�@�������̎擾�i�ݒ�t�@�C���j |
| 100 |
#================================================== |
| 101 |
|
| 102 |
{ |
| 103 |
use vars qw(%SETTING); |
| 104 |
|
| 105 |
# �ݒ�t�@�C����ǂ� |
| 106 |
my ($m_pass,$m_key,$m_value); |
| 107 |
$m_pass = "../$FORM{'bbs'}/SETTING.TXT"; |
| 108 |
if(-e $m_pass){ |
| 109 |
open(FILE,$m_pass); |
| 110 |
foreach (<FILE>){ |
| 111 |
chop; |
| 112 |
($m_key,$m_value) = split /=/; |
| 113 |
$SETTING{$m_key} = $m_value; |
| 114 |
} |
| 115 |
close(FILE); |
| 116 |
}else{ |
| 117 |
# �ݒ�t�@�C�����Ȃ��iERROR) |
| 118 |
DispError("���[�U�[�ݒ肪�������Ă��܂��I"); |
| 119 |
} |
| 120 |
|
| 121 |
# �������̕⊮ |
| 122 |
unless($SETTING{"BBS_THREAD_COLOR"}) {$SETTING{"BBS_THREAD_COLOR"}="#EFEFEF";} |
| 123 |
unless($SETTING{"BBS_SUBJECT_COLOR"}) {$SETTING{"BBS_SUBJECT_COLOR"}="#FF0000";} |
| 124 |
unless($SETTING{"BBS_NAME_COLOR"}) {$SETTING{"BBS_NAME_COLOR"}="forestgreen";} |
| 125 |
unless($SETTING{"BBS_TEXT_COLOR"}) {$SETTING{"BBS_TEXT_COLOR"}="#000000";} |
| 126 |
unless($SETTING{"BBS_LINK_COLOR"}) {$SETTING{"BBS_LINK_COLOR"}="#0000FF";} |
| 127 |
unless($SETTING{"BBS_ALINK_COLOR"}) {$SETTING{"BBS_ALINK_COLOR"}="#FF0000";} |
| 128 |
unless($SETTING{"BBS_VLINK_COLOR"}) {$SETTING{"BBS_VLINK_COLOR"}="#660099";} |
| 129 |
|
| 130 |
$SETTING{"BBS_BG_COLOR"}=$SETTING{'BBS_THREAD_COLOR'}; |
| 131 |
|
| 132 |
$gzip_path = $SETTING{"BBS_GZIP_PATH"}; |
| 133 |
if ($SETTING{"BBS_GZIP_CHECK"} eq "checked") { |
| 134 |
$gzip_enable = 1; |
| 135 |
} else { |
| 136 |
$gzip_enable = 0; |
| 137 |
} |
| 138 |
} |
| 139 |
|
| 140 |
|
| 141 |
#================================================== |
| 142 |
#�@�ϐ��̐ݒ� |
| 143 |
#================================================== |
| 144 |
|
| 145 |
{ |
| 146 |
use vars qw($start); |
| 147 |
use vars qw($end); |
| 148 |
use vars qw($NOW); |
| 149 |
use vars qw(@LOG); |
| 150 |
$NOW=time; |
| 151 |
open(ALL,"../$FORM{'bbs'}/dat/$FORM{'key'}.dat"); |
| 152 |
@LOG=<ALL>; |
| 153 |
close(ALL); |
| 154 |
my $LINENUM = @LOG; |
| 155 |
|
| 156 |
if ($FORM{'st'}) { |
| 157 |
$start = $FORM{'st'}; |
| 158 |
} elsif ($FORM{'ls'}) { |
| 159 |
$start = $LINENUM - $FORM{'ls'} + 1; |
| 160 |
} else { |
| 161 |
$start=1; |
| 162 |
} |
| 163 |
if ($start < 1) {$start = 1;} |
| 164 |
|
| 165 |
if ($FORM{'to'}) { |
| 166 |
$end = $FORM{'to'} + 1; |
| 167 |
} else { |
| 168 |
$end = $LINENUM + 1; |
| 169 |
} |
| 170 |
if ($end - $start < 1) {$end = $start + 1;} |
| 171 |
|
| 172 |
my $st1 = $start - 100; if ($st1 <= 0) {$st1 = 1;} |
| 173 |
my $st2 = $start - 1; |
| 174 |
my $st3 = $end; |
| 175 |
my $st4 = $end + 99; if ($st4 > $LINENUM) {$st4 = $LINENUM;} |
| 176 |
my $st5 = $LINENUM; |
| 177 |
my $res1 = $st2 - $st1 + 1; |
| 178 |
my $res2 = $st4 - $st3 + 1; |
| 179 |
|
| 180 |
my $subject=(split /<>/,$LOG[0])[4]; |
| 181 |
|
| 182 |
my ($name,$mail,$time,$message,$mailto); |
| 183 |
|
| 184 |
if(!$FORM{'imode'}){ |
| 185 |
print "Content-type: text/html; charset=shift_jis\n"; |
| 186 |
|
| 187 |
if ( $gzip_enable ){ |
| 188 |
if ( $ENV{'HTTP_ACCEPT_ENCODING'} =~ /x-gzip/ ){ |
| 189 |
print "Content-encoding: x-gzip\n\n"; |
| 190 |
} |
| 191 |
elsif ( $ENV{'HTTP_ACCEPT_ENCODING'} =~ /gzip/ ){ |
| 192 |
print "Content-encoding: gzip\n\n"; |
| 193 |
} else { |
| 194 |
print "\n"; |
| 195 |
$gzip_enable = 0; |
| 196 |
} |
| 197 |
} |
| 198 |
else { |
| 199 |
print "\n"; |
| 200 |
} |
| 201 |
open(STDOUT,"| $gzip_path -1 -c") if $gzip_enable; |
| 202 |
|
| 203 |
print <<EOF; |
| 204 |
<HTML> |
| 205 |
<HEAD> |
| 206 |
<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"> |
| 207 |
<TITLE> |
| 208 |
$subject |
| 209 |
</TITLE> |
| 210 |
<SCRIPT LANGUAGE="JavaScript" type="text/javascript"> |
| 211 |
<!-- |
| 212 |
Name = getCookie("NAME"); |
| 213 |
Mail = getCookie("MAIL"); |
| 214 |
function getCookie(key,tmp1,tmp2,xx1,xx2,xx3) { |
| 215 |
tmp1 = " " + document.cookie + ";"; |
| 216 |
xx1 = xx2 = 0; |
| 217 |
len = tmp1.length; |
| 218 |
while (xx1 < len) { |
| 219 |
xx2 = tmp1.indexOf(";", xx1); |
| 220 |
tmp2 = tmp1.substring(xx1 + 1, xx2); |
| 221 |
xx3 = tmp2.indexOf("="); |
| 222 |
if (tmp2.substring(0, xx3) == key) { |
| 223 |
return(unescape(tmp2.substring(xx3 + 1, xx2 - xx1 - 1))); |
| 224 |
} |
| 225 |
xx1 = xx2 + 1; |
| 226 |
} |
| 227 |
return(""); |
| 228 |
} |
| 229 |
// --> |
| 230 |
</SCRIPT> |
| 231 |
<BASE HREF="$hyoujun"> |
| 232 |
</HEAD> |
| 233 |
<BODY TEXT="$SETTING{'BBS_TEXT_COLOR'}" BGCOLOR="$SETTING{'BBS_BG_COLOR'}" link="$SETTING{'BBS_LINK_COLOR'}" alink="$SETTING{'BBS_ALINK_COLOR'}" vlink="$SETTING{'BBS_VLINK_COLOR'}"> |
| 234 |
<a href="../$FORM{'bbs'}/index.html">���f���ɖ߂遡</a> |
| 235 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/">�S��</a> |
| 236 |
EOF |
| 237 |
|
| 238 |
my $hundred = int ($LINENUM / 100); |
| 239 |
for (my $i = 0; $i <= $hundred; $i++) { |
| 240 |
my $hndst = $i * 100 + 1; |
| 241 |
my $hndto = $i * 100 + 100; |
| 242 |
if ($hndst == $LINENUM) { |
| 243 |
print <<EOF; |
| 244 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$hndst">$hndst</a> |
| 245 |
EOF |
| 246 |
} elsif ($hndto > $LINENUM) { |
| 247 |
$hndto = $LINENUM; |
| 248 |
print <<EOF; |
| 249 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$hndst-$hndto">$hndst-$hndto</a> |
| 250 |
EOF |
| 251 |
} else { |
| 252 |
print <<EOF; |
| 253 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$hndst-$hndto">$hndst-</a> |
| 254 |
EOF |
| 255 |
} |
| 256 |
} |
| 257 |
|
| 258 |
if ($st2 > 0) { |
| 259 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st1-$st2" . "n" ; |
| 260 |
print <<EOF; |
| 261 |
<a href=$hannyou>�O$res1</a> |
| 262 |
EOF |
| 263 |
} |
| 264 |
if ($st3 - $LINENUM < 1) { |
| 265 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st3-$st4" . "n" ; |
| 266 |
print <<EOF; |
| 267 |
<a href=$hannyou>��$res2</a> |
| 268 |
EOF |
| 269 |
} else { |
| 270 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st5" . "n-" ; |
| 271 |
print <<EOF; |
| 272 |
<a href=$hannyou>�V�����X</a> |
| 273 |
EOF |
| 274 |
} |
| 275 |
|
| 276 |
print <<EOF; |
| 277 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/l50">�ŐV50</a> |
| 278 |
EOF |
| 279 |
|
| 280 |
my $size = int ((-s "../$FORM{'bbs'}/dat/$FORM{'key'}.dat") / 1024); |
| 281 |
|
| 282 |
if ($LINENUM >= $SETTING{'BBS_MAX_RES_COUNT'}){ |
| 283 |
my $maxres = $SETTING{'BBS_MAX_RES_COUNT'}; |
| 284 |
print <<EOF; |
| 285 |
<P><TABLE><TR><TD BGCOLOR=RED> |
| 286 |
<FONT COLOR=WHITE><BR>���X���� $maxres ���Ă��܂��B�c�O�Ȃ��炱�̃X���b�h�ɂ͏������߂܂���B<BR><BR></FONT> |
| 287 |
</TD></TR></TABLE> |
| 288 |
EOF |
| 289 |
}elsif (($LINENUM >= ($SETTING{'BBS_MAX_RES_COUNT'} - 50)) && ($SETTING{'BBS_MAX_RES_COUNT'} >= 50)){ |
| 290 |
my $maxres = $SETTING{'BBS_MAX_RES_COUNT'}; |
| 291 |
my $rescount = $maxres - 50; |
| 292 |
print <<EOF; |
| 293 |
<P><TABLE><TR><TD BGCOLOR=RED> |
| 294 |
<FONT COLOR=WHITE>���X���� $rescount ���Ă��܂��B$maxres����Ə������߂Ȃ��Ȃ��B</FONT> |
| 295 |
</TD></TR></TABLE> |
| 296 |
EOF |
| 297 |
}elsif (($LINENUM >= ($SETTING{'BBS_MAX_RES_COUNT'} - 100)) && ($SETTING{'BBS_MAX_RES_COUNT'} >= 100)){ |
| 298 |
my $maxres = $SETTING{'BBS_MAX_RES_COUNT'}; |
| 299 |
my $rescount = $maxres - 100; |
| 300 |
print <<EOF; |
| 301 |
<P><TABLE><TR><TD BGCOLOR=YELLOW> |
| 302 |
���X���� $rescount ���Ă��܂��B$maxres����Ə������߂Ȃ��Ȃ��B |
| 303 |
</TD></TR></TABLE> |
| 304 |
EOF |
| 305 |
}elsif ($size >= $SETTING{'BBS_MAX_RES_SIZE'}) { |
| 306 |
my $maxkb = $SETTING{'BBS_MAX_RES_SIZE'} . "KB"; |
| 307 |
print <<EOF; |
| 308 |
<P><TABLE><TR><TD BGCOLOR=RED> |
| 309 |
<FONT COLOR=WHITE><BR>�X���b�h�̑傫���� $maxkb ���Ă��܂��B�c�O�Ȃ��炱�̃X���b�h�ɂ͏������߂܂���B<BR><BR></FONT> |
| 310 |
</TD></TR></TABLE> |
| 311 |
EOF |
| 312 |
}elsif (($size >= ($SETTING{'BBS_MAX_RES_SIZE'} - 20)) && ($SETTING{'BBS_MAX_RES_SIZE'} >= 20)) { |
| 313 |
my $maxkb = $SETTING{'BBS_MAX_RES_SIZE'} . "KB"; |
| 314 |
my $maxsize = $SETTING{'BBS_MAX_RES_SIZE'} - 20; |
| 315 |
my $sizekb = $maxsize . "KB"; |
| 316 |
print <<EOF; |
| 317 |
<P><TABLE><TR><TD BGCOLOR=RED> |
| 318 |
<FONT COLOR=WHITE>�X���b�h�̑傫���� $sizekb ���Ă��܂��B$maxkb����Ə������߂Ȃ��Ȃ��B</FONT> |
| 319 |
</TD></TR></TABLE> |
| 320 |
EOF |
| 321 |
}elsif (($size >= ($SETTING{'BBS_MAX_RES_SIZE'} - 50)) && ($SETTING{'BBS_MAX_RES_SIZE'} >= 50)) { |
| 322 |
my $maxkb = $SETTING{'BBS_MAX_RES_SIZE'} . "KB"; |
| 323 |
my $maxsize = $SETTING{'BBS_MAX_RES_SIZE'} - 50; |
| 324 |
my $sizekb = $maxsize . "KB"; |
| 325 |
print <<EOF; |
| 326 |
<P><TABLE><TR><TD BGCOLOR=YELLOW> |
| 327 |
�X���b�h�̑傫���� $sizekb ���Ă��܂��B$maxkb����Ə������߂Ȃ��Ȃ��B |
| 328 |
</TD></TR></TABLE> |
| 329 |
EOF |
| 330 |
} |
| 331 |
|
| 332 |
print <<EOF; |
| 333 |
<P><FONT SIZE=+1 COLOR="$SETTING{'BBS_SUBJECT_COLOR'}"> |
| 334 |
$subject |
| 335 |
</FONT></B><BR> |
| 336 |
<DL> |
| 337 |
EOF |
| 338 |
|
| 339 |
if($FORM{'nofirst'} ne "true" || $FORM{'st'} eq 1){ |
| 340 |
chop($LOG[0]); |
| 341 |
($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[0]); |
| 342 |
#�{������̏ꍇ |
| 343 |
if ($message eq "") { |
| 344 |
$name=""; |
| 345 |
$mail=""; |
| 346 |
$time="[�������Ă܂�]"; |
| 347 |
$message="[�������Ă܂�]"; |
| 348 |
} |
| 349 |
my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 350 |
$message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<a href=\"$2\:$3\" target=\"_blank\">$2\:$3<\/a>/igo; |
| 351 |
|
| 352 |
# ������sjis��1�o�C�g�ڂ����������� |
| 353 |
my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 354 |
my $check2 = '[\201-\237\340-\374]'; |
| 355 |
$mail =~ s/($check1)$check2$/$1/g; |
| 356 |
$name =~ s/($check1)$check2$/$1/g; |
| 357 |
|
| 358 |
if($mail){ |
| 359 |
$mailto = "<a href=\"mailto:$mail\"><b>$name</B></a>"; |
| 360 |
}else{ |
| 361 |
$mailto = "<font color=\"$SETTING{'BBS_NAME_COLOR'}\"><b>$name</b></font>"; |
| 362 |
} |
| 363 |
print "<dt>1 ���O�F$mailto ���e���F$time<dd>$message<br><br>\n"; |
| 364 |
if($start eq 1){$start++;} |
| 365 |
} |
| 366 |
|
| 367 |
while($start != $end){ |
| 368 |
unless($LOG[$start-1]){last;} |
| 369 |
chop($LOG[$start-1]); |
| 370 |
($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[$start-1]); |
| 371 |
#�{������̏ꍇ |
| 372 |
if ($message eq "") { |
| 373 |
$name=""; |
| 374 |
$mail=""; |
| 375 |
$time="[�������Ă܂�]"; |
| 376 |
$message="[�������Ă܂�]"; |
| 377 |
} |
| 378 |
my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 379 |
$message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<a href=\"$2\:$3\" target=\"_blank\">$2\:$3<\/a>/igo; |
| 380 |
|
| 381 |
# ������sjis��1�o�C�g�ڂ����������� |
| 382 |
my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 383 |
my $check2 = '[\201-\237\340-\374]'; |
| 384 |
$mail =~ s/($check1)$check2$/$1/g; |
| 385 |
$name =~ s/($check1)$check2$/$1/g; |
| 386 |
|
| 387 |
if($mail){ |
| 388 |
$mailto = "<a href=\"mailto:$mail\"><b>$name</B></a>"; |
| 389 |
}else{ |
| 390 |
$mailto = "<font color=\"$SETTING{'BBS_NAME_COLOR'}\"><b>$name</b></font>"; |
| 391 |
} |
| 392 |
print "<dt>$start ���O�F$mailto ���e���F$time<dd>$message<br><br>\n"; |
| 393 |
$start++; |
| 394 |
} |
| 395 |
|
| 396 |
my $newres = $LINENUM + 1; |
| 397 |
print <<EOF; |
| 398 |
</DL><font color=red><b>$size KB</b></font> |
| 399 |
<hr> |
| 400 |
<a href="../$FORM{'bbs'}/index.html">�f���ɖ߂�</a> |
| 401 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/">�S��</a> |
| 402 |
EOF |
| 403 |
for (my $i = 0; $i <= $hundred; $i++) { |
| 404 |
my $hndst = $i * 100 + 1; |
| 405 |
my $hndto = $i * 100 + 100; |
| 406 |
if ($hndst == $LINENUM) { |
| 407 |
print <<EOF; |
| 408 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$hndst">$hndst</a> |
| 409 |
EOF |
| 410 |
} elsif ($hndto > $LINENUM) { |
| 411 |
$hndto = $LINENUM; |
| 412 |
print <<EOF; |
| 413 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$hndst-$hndto">$hndst-$hndto</a> |
| 414 |
EOF |
| 415 |
} else { |
| 416 |
print <<EOF; |
| 417 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$hndst-$hndto">$hndst-</a> |
| 418 |
EOF |
| 419 |
} |
| 420 |
} |
| 421 |
|
| 422 |
if ($st2 > 0) { |
| 423 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st1-$st2" . "n" ; |
| 424 |
print <<EOF; |
| 425 |
<a href=$hannyou>�O$res1</a> |
| 426 |
EOF |
| 427 |
} |
| 428 |
if ($st3 - $LINENUM < 1) { |
| 429 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st3-$st4" . "n" ; |
| 430 |
print <<EOF; |
| 431 |
<a href=$hannyou>��$res2</a> |
| 432 |
EOF |
| 433 |
} else { |
| 434 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st5" . "n-" ; |
| 435 |
print <<EOF; |
| 436 |
<a href=$hannyou>�V�����X</a> |
| 437 |
EOF |
| 438 |
} |
| 439 |
|
| 440 |
print <<EOF; |
| 441 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/l50">�ŐV50</a><hr> |
| 442 |
EOF |
| 443 |
|
| 444 |
if (($LINENUM < $SETTING{'BBS_MAX_RES_COUNT'}) && ($size < $SETTING{'BBS_MAX_RES_SIZE'})){ |
| 445 |
print <<EOF; |
| 446 |
<table border=0 cellspacing=0 cellpadding=10 vspace=0 hspace=0><tr align="center" valign="top"><td align=left> |
| 447 |
<form method=POST action="./bbs.cgi"> |
| 448 |
<table border=0 cellspacing=0 cellpadding=0><tr><td align=right> |
| 449 |
<input type=submit value="��������" name="submit"> |
| 450 |
</td><td> ���O�F |
| 451 |
<SCRIPT Language="JavaScript"> |
| 452 |
<!-- |
| 453 |
document.write("<INPUT TYPE=text NAME=FROM SIZE=19 VALUE="); |
| 454 |
document.write(Name,">"); |
| 455 |
// --> |
| 456 |
</SCRIPT><NOSCRIPT> |
| 457 |
<INPUT TYPE=text NAME=FROM SIZE=19> |
| 458 |
</NOSCRIPT> |
| 459 |
E-mail<font size=1>�i�ȗ��j</font>�F |
| 460 |
<SCRIPT Language="JavaScript"> |
| 461 |
<!-- |
| 462 |
document.write("<INPUT TYPE=text NAME=mail SIZE=19 VALUE="); |
| 463 |
document.write(Mail,">"); |
| 464 |
// --> |
| 465 |
</SCRIPT><NOSCRIPT> |
| 466 |
<INPUT TYPE=text NAME=mail SIZE=19> |
| 467 |
</NOSCRIPT> |
| 468 |
</td></tr></table> |
| 469 |
<textarea rows=5 cols=70 wrap=OFF name=MESSAGE></textarea> |
| 470 |
<input type=hidden name=bbs value=$FORM{'bbs'}> |
| 471 |
<input type=hidden name=key value=$FORM{'key'}> |
| 472 |
<input type=hidden name=time value=$NOW> |
| 473 |
</form></td></tr></table> |
| 474 |
EOF |
| 475 |
} |
| 476 |
|
| 477 |
print <<EOF; |
| 478 |
$ver</BODY></HTML> |
| 479 |
EOF |
| 480 |
close(STDOUT) if $gzip_enable; |
| 481 |
}else{ |
| 482 |
#================================================== |
| 483 |
#�@i-mode�p |
| 484 |
#================================================== |
| 485 |
if ($FORM{'st'} eq '' && $FORM{'to'} eq '' && $FORM{'ls'} eq '') { |
| 486 |
$start = $LINENUM - 4; if ($start < 1) {$start = 1;} |
| 487 |
$end = $LINENUM + 1; |
| 488 |
} |
| 489 |
|
| 490 |
if ($end - $start > 5) {$end = $start + 5;} |
| 491 |
if ($LINENUM => $start && $end - $LINENUM > 1) {$end = $LINENUM + 1;} |
| 492 |
|
| 493 |
my $st1 = $start - 5; if ($st1 <= 0) {$st1 = 1;} |
| 494 |
my $st2 = $start - 1; |
| 495 |
my $st3 = $end; |
| 496 |
my $st4 = $end + 4; if ($st4 > $LINENUM) {$st4 = $LINENUM;} |
| 497 |
my $st5 = $LINENUM; |
| 498 |
my $res1 = $st2 - $st1 + 1; |
| 499 |
my $res2 = $st4 - $st3 + 1; |
| 500 |
|
| 501 |
# �S�p�J�i�Ɣ��p�J�i�̕ϊ� |
| 502 |
&jcode::z2h_sjis(\$subject); |
| 503 |
foreach (@LOG) { |
| 504 |
&jcode::z2h_sjis(\$_); |
| 505 |
} |
| 506 |
|
| 507 |
print "Content-type: text/html; charset=shift_jis\n\n"; |
| 508 |
print <<EOF; |
| 509 |
<HTML> |
| 510 |
<HEAD> |
| 511 |
<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"> |
| 512 |
<TITLE> |
| 513 |
$subject |
| 514 |
</TITLE> |
| 515 |
<BASE HREF="$hyoujun"> |
| 516 |
</HEAD> |
| 517 |
<BODY TEXT="$SETTING{"BBS_TEXT_COLOR"}" BGCOLOR="$SETTING{"BBS_BG_COLOR"}" link="$SETTING{"BBS_LINK_COLOR"}" alink="$SETTING{"BBS_ALINK_COLOR"}" vlink="$SETTING{"BBS_VLINK_COLOR"}"> |
| 518 |
<a href="../$FORM{'bbs'}/i/index.html">�f���ɖ߂�</a> |
| 519 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/1-5i">�ŏ�-</a> |
| 520 |
EOF |
| 521 |
if ($st2 > 0) { |
| 522 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st1-$st2" . "ni"; |
| 523 |
print <<EOF; |
| 524 |
<a href=$hannyou>�O$res1</a> |
| 525 |
EOF |
| 526 |
} |
| 527 |
if ($st3 - $LINENUM < 1) { |
| 528 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st3-$st4" . "ni"; |
| 529 |
print <<EOF; |
| 530 |
<a href=$hannyou>��$res2</a> |
| 531 |
EOF |
| 532 |
} else { |
| 533 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st5" . "-ni"; |
| 534 |
print <<EOF; |
| 535 |
<a href=$hannyou>�V��</a> |
| 536 |
EOF |
| 537 |
} |
| 538 |
print <<EOF; |
| 539 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/l5i">�ŐV5</a> |
| 540 |
<P><FONT SIZE=+1 COLOR="$SETTING{'BBS_SUBJECT_COLOR'}"> |
| 541 |
$subject |
| 542 |
</FONT></B><BR> |
| 543 |
EOF |
| 544 |
|
| 545 |
if($FORM{'nofirst'} ne "true" || $FORM{'st'} eq 1){ |
| 546 |
chop($LOG[0]); |
| 547 |
($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[0]); |
| 548 |
#�{������̏ꍇ |
| 549 |
if ($message eq "") { |
| 550 |
$name=""; |
| 551 |
$mail=""; |
| 552 |
$time="[�������Ă܂�]"; |
| 553 |
$message="[�������Ă܂�]"; |
| 554 |
} |
| 555 |
# URL��ϊ��ionpuch.jp�ȊO��URL�̓����N�����j |
| 556 |
my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 557 |
$message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<r>$2\:$3<\/r>/igo; |
| 558 |
$message =~ s/<r>(http\:\/\/www\.onpuch\.jp[\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)<\/r>/<a href=\"$1\" target=\"_blank\">$1<\/a>/igo; |
| 559 |
$message =~ s/<r>(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)<\/r>/(URL)/igo; |
| 560 |
$message =~ s/(<a href="(?:\.\.|http\:\/\/www\.onpuch\.jp\/cgi-bin\/onpuch)\/test\/read\.cgi\?bbs=\w+&key=\d+(?:&st=\d+)*(?:&to=\d+)*(?:&nofirst=true)*)/$1&imode=true/g; |
| 561 |
$message =~ s/<\/?r>//g; |
| 562 |
|
| 563 |
# ������sjis��1�o�C�g�ڂ����������� |
| 564 |
my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 565 |
my $check2 = '[\201-\237\340-\374]'; |
| 566 |
$mail =~ s/($check1)$check2$/$1/g; |
| 567 |
$name =~ s/($check1)$check2$/$1/g; |
| 568 |
|
| 569 |
if($mail && $mail ne "sage"){ |
| 570 |
$mailto = "<b><a href=\"mailto:$mail\">$name</a></b>"; |
| 571 |
}else{ |
| 572 |
$mailto = "<b>$name</b>"; |
| 573 |
} |
| 574 |
print "<p>[1:$mailto($time)]<br>$message</p><hr>\n"; |
| 575 |
if($start eq 1){$start++;} |
| 576 |
} |
| 577 |
|
| 578 |
while($start != $end){ |
| 579 |
unless($LOG[$start-1]){last;} |
| 580 |
chop($LOG[$start-1]); |
| 581 |
($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[$start-1]); |
| 582 |
#�{������̏ꍇ |
| 583 |
if ($message eq "") { |
| 584 |
$name=""; |
| 585 |
$mail=""; |
| 586 |
$time="[�������Ă܂�]"; |
| 587 |
$message="[�������Ă܂�]"; |
| 588 |
} |
| 589 |
# URL��ϊ��ionpuch.jp�ȊO��URL�̓����N�����j |
| 590 |
my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 591 |
$message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<r>$2\:$3<\/r>/igo; |
| 592 |
$message =~ s/<r>(http\:\/\/www\.onpuch\.jp[\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)<\/r>/<a href=\"$1\" target=\"_blank\">$1<\/a>/igo; |
| 593 |
$message =~ s/<r>(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)<\/r>/(URL)/igo; |
| 594 |
$message =~ s/(<a href="(?:\.\.|http\:\/\/www\.onpuch\.jp\/cgi-bin\/onpuch)\/test\/read\.cgi\?bbs=\w+&key=\d+(?:&st=\d+)*(?:&to=\d+)*(?:&nofirst=true)*)/$1&imode=true/g; |
| 595 |
$message =~ s/<\/?r>//g; |
| 596 |
|
| 597 |
# ������sjis��1�o�C�g�ڂ����������� |
| 598 |
my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*'; |
| 599 |
my $check2 = '[\201-\237\340-\374]'; |
| 600 |
$mail =~ s/($check1)$check2$/$1/g; |
| 601 |
$name =~ s/($check1)$check2$/$1/g; |
| 602 |
|
| 603 |
if($mail && $mail ne "sage"){ |
| 604 |
$mailto = "<b><a href=\"mailto:$mail\">$name</a></b>"; |
| 605 |
}else{ |
| 606 |
$mailto = "<b>$name</b>"; |
| 607 |
} |
| 608 |
print "<p>[$start:$mailto($time)]<br>$message</p><hr>\n"; |
| 609 |
$start++; |
| 610 |
} |
| 611 |
|
| 612 |
#my $FL=1; |
| 613 |
#if($FORM{'ls'} || $end > 1001 || $end > @LOG-1){$FL=0} |
| 614 |
#if($FL){ |
| 615 |
|
| 616 |
print <<EOF; |
| 617 |
<a href="../$FORM{'bbs'}/i/index.html">�f���ɖ߂�</a> |
| 618 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/1-5i">�ŏ�-</a> |
| 619 |
EOF |
| 620 |
if ($st2 > 0) { |
| 621 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st1-$st2" . "ni"; |
| 622 |
print <<EOF; |
| 623 |
<a href=$hannyou>�O$res1</a> |
| 624 |
EOF |
| 625 |
} |
| 626 |
if ($st3 - $LINENUM < 1) { |
| 627 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st3-$st4" . "ni"; |
| 628 |
print <<EOF; |
| 629 |
<a href=$hannyou>��$res2</a> |
| 630 |
EOF |
| 631 |
} else { |
| 632 |
$hannyou = "./read.cgi/$FORM{'bbs'}/$FORM{'key'}/$st5" . "-ni"; |
| 633 |
print <<EOF; |
| 634 |
<a href=$hannyou>�V��</a> |
| 635 |
EOF |
| 636 |
} |
| 637 |
print <<EOF; |
| 638 |
<a href="./read.cgi/$FORM{'bbs'}/$FORM{'key'}/l5i">�ŐV5</a><BR> |
| 639 |
EOF |
| 640 |
#} |
| 641 |
print "<FORM METHOD=POST ACTION=\"./bbs.cgi\">\n"; |
| 642 |
print "<INPUT TYPE=submit VALUE=\"��������\" name=\"submit\"> "; |
| 643 |
print "NAME�F<INPUT TYPE=text NAME=FROM SIZE=20 VALUE=\"\">"; |
| 644 |
print "MAIL�F<INPUT TYPE=text NAME=mail SIZE=20 VALUE=\"\">"; |
| 645 |
print "<br>"; |
| 646 |
print "<INPUT TYPE=hidden name=time VALUE=$NOW>\n"; |
| 647 |
print "<INPUT TYPE=hidden name=bbs VALUE=$FORM{'bbs'}>\n"; |
| 648 |
print "<INPUT TYPE=hidden name=key VALUE=$FORM{'key'}>\n"; |
| 649 |
print "<TEXTAREA ROWS=5 COLS=60 wrap=off NAME=MESSAGE></TEXTAREA>\n"; |
| 650 |
print "</FORM><br>\n"; |
| 651 |
print "<P>$ver"; |
| 652 |
print "</BODY>"; |
| 653 |
print "</HTML>"; |
| 654 |
exit; |
| 655 |
} |
| 656 |
} |
| 657 |
|
| 658 |
|
| 659 |
#�G���[��ʁi�G���[�����j |
| 660 |
#DispError(TITLE,TOPIC); |
| 661 |
sub DispError{ |
| 662 |
my ($topic)=@_; |
| 663 |
print "Content-type: text/html; charset=shift_jis\n\n"; |
| 664 |
#----------------------------------------------------------------------- |
| 665 |
print <<EOF; |
| 666 |
<HTML> |
| 667 |
<HEAD> |
| 668 |
<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"> |
| 669 |
<TITLE>$topic</TITLE> |
| 670 |
<style type="text/css"> |
| 671 |
<!-- |
| 672 |
TD.Type1 { |
| 673 |
color: #ffffff; |
| 674 |
text-align: left; |
| 675 |
} |
| 676 |
A.BigLine { |
| 677 |
color: #000000; |
| 678 |
text-decoration: none; |
| 679 |
} |
| 680 |
--> |
| 681 |
</style> |
| 682 |
<BASE HREF="$hyoujun"> |
| 683 |
</HEAD> |
| 684 |
<BODY TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099"> |
| 685 |
<P><FONT SIZE=+1 COLOR="#FF0000">$topic</FONT></B><BR> |
| 686 |
<DL> |
| 687 |
<dt>1 ���O�F<font color="forestgreen"><b>$ver</b></font>���e���F2001/04/12(��) 15:11<dd>$topic<br><br><br> |
| 688 |
</DL> |
| 689 |
<HR> |
| 690 |
<FONT SIZE=-2>$ver</FONT> |
| 691 |
<HR><P> |
| 692 |
EOF |
| 693 |
my $datn = substr($FORM{'key'},0,3); |
| 694 |
|
| 695 |
if (-e "../$FORM{'bbs'}/kako/$FORM{'key'}.html"){ |
| 696 |
print "����! �ߋ����O�q�ɂŁA<A TARGET=\"_self\" HREF=\"../$FORM{'bbs'}/kako/$FORM{'key'}.html\">�X���b�h $FORM{'key'}.html</A>�@�����܂����B\n"; |
| 697 |
}elsif (-e "../$FORM{'bbs'}/kako/$datn/$FORM{'key'}.dat"){ |
| 698 |
print "����! �ߋ����O�q�ɂŁA<A TARGET=\"_self\" HREF=\"../$FORM{'bbs'}/kako/$datn/$FORM{'key'}.dat\">�X���b�h $FORM{'key'}.dat</A>�@�����܂����B<BR><B><FONT SIZE=+1 COLOR=RED>��</FONT></B>�A�������܂� html������Ă��܂���B�c�O�A�҂����Ȃ��B\n"; |
| 699 |
}else{ |
| 700 |
print "<A TARGET=\"_self\" HREF=\"../$FORM{'bbs'}/kako/index.html\">�ߋ����O�q��</A>�ɂ�����܂���ł����B<BR>�₢���킹�Ă�������\\���͂قƂ�ǂ���܂���B\n"; |
| 701 |
} |
| 702 |
print <<EOF; |
| 703 |
</BODY> |
| 704 |
</HTML> |
| 705 |
EOF |
| 706 |
exit; |
| 707 |
} |
Parent Directory
| 
Revision Log