Skip to content

Instantly share code, notes, and snippets.

@xaav
Created July 2, 2011 20:45
Show Gist options
  • Save xaav/1061627 to your computer and use it in GitHub Desktop.
Save xaav/1061627 to your computer and use it in GitHub Desktop.
#!/usr/bin/perl
#### �X�N���v�g�쐬�� ####################
## Honey Board v1.62 (2000/10/08) ##
## Copyright© Kent Web 2000 ##
## Mail: webmaster@kent-web.com ##
## Home: [url="http://www.kent-web.com/"]http://www.kent-web.com/[/url] ##
##########################################
$ver = 'Honey v1.62e'; # �o�[�W�������
##+- Created By --------------------------+##
## ##
## Talking BBS v1.0307 (1.0307) ##
## ##
## *- CGI Cafe. -* ##
## URL: [url="http://saya.kiy.jp/"]http://saya.kiy.jp/[/url] ##
## ##
##+------------------------------------+##
##+- Translated By --------------------------+##
## ##
## Talking BBS v1.62e (1.62) ##
## ##
## Zapchu Evolution ##
## URL: [url="http://zapchu.com"]http://zapchu.com[/url] ##
## ##
##+------------------------------------+##
##+- Re-posted and CGI Editted By --------------------------+##
## ##
## Talking BBS v1.62e (1.62) ##
## ##
## Flamzeron ##
## URL: [url="http://www.freewebs.com/flamzeron/"]http://www.freewebs.com/flamzeron/[/url] ##
## ##
##+------------------------------------+##
##----[���ӎ���]------------------------------------------------##
## ##
## 1. ���̃X�N���v�g�̓t���[�\�t�g�ł��B���̃X�N���v�g��g�p����##
## �����Ȃ鑹�Q�ɑ΂��Ă��҂͈�؂̐ӔC�𕉂��܂���B ##
## ##
## 2. �ݒu�Ɋւ��鎿��͌f���‚ɂ��肢�������܂��B ##
## ���[���ɂ�鎿��ɂ͈�؂��������܂���B ##
## ##
## 3. ����CGI�ɑ΂���₢���킹��A�X�N���v�g�쐬���ɂ� ##
## ��΂ɂ��Ȃ��ł��������ˁB ##
## ##
##��������������������������������ï¿
½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½ï¿½##
## ##
## �� �K�v�ȃt�@�C���Ǝ�ȃp�[�~�b�V�����ݒ� ##
## ���e�v���o�C�_�ɂ��ĈႢ�܂��̂ŕK���m�F���ĉ��
����ˁI##
## ������CGI�X�N���v�g��u���f�B���N�g���� ##
## �@�p�[�~�b�V������[777]�ɕύX���Ă��������I ##
## ##
##�@(��)talkbbs�f�B���N�g��[755] ##
## �talkbbs.cgi-----------------[755] ##
## �jcode.pl--------------------[755] ##
## �talkbbs.log(���O�ۑ��p)-----[755] ##
## �count.dat(�J�E���^�[���O)---[755] ##
## �img�t�H���_(gif�摜)--------[�ύX�s�v] ##
## ##
##--------------------------------------------------------------##
#============#
# �ݒ� #
#============#
require '/home/mizuho/public_html/cgi-bin/jcode.pl'; # Location of jcode.pl
$title = "Skit Style BBS"; # Title name
$t_color = "#000000"; # Title color
$t_face = "�ւ���"; # Title font
$t_point = '14pt'; # Title font size
$ImgT = "/home/mizuho/public_html/images/imgtitle.gif"; # Title image location goes here.
$ImgW = "376"; # Title image width
$ImgH = "83"; # Title image height
$script = /home/mizuho/public_html/cgi-bin/talkbbs.cgi"; # Name of script.
$logfile = /home/mizuho/public_html/cgi-bin/talkbbs.log"; # Name of logfile.
$pass = 'applesheena'; # Admin password
$admin ="Admin"; # Admin name.
$max = 300; # Max number of entries and replies before log overwrites.
$home = "http://mizuhobbs.heliohost.org/"; # Homepage
$imgurl = "/home/mizuho/public_html/images/"; # Folder location for your images
$home_img = "home.gif"; # Homepage image.
# �w�i�F�A�����F
$bgrnd = "/home/mizuho/public_html/images/bg1.gif"; # Background image
$lbg = "/home/mizuho/public_html/images/lefbg.gif"; # Left Background image
$rbg = "/home/mizuho/public_html/images/rigbg.gif"; # Right Background image
$tbg = "/home/mizuho/public_html/images/topbg.gif"; # Top Background image
$bbg = "/home/mizuho/public_html/images/botbg.gif"; # Bottom Background image
$bgcol = "#FFFFFF"; # Background color
$text = "#000000"; # Text color
$link = "#cc0000"; # Link color
$vlink = "#800000"; # Visited link color
$alink = "#800000"; # Active link color
$onepnt = "#000000"; # The color of the title text.
$t_m = "��"; # The text before the title of the entry.
# Colors that you want the users to be able to use in the entires.
@colors = ('#606060','#ff66b3','#99b3ff','#cc99ff','#4db3ff','#00e6b3','#ff8066','#ff4d99');
$c_m = "��"; # Font color example.
# �L���\�����u���n�v�̐F (1=�� 2=�s���N�j
$oya_sita = 1; # �e�L��
$res_sita = 2; # ���X�L��
$in_email = 0; # �d���[���A�h���X��K�{��͍��ڂɂ��܂����H (0=no 1=yes)
$method = 'POST'; # method�`�� (POST/GET)
$MethPost = 1; # �L���̍X�V�� method=POST ��� (0=no 1=yes) �A�����e�Ȃǂ̍r�炵�΍�
# How many seconds does someone have to wait before they can repost? (Can save bandwidth.)
# --> �A�����e�Ȃǂ̍r�炵�΍�
# --> �l�� 0 �ɂ���Ƃ��̋@�\�͖���ɂȂ�܂�
$wait = 120;
$tagkey = 0; # �^�O���� (0=no 1=yes)
$autolink = 1; # Want to auto link URLs? (0=no 1=yes)�^�O���‚̏ꍇ�� no �Ƃ��邱�ƁB
$p_log = 10; # How many entries do you want per page for the log?
$top_sort = 1; # Will new replies push entries to the top of page? (0=no 1=yes)
$gethostbyaddr = 1; # �z�X�g���擾�� gethostbyaddr�֐���g�p (0=no 1=yes)
# �z�X�g�����u�����v�݂̂ŕ\�������ꍇ�� "1" ����Ă݂Ă��������B
# ����ł�u�����v�ł����\������Ȃ��ꍇ�́A�v���o�C�_�����Ή��ł��B
# ���b�N�t�@�C���@�\ (0=no 1=symlink�֐� 2=open�֐�)
# --> ���b�N�t�@�C���@�\��g�p����ꍇ���b�N�t�@�C���𐶐�����f�B���N
�g��
# �̃p�[�~�b�V������ 777 �ɐݒ肷��
$lockkey = 0;
$lockfile = "./talkbbs.lock"; # Name of the lock file.
# ���[���ʒm�@�\
# --> 0 : no
# --> 1 : yes �����̓��e�L�����[���ʒm����
# --> 2 : yes �����̓��e�L���̓��[���ʒm���Ȃ�
$mailing = 0;
$sendmail = '/usr/lib/sendmail'; # The directory to the sendmail program on your host goes here
$mailto = 'dmbvol@aol.com'; # dmbvol@aol.com
# ADD AVATARS HERE (icon1 is the file location, icon2 is the name of the file)
@icon1 = (
'cress1.png','lloyd1.gif','lloyd2.gif','lloyd3.gif','lloyd4.gif','lloyd5.gif','zelos1.gif','zelos2.gif','zelos3.gif','zelos4.gif','zelos5.gif','sheena1.gif','sheena2.gif','sheena3.gif','sheena4.gif','sheena5.gif','kratos1.gif','kratos2.gif','kratos3.gif','kratos4.gif','kratos5.gif','raine1.gif','raine2.gif','raine3.gif','raine4.gif','raine5.gif','genis1.gif','genis2.gif','genis3.gif','genis4.gif','genis5.gif','presea1.gif','presea2.gif','presea3.gif','presea4.gif','presea5.gif','regal1.gif','regal2.gif','regal3.gif','regal4.gif','regal5.gif','colette1.gif','colette2.gif','colette3.gif','colette4.gif','colette5.gif','corrine.gif','noishe.gif');
@icon2 = (
'Cress 1','Lloyd 1','Lloyd 2','Lloyd 3','Lloyd 4','Lloyd 5','Zelos 1','Zelos 2','Zelos 3','Zelos 4','Zelos 5','Sheena 1','Sheena 2','Sheena 3','Sheena 4','Sheena 5','Kratos 1','Kratos 2','Kratos 3','Kratos 4','Kratos 5','Raine 1','Raine 2','Raine 3','Raine 4','Raine 5','Genis 1','Genis 2','Genis 3','Genis 4','Genis 5','Presea 1','Presea 2','Presea 3','Presea 4','Presea 5','Regal 1','Regal 2','Regal 3','Regal 4','Regal 5','Colette 1','Colette 2','Colette 3','Colette 4','Colette 5','Corrine','Noishe');
# �Ǘ��җp�A�C�R��
# --> �Ǘ��A�C�R����w�肷��ꍇ�́u�ς��v���ɊǗ��p�p�X��
�[�h�𓯎��ɓ�͂���K�v������܂��B
$mgr_icon = "admin.jpeg";
# �^�O�L���}��I�v�V����
# �� <!--�㕔--> <!--����--> �̑���Ɂu�L���^�O�v��}���B
# �� �L���^�O�ȊO�ɁAMIDI�^�O �� LimeCounter���̃^�O�ɂ�g�p�”\�ł��B
$banner1 = '<!--�㕔-->'; # �f���㕔�ɑ}��
$banner2 = '<!--����-->'; # �f���‰����ɑ}��
# Who do you want to deny access to? Add the IP address below in the same format.
@deny = (
"anonymizer",
"cache*.*.interlog.com",
"mail.stjohns.sa.edu.au",
"modemcable180.108-81-70.mc.videotron.ca",
"ool-18b923ad.dyn.optonline.net",
"69.0.31.77.adsl.snet.net",
"c-24-0-132-105.client.comcast.net",
"CPE-60-231-228-37.sa.bigpond.net.au",
"89.011.dsl.ade.iprimus.net.au",
"108.192.233.220.exetel.com.au",
"DC-205-62.bpb.bigpond.com",
"200.118.2.219",
"195.229.242.85",
"mail.reveszgroup.com",
"200.118.2.219",
"216-136-4-22.gen.twtelecom.net",
""
);
# �~�j�J�E���^�̐ݒu---------------------------------------
$counter = 1; # 0=no�A 1=�e�L�X�g�A 2=GIF�摜
$mini_fig = 5; # �~�j�J�E���^�̌���
$cnt_color = "#000000"; # �e�L�X�g�̂Ƃ��F�~�j�J�E���^�̐F
$gif_path = "./img"; # �f�h�e�̂Ƃ��@�F�摜�܂ł̃f�B���N�g��
$mini_w = 10; # �V �@�F�摜�̉��T�C�Y
$mini_h = 10; # �V �@�F�摜�̏c�T�C�Y
$cntfile = "./count.dat"; # �J�E���^�t�@�C��
$cnt_pl = "right"; # �J�E���^�[�̕\���ʒu�@(��ʍ��Fleft�@��ʉE�Fright)���X�y���ԈႦ�Ȃ��łˁ`�I
$cntlock = "./cnt.lock"; # �J�E���^�̃��b�N�t�@�C�����������������폜
�����̂ŁA�������ō쐬������A�b�v���[�h�̕K�v�͂���܂����B
#---------------- �X�^�C���V�[�g�̐ݒ� -------------------------------
#�X�^�C���V�[�g���킩��l�͓K���ɕύX���Ă��������ˁB
# �@��IE4�ȏ�ANN6�ȏ�ł������f����Ȃ����ڂ���܂��B
$b_size = '9pt'; # �{���̕����T�C�Y�i�X�^�C���V�[�g�ŗL��j
$body_font= "�ւ���"; # �{���̕����X�^�C��
$input_color = "#000000"; #��͗��̕����F
$input_border = "#000000"; #��͗��̘g�̐F
$input_bgcolor= "#FFFFFF"; #��͗��̔w�i�̐F
$hlink_color = "#000000"; #�����N�Ƀ}�E�X��̂����Ƃ��̕����F
$hlink_bgcolor= "#FFFFFF"; #�����N����(�{�^���܂�)�Ƀ}�E�X��̂����Ƃ��̔w�i�F
$hr = "#000000"; #����̐F
$style = <<"HTML";
<style type="text/css">
<!--
body,table,tr,td,th,input { font-size:$b_size; font-family : $body_font;}
a:link {text-decoration : none; }
a:visited {text-decoration : none; }
a:active {text-decoration : none; }
a:hover {text-decoration :underline overline; background-color : $hlink_bgcolor; color:$hlink_color;
}
input,textarea,select{border-left:1px solid $input_border;
border-right:2px solid $input_border;
border-top:1px solid $input_border;
border-bottom:2px solid $input_border;
background-color : $input_bgcolor; color : $input_color;cursor:hand;}
hr {color: $hr;}
th {background-color: $hr;}
span { font-size:$t_point }
big { font-size:12pt }
small { font-size:9pt }
-->
</style>
HTML
#============#
# �ݒ芮�� #
#============#
# �C���[�W�f�B���N�g������
$imgurl =~ s/\/$//;
&decode;
&axs_check;
if ($mode eq 'regist') { &regist; }
if ($mode eq 'find') { &find; }
if ($mode eq 'howto') { &howto; }
if ($mode eq 'admin') { &admin; }
if ($mode eq 'usrdel') { &usrdel; }
if ($mode eq 'image') { &image; }
if ($mode eq 'res') { &res_msg; }
&html;
#----------------#
# �A�N�Z�X���� #
#----------------#
sub axs_check {
# �z�X�g����擾
&get_host;
local($flag)=0;
foreach (@deny) {
if (!$_) { next; }
$_ =~ s/\*/\.\*/g;
if ($host =~ /$_/i) { $flag=1; last; }
}
if ($flag) { &error("�A�N�Z�X��‚���Ă��܂���"); }
}
#----------------#
# �L���\������ #
#----------------#
sub html {
&header;
print "<center>\n";
if ($banner1 ne "<!--�㕔-->") { print "$banner1<P>\n"; }
# �J�E���^����
if ($counter) { &counter; }
# �^�C�g����
if ($ImgT) {
print "<img src=\"$ImgT\" width=$ImgW height=$ImgH alt=\"$title\"><p>\n";
}
else {
print "<font color=\"$t_color\" face=\"$t_face\" size=5\"><b><span>$title</span></b></font><p>\n";
}
print "| <a href=\"$home\" target=\"_top\">Home</a> \n";
print "| <a href=\"$script?mode=howto\">How To/Rules</a> \n";
print "| <a href=\"$script?mode=find\">Find</a> \n";
print "| <a href=\"$script?mode=admin\">Admin</a> |<p>\n";
# �t�H�[����\��
&form_view;
# �y�[�W��؂菈��
$start = $page + 1;
$end = $page + $p_log;
open(IN,"$logfile") || &error("Open Error : $logfile");
$top = <IN>;
$i=0; $j=0;
while (<IN>) {
($no,$reno,$date,$name,$mail,$sub,$icon,
$icon2,$com,$color,$url,$host,$pw) = split(/<>/);
if ($reno eq "") { $i++; $j++; }
if ($i < $start) { next; }
if ($i > $end) { next; }
if ($mail) { $name = "<a href=\"mailto:$mail\">$name</a>"; }
if (!$reno && $url) { $url = "<a href=\"http://$url\" target='_blank'><img src=\"$imgurl\/$home_img\" border=0 align=top></a>"; }
elsif ($reno && $url) { $url = "<font size=2>&lt;<a href=\"http://$url\" target='_top'>Homepage&gt;</font>"; }
# �P�}�X�̑傫��
$pix = 24;
# �e�q�L���ŕ��ƐF�𒲐�
@GIF1 = ("","m_c1.gif","m_c2.gif","m_c3.gif","m_c4.gif","m_c5.gif","m_c6.gif");
@GIF2 = ("","m_c1.gif","m_c2.gif","m_c3.gif","m_c4.gif","m_c5.gif","m_c6.gif");
if ($reno) {
$wide = 300;
if ($res_sita == 2) {
$iro = "#DEBD5A";
@gif = @GIF2;
} else {
$iro = "#DEBD5A";
@gif = @GIF1;
}
}
else {
$wide = 400;
if ($oya_sita == 2) {
$iro = "#DEBD5A";
@gif = @GIF2;
} else {
$iro = "#DEBD5A";
@gif = @GIF1;
}
}
# ENTRY STYLE
if (!$reno) { print "<br><br>\n"; }
print "<TABLE BORDER=0><TR>\n";
# ���]�Ώە���1
if (!$flag) {
print "<TD><img src=\"$imgurl\/$icon\"></TD>\n";
print "<TD>\n";
print "<table border=0 cellpadding=0 cellspacing=0><tr>\n";
print "<td width=$pix><br></td>\n";
}
else {
print "<TD>\n";
print "<table border=0 cellpadding=0 cellspacing=0><tr>\n";
}
print "<td><img src=\"$imgurl\/$gif[1]\" width=$pix height=$pix></td>\n";
print "<td width=$wide bgcolor=\"$iro\" background=\"img/topbg.gif\"><br></td>\n";
print "<td><img src=\"$imgurl\/$gif[2]\" width=$pix height=$pix></td>\n";
# ���]�Ώە���2
if ($flag == 0) {
print "</tr>";
print "<tr><td><img src=\"$imgurl\/$gif[5]\" width=$pix height=$pix></td>\n";
}
else {
print "<td width=$pix><br></td></tr>\n<tr>\n";
}
print "<td bgcolor=\"$iro\" background=\"img/lefbg.gif\"><br></td>\n";
print "<td width=\"$wide\" bgcolor=\"$iro\">\n";
print "<font color=\"$onepnt\">$t_m $sub</font> ";
print "<blockquote><font color=\"$color\">$com</font></blockquote><DIV align=\"right\">\n";
print "by $name <small>...$date</small> ";
print "<font color=\"$onepnt\"><small>No\.$no</small></font> ";
print "$url\n";
if (!$reno) {
print "[<a href=\"$script?mode=res&no=$no\">Reply</a>] &nbsp; \n";
}
print "</div></td><td bgcolor=\"$iro\" background=\"img/rigbg.gif\"><br></td>\n";
if ($flag == 1) {
print "<td><img src=\"$imgurl\/$gif[6]\" width=$pix height=$pix></td>\n";
}
print "</tr><tr>\n";
# ���]�Ώە���3
if ($flag == 0) { print "<td width=$pix><br></td>\n"; }
print "<td><img src=\"$imgurl\/$gif[4]\" width=$pix height=$pix></td>\n";
print "<td width=\"$wide\" bgcolor=\"$iro\" background=\"img/botbg.gif\">�@</td>\n";
print "<td><img src=\"$imgurl\/$gif[3]\" width=$pix height=$pix></td>\n";
if ($flag == 1) { print "<td width=$pix><br></td>\n"; }
print "</tr></table>\n";
if ($flag == 1) {
print "</TD><TD><img src=\"$imgurl\/$icon\">\n";
}
print "</TD></TR></TABLE>\n";
if (!$reno) {
if ($flag == 0) { $flag = 1;}
else { $flag = 0; }
}
}
close(IN);
$next_page = $page + $p_log;
$back_page = $page - $p_log;
print "<p><table cellpadding=0 cellspacing=0 align=\"center\"><tr>\n";
if ($back_page >= 0) {
print "<td align=\"center\"><form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=page value=\"$back_page\">\n";
print "<input type=submit value=\"Back\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "</td></form>\n";
}
if ($next_page < $i) {
print "<td align=\"center\"><form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=page value=\"$next_page\">\n";
print "<input type=submit value=\"Next\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "</td></form>\n";
}
print "</tr></table><br><br><p>\n";
print "<table align='center'><tr>\n";
print "<td nowrap align='center'><form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=mode value=\"usrdel\">\n";
print "Message Deletion Form<br>\n";
print "No.<input type=text name=no size=3>\n";
print "Password<input type=password name=pwd size=4 maxlength=8>\n";
print "<input type=submit value=\"Delete?\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "</form></td>\n";
print "</tr></table>\n";
# FOOTER FOR AUTHOR NOTES (DO NOT REMOVE)
print "<center><a href='http://www.kent-web.com/' target='_blank'>- Honey Board -</a><br>\n";
print "Edit By <a href='http://saya.kiy.jp/' target='_blank'>*- CGI Cafe. -*</a><br>\n";
print "Translated By <a href='http://zapchu.com/' target='_blank'>Zapchu Evolution</a><p>\n";
print "Reposted By <a href='http://freewebs.com/flamezeron' target='_blank'>Flamezeron</a><p>\n";
print "</small>\n";
print "$banner2<P><small><!-- $ver --></center>\n";
print "</body></html>\n";
exit;
}
#----------------#
# �������ݏ��� #
#----------------#
sub regist {
# POST���
if ($MethPost && !$post_flag) { &error("There was an error."); }
# �t�H�[����e��`�F�b�N
if ($in{'name'} eq "") { &error("You forgot to input a name."); }
if ($in{'comment'} eq "") { &error("You forgot to input a comment."); }
if ($in_email && $in{'email'} !~ /(.+)\@(.+)\.(.+)/) {
&error("Please go back and check the e-mail address.");
}
# �Ǘ��҃A�C�R������
if ($in{'icon'} eq "$mgr_icon") {
if ($in{'pwd'} ne "$pass") {
&error("You may not use administrator avatar.");
}
}
# ���b�N����
if ($lockkey == 1) { &lock1; }
elsif ($lockkey == 2) { &lock2; }
open(IN,"$logfile") || &error("Open Error : $logfile","lock");
@lines = <IN>;
close(IN);
# �L��NO����
$top = shift(@lines);
($no,$ip,$time2) = split(/<>/, $top);
$no++;
# �A�����e�`�F�b�N
if ($addr eq "$ip" && $wait > $times - $time2)
{ &error("You may not post at frequent intervals. Please wait a while.","lock"); }
# �폜�L�[��Í���
if ($in{'pwd'} ne "") { $PW = &encrypt("$in{'pwd'}"); }
# URL���������N
if ($autolink) { &auto_link($in{'comment'}); }
# �e�L���̏ꍇ
if ($in{'reno'} eq "") {
# �ő�L��������
while ($max <= @lines) { pop(@lines); }
unshift(@lines,"$no<><>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'icon'}<>$icon2<>$in{'comment'}<>$in{'color'}<>$in{'url'}<>$host<>$PW<>\n");
unshift(@lines,"$no<>$addr<>$times<>\n");
# �X�V
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @lines;
close(OUT);
}
# ���X�L���̏ꍇ�F�g�b�v�\�[�g����
elsif ($in{'reno'} && $top_sort) {
$match=0;
@new=();
@tmp=();
foreach (@lines) {
($no2,$reno2) = split(/<>/);
if ($in{'reno'} eq "$no2") {
$match=1;
push(@new,$_);
}
elsif ($in{'reno'} eq "$reno2") {
push(@new,$_);
}
elsif ($match == 1 && $in{'reno'} ne "$reno2") {
$match=2;
push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'icon'}<>$icon2<>$in{'comment'}<>$in{'color'}<>$in{'url'}<>$host<>$PW<>\n");
push(@tmp,$_);
}
else { push(@tmp,$_); }
}
if ($match == 1) {
push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'icon'}<>$icon2<>$in{'comment'}<>$in{'color'}<>$in{'url'}<>$host<>$PW<>\n");
}
push(@new,@tmp);
# �X�V
unshift(@new,"$no<>$addr<>$times<>\n");
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @new;
close(OUT);
}
# ���X�L���̏ꍇ�F�g�b�v�\�[�g�Ȃ�
else {
$match=0;
@new=();
foreach (@lines) {
($no2,$reno2) = split(/<>/);
if ($match == 0 && $in{'reno'} eq "$no2") { $match=1; }
elsif ($match == 1 && $in{'reno'} ne "$reno2") {
$match=2;
push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'icon'}<>$icon2<>$in{'comment'}<>$in{'color'}<>$in{'url'}<>$host<>$PW<>\n");
}
push(@new,$_);
}
if ($match == 1) {
push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'icon'}<>$icon2<>$in{'comment'}<>$in{'color'}<>$in{'url'}<>$host<>$PW<>\n");
}
# �X�V
unshift(@new,"$no<>$addr<>$times<>\n");
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @new;
close(OUT);
}
# ���b�N��
if (-e $lockfile) { unlink($lockfile); }
if ($in{'cook'} eq 'on') { &set_cookie; }
# ���[���ʒm����
if ($mailing == 1) { &mail_to; }
elsif ($mailing == 2 && $email ne "$mailto") { &mail_to; }
}
#--------------#
# ���[�h���� #
#--------------#
sub find {
&header;
print <<"HTML";
<center>
<table width="60%"><tr><th>
<font color="#FFFFFF">Word Search</font>
</th></tr></table>
<a href="$script?">*Back</a><P>
<table cellpadding=5 cellspacing=0>
<tr><td nowrap>
<UL>
<LI>If you want to search for an entry, please put in a keyword. Then, press the search button.
<LI>You may also search for partial keywords.
</UL>
</td></tr>
</table>
<P><form action="$script" method="$method">
<input type=hidden name=mode value="find">
<table border=2 bgcolor="#ffffff" cellspacing=0 bordercolor="#000000">
<tr>
<td colspan=2 align="center">
Keyword<input type=text name=word size=30 value="$in{'word'}">
</th>
</tr>
<tr>
<td>Search Options</td>
<td>
<input type=radio name=cond value="and" checked>AND
<input type=radio name=cond value="or">OR
</td>
</tr>
<tr>
<td colspan=2 align="center">
<input type=submit value="Search" onMouseOver="this.style.background='$hlink_bgcolor'" onMouseOut="this.style.background='$input_bgcolor'">
<input type=reset value="Reset" onMouseOver="this.style.background='$hlink_bgcolor'" onMouseOut="this.style.background='$input_bgcolor'">
</th>
</tr>
</table>
</form></center>
HTML
# ���[�h����̎�s�ƌ��ʕ\��
if ($in{'word'} ne "") {
# ��͓�e�𐮗�
$in{'word'} =~ s/�@/ /g;
@pairs = split(/\s+/, $in{'word'});
# �����
print "<hr width='60%'>\n";
open(IN,"$logfile") || &error("Open Error : $logfile");
$top = <IN>;
$i=0;
while (<IN>) {
$flag=0;
foreach $pair (@pairs) {
if (index($_,$pair) >= 0) {
$flag=1;
if ($in{'cond'} eq 'or') { last; }
} else {
if ($in{'cond'} eq 'and') { $flag=0; last; }
}
}
if ($flag == 0) { next; }
# ���ʂ�\��
$i++;
($no,$reno,$date,$name,$mail,$sub,
$icon,$icon2,$com,$res,$url,$host,$pw) = split(/<>/);
if ($mail) { $name = "<a href=\"mailto:$mail\">$name</a>"; }
if ($url) { $url = "<a href=\"http://$url\" target='_blank'>http://$url</a>"; }
print "<center><table width='60%'><tr><td>\n";
print "<LI>[$no]$sub by $name <small>...$date</small><br>\n";
print "<blockquote>$com<P>$url</blockquote></td></tr></table><hr width='60%'>\n";
}
close(IN);
print "The search results are: <b>$i</b>.\n";
}
print "</center></body></html>\n";
exit;
}
#--------------#
# �Ǘ����[�h #
#--------------#
sub admin {
if ($in{'pass'} ne "" && $in{'pass'} ne "$pass") {
&error("The password is incorrect.");
}
&header;
print "<center><table width='75%'><tr><th>\n";
print "<font color=\"#FFFFFF\">*-- $admin only --*</font>\n";
print "</th></tr></table>\n";
print "<a href=\"$script\?\">Back</a>\n";
if ($in{'pass'} eq "") {
print "<P><center><h4>Please input a password!</h4>\n";
print "<form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=mode value=\"admin\">\n";
print "<input type=hidden name=action value=\"del\">\n";
print "<input type=password name=pass size=8> ";
print "<input type=submit value=\" �n�j \" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "</form>\n";
} else {
# �폜����
if ($DEL[0]) {
# ���b�N����
if ($lockkey == 1) { &lock1; }
elsif ($lockkey == 2) { &lock2; }
# �폜����}�b�`���O���X�V
@new=();
open(IN,"$logfile") || &error("Open Error : $logfile","lock");
$top = <IN>;
while (<IN>) {
$flag=0;
($no,$reno,$date) = split(/<>/);
foreach $del (@DEL) {
if ($no eq "$del" || $reno eq "$del") {
$flag=1; last;
}
}
if ($flag == 0) { push(@new,$_); }
}
close(IN);
# �X�V
unshift(@new,$top);
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @new;
close(OUT);
# ���b�N��
if (-e $lockfile) { unlink($lockfile); }
}
# �Ǘ���\��
if ($page eq "") { $page = 0; }
print "<P><center><table><tr><td>\n";
print "<UL><LI>�폜����L���̃`�F�b�N�{�b�N�X�Ƀ`�F�b�N����A�u�����v�{�^������ĉ������B\n";
print "<LI>�e�L����폜����Ƃꂷ�L����ꊇ���č폜����܂��̂Å
A���ӂ��Ă��������B</UL>\n";
print "</td></tr></table>\n";
print "<form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=mode value=\"admin\">\n";
print "<input type=hidden name=page value=\"$page\">\n";
print "<input type=hidden name=pass value=\"$in{'pass'}\">\n";
print "<input type=hidden name=action value=\"$in{'action'}\">\n";
print "<input type=submit value=\"Post\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\"> ";
print "<input type=reset value=\"Reset\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "<P><table border=0 cellspacing=1 bgcolor=\"#ffffff\" bordercolor=\"#000000\" width='75%'>\n";
print "<tr><th>Delete</th><th>NO</th><th>Date</th><th>Title</th>";
print "<th>Name</th><th>Homepage</th><th>Comment</th><th>IP</th></tr>\n";
# �y�[�W��؂菈��
$start = $page + 1;
$end = $page + $p_log;
open(IN,"$logfile") || &error("Open Error : $logfile");
$top = <IN>;
$i=0; $j=0;
while (<IN>) {
($no,$reno,$date,$name,$mail,$sub,$icon,
$icon2,$com,$color,$url,$host,$pw) = split(/<>/);
if ($reno eq "") { $i++; $j++; }
if ($i < $start) { next; }
if ($i > $end) { next; }
if ($mail) { $name="<a href=\"mailto:$mail\">$name</a>"; }
($date,$dmy) = split(/\(/, $date);
if ($url) { $url = "<a href=\"http://$url\" target='_top'>Home</a>"; }
else { $url = '-'; }
$com =~ s/<br>//ig;
$com =~ s/</&lt;/g;
$com =~ s/>/&gt;/g;
if (length($com) > 50) {
$com = substr($com,0,48);
$com = "$com" . "...";
}
if ($reno eq "") { print "<tr><td colspan=8><hr></td></tr>\n"; }
# �폜�`�F�b�N�{�b�N�X
print "<tr><td align=\"center\"><input type=checkbox name=del value=\"$no\"></td>";
print "<td align=center>$no</td>";
print "<td><small>$date</small></td><td align=\"center\">$sub</td><td align=\"center\">$name</td>";
print "<td align=center>$url</td><td><small>$com</small></td>";
print "<td><small>$host</small></td></tr>\n";
}
close(IN);
print "<tr><td colspan=8><hr></td></tr>\n";
print "</table></form>\n";
}
$next_page = $page + $p_log;
$back_page = $page - $p_log;
print "<P><table cellspacing=0 cellpadding=0><tr>\n";
if ($back_page >= 0) {
print "<td><form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=page value=\"$back_page\">\n";
print "<input type=hidden name=pass value=\"$in{'pass'}\">\n";
print "<input type=hidden name=mode value=\"admin\">\n";
print "<input type=hidden name=action value=\"$in{'action'}\">\n";
print "<input type=submit value=\"Back\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "</td></form>\n";
}
if ($next_page < $i) {
print "<td><form action=\"$script\" method=\"$method\">\n";
print "<input type=hidden name=page value=\"$next_page\">\n";
print "<input type=hidden name=pass value=\"$in{'pass'}\">\n";
print "<input type=hidden name=mode value=\"admin\">\n";
print "<input type=hidden name=action value=\"$in{'action'}\">\n";
print "<input type=submit value=\"Next\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\">\n";
print "</td></form>\n";
}
print "</tr></table></center>\n";
print "</body></html>\n";
exit;
}
#--------------------#
# �ԐM���X�t�H�[�� #
#--------------------#
sub res_msg {
&header;
print <<"EOM";
<center>
<table width="60%"><tr><th>
<font color="#FFFFFF">�ԐM��[��</font>
</th></tr></table>
<a href="java script:history.back()">*- �΂�� -*</a>
<p><hr width='60%'>
EOM
open(IN,"$logfile") || &error("Open Error : $logfile");
$top = <IN>;
while (<IN>) {
($no,$reno,$date,$name,$mail,$sub,$icon,
$icon2,$com,$color,$url,$host,$pw) = split(/<>/);
if ($in{'no'} eq "$no" || $in{'no'} eq "$reno") {
if ($mail) { $name = "<a href=\"mailto:$mail\">$name</a>"; }
if ($url) { $url = "<a href=\"http://$url\" target='_top'><img src=\"$imgurl\/$home_img\" border=0 align=top></a>"; }
# ���X�薼�p
if ($reno eq "") { $res_sub = "Re: $sub"; }
print "<table width='60%'><tr><td><font color=\"$onepnt\">$t_m $sub</font> by $name ...$date $url<P>\n";
print "$com</td></tr></table><hr width='60%'>\n";
}
}
close(IN);
&form_view("$in{'no'}");
print "</body></html>\n";
exit;
}
#--------------#
# HOW TO/RULES #
#--------------#
sub howto {
&header;
print <<"EOM";
<center>
<table width="60%">
<tr>
<th>
<font color="#FFFFFF">How to use this bulletin board.</font>
</th>
</tr>
</table>
<a href="java script:history.back()">Back</a>
<P>
<table border=2 bordercolor="#000000" cellpadding=10 align=center width="50%">
<tr><td bgcolor="#FFFFFF">
<OL>
<LI>This BBS uses cookies.</b>The system saves all the information you entered and saves it as a cookie.<P>
EOM
if ($tagkey) {
print "<LI>You may use tags inside the message box.</b><P>\n";
}
else {
print "<LI>Using tags inside the message box has been disabled.</b><P>\n";
}
if ($in_email) {
print "<LI>The most important factors in contributing a post are inputting the name and message. The other items are optional.<P>\n";
} else {
print "<LI>The most important factors in contributing a post are inputting name and message. The other items are optional.<P>\n";
}
print <<"EOM";
<LI>Hey there, everyone! My name is Flamzeron. I am also known as RyanBurton on this BBS. The original version of this BBS was closing down, so I have taken over duties as the administrator. As you can see, I have done some editing of this site. However, I do not know CGI, so any help will be appreciated.P>
<LI>First off, this is a message board, not a chat room. You may talk about Tales or anything else. All I ask is that you are respectable of others.<P>
<LI>Do not make posts just to test out the avatars. If you want to see the avatars, click the word avatar?in the posting box. Beneath the pictures, you'll see which choice they represent. Don't worry; the page will open up in a new window so you won't have to worry about losing what you may have already typed.<P>
<LI>When replying to someone's post in a thread, please click the reply?button instead of posting in the reply box at the top of the page. That would not be a good thing. Only use the reply box at the top of the page in order to make a new topic.<P>
<LI>Any and all trolling posts or flames WILL be deleted. This goes for inappropriate posts that were meant to make people feel bad or posts that have pretty much nothing in them, or cluttering posts. No questions asked. But I will know if you're simply kidding around, so feel free to let your sense of humor run amok, just be courteous to other people's feelings. Also, avoid unnecessary fighting posts. I don't mind simple bonks at times, but no all out war. This is a friendly community here, people! XD<P>
<LI>You don't have to be perfect, but please try to keep as best spelling and grammer as possible. Also, no grammar nazis.P>
<LI>Something I've notice happen a lot lately is war threads. Everyone, please don't do this. They are unnecessarily lengthily and they bump out other posts, often people looking for help or wanting to hold a poll. So, I'm sorry to say, but I'm gonna have to ask you to stop. I don't mind you whacking people once in a while, but don't turn it into all out battles and wars please.<P>
<LI>Well, I think that covers all the basics. If I think of anything else that should be mentioned, I'll be sure to add it into my files for next time I feel the guidelines of the board should be posted.<P>
<LI>The one thing I want to make sure everyone understands is that this BBS is meant to be fun. Feel free to talk about anything Tales of related or other interesting topics. But you must also know that there are others on this board you have to be considerate of. So let's all try to be friends. ^_^P>
<LI>Happy posting, Flamzeron
</OL>
</td></tr></table>
</body></html>
EOM
exit;
}
#------------------#
# ���[�U�L���폜 #
#------------------#
sub usrdel {
# POST���
if ($MethPost && !$post_flag) { &error("�s���ȃA�N�Z�X�ł�"); }
if ($in{'no'} eq '' || $in{'pwd'} eq '') {
&error("�폜No�܂��͍폜���[����͂��ł�");
}
# ���b�N����
if ($lockkey == 1) { &lock1; }
elsif ($lockkey == 2) { &lock2; }
open(IN,"$logfile") || &error("Open Error : $logfile");
@lines = <IN>;
close(IN);
$top = shift(@lines);
$flag=0;
foreach (@lines) {
($no,$reno,$date,$name,$mail,$sub,$icon,
$icon2,$com,$color,$url,$host,$pw) = split(/<>/);
if ($flag == 0 && $in{'no'} eq "$no") {
$PW = $pw;
if ($reno eq "") { $flag=2; }
else { $flag=1; }
}
elsif ($flag == 2 && $in{'no'} eq "$reno") { next; }
else { push(@new,$_); }
}
if ($flag == 0) { &error("�Y���L������������܂���","lock"); }
if ($PW eq '') { &error("�Y���L���ɂ͍폜���[���ݒ肳��Ă��܂���","lock"); }
# �폜�L�[��ƍ�
$check = &decrypt("$in{'pwd'}", "$PW");
if ($check ne 'yes') { &error("�폜���[���Ⴂ�܂�","lock"); }
else {
# �X�V
unshift(@new,$top);
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @new;
close(OUT);
# ���b�N��
if (-e $lockfile) { unlink($lockfile); }
}
}
#----------------#
# �f�R�[�h���� #
#----------------#
sub decode {
$post_flag=0;
if ($ENV{'REQUEST_METHOD'} eq "POST") {
$post_flag=1;
if ($ENV{'CONTENT_LENGTH'} > 51200) { &error("���e�ʂ��傫�����܂�"); }
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
} else { $buffer = $ENV{'QUERY_STRING'}; }
@pairs = split(/&/, $buffer);
foreach (@pairs) {
($name,$value) = split(/=/);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# S-JIS�R�[�h�ϊ�
&jcode'convert(*value, "sjis", "", "z");
# �^�O����
if ($tagkey == 0) {
$value =~ s/\&/&amp;/g;
$value =~ s/</&lt;/g;
$value =~ s/>/&gt;/g;
} else {
$value =~ s/<>/&lt;&gt;/g;
$value =~ s/<!--(.|\n)*-->//g;
}
# ��s����
if ($name eq 'comment') {
$value =~ s/\r\n/<br>/g;
$value =~ s/\r/<br>/g;
$value =~ s/\n/<br>/g;
} else {
$value =~ s/\r//g;
$value =~ s/\n//g;
}
# �폜���
if ($name eq 'del') { push(@DEL,$value); }
$in{$name} = $value;
}
if ($in{'sub'} eq "") { $in{'sub'} = "�́[�����Ƃ�"; }
$in{'url'} =~ s/^http\:\/\///;
$mode = $in{'mode'};
$page = $in{'page'};
# ��̎擾
$ENV{'TZ'} = "JST-9";
$times = time;
($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($times);
# ��̃t�H�[�}�b�g
@week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
$date = sprintf("%04d\/%02d\/%02d(%s) %02d\:%02d",
$year+1900,$mon+1,$mday,$week[$wday],$hour,$min);
}
#--------------#
# HTML�w�b�_ #
#--------------#
sub header {
$head_flag = 1; # �w�b�_�\���t���O
print "Content-type: text/html\n\n";
print <<"EOM";
<html>
<head>
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift_JIS">
$style
<title>$title</title></head>
<body background="$bgrnd" bgcolor="$bgcol" text="$text" link="$link" vlink="$vlink" alink="$alink" font family="$body_font" bgproperties="fixed">
EOM
}
#------------------------------------#
# �u���E�U��񂩂�t�H�[�������` #
#------------------------------------#
sub get_agent {
$agent = $ENV{'HTTP_USER_AGENT'};
if ($agent =~ /MSIE 4/i || $agent =~ /MSIE 5/i) {
$f_name = 50;
$f_sub = 50;
$f_url = 50;
$f_cols = 50;
} else {
$f_name = 35;
$f_sub = 35;
$f_url = 35;
$f_cols = 40;
}
}
#--------------#
# �G���[���� #
#--------------#
sub error {
if ($_[1] eq "lock" && -e $lockfile) { unlink($lockfile); }
&header if (!$head_flag);
print "<center><hr width='75%'><P><h3>����[�I�I</h3>\n";
print "<P><font color=red><B>$_[0]</B></font>\n";
print "<P><hr width='75%'></center>\n";
print "</body></html>\n";
exit;
}
#------------------#
# �N�b�L�[�̔��s #
#------------------#
sub set_cookie {
($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg) = gmtime(time + 60*24*60*60);
@mons = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
$date_g = sprintf("%s, %02d\-%s\-%04d %02d\:%02d\:%02d GMT",
$week[$wdayg],$mdayg,$mons[$mong],$yearg+1900,$hourg,$ming,$secg);
$cook="name\:$in{'name'}\,email\:$in{'email'}\,url\:$in{'url'}\,pwd\:$in{'pwd'}\,color\:$in{'color'}\,icon\:$in{'icon'}";
print "Set-Cookie: HONEY=$cook; expires=$date_g\n";
}
#------------------#
# �N�b�L�[��擾 #
#------------------#
sub get_cookie {
local($key, $val);
$cookies = $ENV{'HTTP_COOKIE'};
@pairs = split(/;/, $cookies);
foreach (@pairs) {
($key, $val) = split(/=/);
$key =~ s/\s//g;
$DUMMY{$key} = $val;
}
@pairs = split(/,/, $DUMMY{'HONEY'});
foreach (@pairs) {
($key, $val) = split(/:/);
$COOKIE{$key} = $val;
}
$c_name = $COOKIE{'name'};
$c_email = $COOKIE{'email'};
$c_url = $COOKIE{'url'};
$c_pwd = $COOKIE{'pwd'};
$c_icon = $COOKIE{'icon'};
$c_color = $COOKIE{'color'};
if ($in{'cook'} eq 'on') {
if ($in{'name'}) { $c_name = $in{'name'}; }
if ($in{'email'}) { $c_email = $in{'email'}; }
if ($in{'url'}) { $c_url = $in{'url'}; }
if ($in{'pwd'} ne "") { $c_pwd = $in{'pwd'}; }
if ($in{'icon'}) { $c_icon = $in{'icon'}; }
if ($in{'color'}) { $c_color = $in{'color'}; }
}
}
#----------------#
# �z�X�g���擾 #
#----------------#
sub get_host {
$host = $ENV{'REMOTE_HOST'};
$addr = $ENV{'REMOTE_ADDR'};
if ($gethostbyaddr) {
if ($host eq "" || $host eq "$addr") {
$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
}
}
if ($host eq "") { $host = $addr; }
}
#----------------------#
# �p�X���[�h������ #
#----------------------#
sub encrypt {
local($inpw) = $_[0];
local(@SALT, $salt, $encrypt);
@SALT = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
srand;
$salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
$encrypt = crypt($inpw, $salt) || crypt ($inpw, '$1$' . $salt);
return $encrypt;
}
#----------------------#
# �p�X���[�h�ƍ����� #
#----------------------#
sub decrypt {
local($inpw, $logpw) = @_;
local($salt, $key, $check);
$salt = $logpw =~ /^\$1\$(.*)\$/ && $1 || substr($logpw, 0, 2);
$check = "no";
if (crypt($inpw, $salt) eq "$logpw" || crypt($inpw, '$1$' . $salt) eq "$logpw")
{ $check = "yes"; }
return $check;
}
#--------------------------------#
# ���b�N�t�@�C�� : symlink�֐� #
#--------------------------------#
sub lock1 {
local($retry) = 5;
while (!symlink(".", $lockfile)) {
if (--$retry <= 0) { &error("LOCK is BUSY","lock"); }
sleep(1);
}
}
#-----------------------------#
# ���b�N�t�@�C�� : open�֐� #
#-----------------------------#
sub lock2 {
local($flag) = 0;
foreach (1 .. 5) {
if (-e $lockfile) { sleep(1); }
else {
open(LOCK,">$lockfile")
|| &error("Write Error : $lockfile","lock");
close(LOCK);
$flag = 1;
last;
}
}
if ($flag == 0) { &error("LOCK is BUSY","lock"); }
}
#--------------#
# ���[�����M #
#--------------#
sub mail_to {
# ���[���^�C�g�����`
$MailSub = "[$title : $no] $in{'sub'}";
# �L���̉�s�E�^�O�𕜌�
$com = $in{'comment'};
$com =~ s/<br>/\n/g;
$com =~ s/&amp;/&/g;
$com =~ s/&lt;/</g;
$com =~ s/&gt;/>/g;
# ���[���{�����`
$MailBody = <<"EOM";
���e��F$date
�z�X�g���F$host
�u���E�U�F$ENV{'HTTP_USER_AGENT'}
���e�Җ��F$in{'name'}
�d���[���F$in{'email'}
�t�q�k �F$in{'url'}
�^�C�g���F$in{'sub'}
���e�L���F
$com
EOM
# JIS�R�[�h�ϊ�
&jcode'convert(*MailSub,'jis');
&jcode'convert(*MailBody,'jis');
# ���[���A�h���X���Ȃ��ꍇ�̓_�~�[���[���ɒu������
if ($in{'email'} eq "") { $email = 'nomail@xxx.xxx'; }
else { $email = $in{'email'}; }
if (!open(MAIL,"| $sendmail -t")) { &error("�߁[�鑗�M�Ɏ��s���܂���"); }
print MAIL "To: $mailto\n";
print MAIL "From: $email\n";
print MAIL "Subject: $MailSub\n";
print MAIL "MIME-Version: 1.0\n";
print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
print MAIL "Content-Transfer-Encoding: 7bit\n";
print MAIL "X-Mailer: $ver\n\n";
print MAIL "--------------------------------------------------------\n";
print MAIL "$MailBody\n";
print MAIL "--------------------------------------------------------\n";
close(MAIL);
}
#----------------#
# �C���[�W�\�� #
#----------------#
sub image {
&header;
print "<center><hr width=\"50%\">\n";
print "<big><b>���߁[���摜����Ղ�</b></big>\n";
print "<P>���ݓo�^����Ă��邢�߁[���摜�͈ȉ��̂Ƃ���ł�\n";
print "<hr width=\"50%\">\n";
print "<P><table border=1 cellpadding=5 cellspacing=0><tr>\n";
$i=0; $j=0;
$stop = @icon1;
foreach (0 .. $#icon1) {
$i++; $j++;
print "<td bgcolor=\"#ffffff\" ><img src=\"$imgurl\/$icon1[$_]\" ALIGN=middle> $icon2[$_]</td>\n";
if ($i >= 5) { print '</tr><tr>'; $i=0; }
if ($j eq "$stop") {
if ($i == 0) { last; }
while ($i < 5) { print "<td><br></td>"; $i++; }
}
}
print "</tr></table><br>\n";
print "<FORM><INPUT TYPE=\"button\" VALUE=\" CLOSE \" onClick=\"top.close();\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\"></FORM></center>\n";
print "</body></html>\n";
exit;
}
#--------------#
# ���������N #
#--------------#
sub auto_link {
$_[0] =~ s/([^=^\"]|^)(http\:[\w\.\~\-\/\?\&\=\@\;\#\:\%]+)/$1<a href=\"$2\" target='_top'>$2<\/a>/g;
}
#----------------#
# ���e�t�H�[�� #
#----------------#
sub form_view {
# �u���E�U����擾
&get_agent;
# �N�b�L�[����擾
&get_cookie;
print "<form action=\"$script\" method=\"$method\">\n";
if ($mode eq "res") {
print "<input type=hidden name=reno value=\"$_[0]\">\n";
}
print <<"EOM";
<DIV align="center">
<input type=hidden name=mode value="regist">
<TABLE width=400 height=270 border=2 bordercolor="#000000" bgcolor="#FFFFFF">
<TR><TD align="center" valign="center" colspan=10>
<TABLE width="95%" cellspacing=0 height="100%">
<tr>
<td align="right">Name<input type=text name=name size="$f_name" value="$c_name"></td>
</tr>
<tr>
<td align="right">Title<input type=text name=sub size="$f_sub" value="$res_sub"></td>
</tr>
<tr>
<td align="right">E-Mail<input type=text name=email size="$f_name" value="$c_email"></td>
</tr>
<tr>
<td align="right">Homepage<input type=text name=url size="$f_url" value="http://$c_url"></td>
</tr>
<tr>
<td align="right"><textarea name=comment cols="$f_cols" rows=5 wrap=soft></textarea></td>
</tr>
<tr>
<tr>
<td align="center"><a href="$script?mode=image" target="_blank">Avatar</a> <select name=icon>
EOM
# �C���[�W�̑I��t�H�[����\��
push(@icon1,"$mgr_icon");
push(@icon2,"$admin�p");
foreach (0 .. $#icon1) {
if ($icon1[$_] eq "$c_icon") {
print "<option value=\"$icon1[$_]\" selected>$icon2[$_]\n";
} else {
print "<option value=\"$icon1[$_]\">$icon2[$_]\n";
}
}
print <<"EOM";
</select> Pass<input type=password name=pwd size=6 maxlength=8 value="$c_pwd">
<small>Remeber?</small> <input type=checkbox name=cook value="on" checked></td>
</tr>
<tr>
<td>Color
EOM
if ($c_color eq "") { $c_color = $colors[0]; }
foreach (0 .. $#colors) {
if ($c_color eq "$colors[$_]") {
print "<input type=radio name=color value=\"$colors[$_]\" checked>";
print "<font color=\"$colors[$_]\">$c_m</font> \n";
}
else {
print "<input type=radio name=color value=\"$colors[$_]\">";
print "<font color=\"$colors[$_]\">$c_m</font> \n";
}
}
if ($_[0]) {
print "<input type=hidden name=no value=\"$_[0]\">\n";
}
print "</td></tr></table></td></tr></table><br>\n";
print "<input type=submit value=\"Post\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\"> <input type=reset value=\"Reset\" onMouseOver=\"this.style.background='$hlink_bgcolor'\" onMouseOut=\"this.style.background='$input_bgcolor'\"></div></form>\n";
}
## --- �J�E���^����
sub counter {
# �{�����̂݃J�E���g�A�b�v
$match=0;
if ($FORM{'mode'} eq '') {
# �J�E���^���b�N
if ($lockkey) { &lock3; }
$match=1;
}
# �J�E���g�t�@�C����ǂ݂���
open(NO,"$cntfile") || &error("Can't open $cntfile",'0');
$cnt = <NO>;
close(NO);
# �J�E���g�A�b�v
if ($match) { $cnt++; }
# �X�V
open(OUT,">$cntfile") || &error("Write Error : $cntfile");
print OUT $cnt;
close(OUT);
# �J�E���^���b�N��
if (-e $cntlock) { unlink($cntlock); }
# ��������
while(length($cnt) < $mini_fig) { $cnt = '0' . "$cnt"; }
@cnts = split(//,$cnt);
print "<DIV align=\"$cnt_pl\"><table><tr><td>\n";
# GIF�J�E���^�\��
if ($counter == 2) {
foreach (0 .. $#cnts) {
print "<img src=\"$gif_path/$cnts[$_]\.gif\" alt=\"$cnts[$_]\" width=\"$mini_w\" height=\"$mini_h\">";
}
# �e�L�X�g�J�E���^�\��
} else {
print "<font color=\"$cnt_color\" face=\"verdana,Times New Roman,Arial\">$cnt</font>";
}
print "</td></tr></table></DIV>\n";
}
## --- �J�E���^���b�N
sub lock3 {
$cnt_flag = 0;
foreach (1 .. 7) {
if (-e $cntlock) { sleep(1); }
else {
open(LOCK,">$cntlock");
close(LOCK);
$cnt_flag = 1;
last;
}
}
if (!$cnt_flag) { unlink($cntlock); }
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment