#!/usr/bin/perl #以上確實修改為Perl的實際路徑 #===================================================================== #版權聲明 (kenwubbs v1.0) # #本軟體為衣劍舞(http://www.kenwu.com)所撰寫 #雖然是屬於習作之類的程式，但也是本人心血結晶 #因此特作此版權說明，請大家遵守 # #本軟體為共享軟體（shareware)提供所有網站免費使用 #請勿非法轉載, 散播, 或用於其他圖利行為, 並請勿刪除版權聲明 # #衣劍舞 kenwus@yahoo.com #衣劍舞中文工坊 http://www.kenwu.com # #本軟體中，引用了Ray Chan先生Guest Book 98.1.0中分頁的寫法， #特將Ray Chan的版權聲明引述於下，以示尊重 ########################################################################### # Guest Book 98.1.0 Personal Version - Entry Processor # # [Eng/Unix/Perl5] # # Written by Ray Chan, 1998/07/12 # # Copyright 1997,1998 All Right Reserved. ########################################################################### $datafile="data.txt"; #data.txt的絕對路徑 $countfile="count.txt"; #count.txt的絕對路徑 $data_dir="./data"; #儲存討論資料檔案的目錄URL $data_path="./data"; #儲存討論資料檔案的目錄的絕對路徑 $cgiurl="http://www.mingtong.com.tw/cgi-bin/bbs/bbs.pl"; #bbs.pl完整的執行路徑 $homeurl="http://www.mingtong.com.tw/"; #首頁網址 $html="ON"; #是否允許使用HTML，ON為可以，OFF為不可以，請注意要大寫 $allow_img="ON"; #貼圖開關，ON為開，OFF圍觀，請注意要大寫 $entryno="10"; #每頁主題數 $time_miss="+12"; #調整時差，若比本地慢12小時，則輸入+12，若比本地快12小時，則輸入-12 $title="名堂才藝坊【學生討論區】"; #留言板標題 $manageid="0901jk"; #管理ID $managepass="0901jk"; #管理密碼 $titlegif="http://www.mingtong.com.tw/art/news/gif/logo-1.gif"; #留言板LOGO的連結URL，也可不填 $backgif="http://www.mingtong.com.tw/art"; #留言板背景圖的連結URL，也可不填 $bgcolor="#CCFF99"; #留言板背景色 $text="#FF9900"; #留言板文字色 $link="0000ff"; #留言板連結文字色 $alink="ff0000"; #留言板按下連結文字色 $vlink="008080"; #留言板已連結文字色 $newcolor="ff0000"; #New字的顏色 $upcolor="008000"; #up字的顏色 $boycolor="d000d0"; #作者為男性時的字色 $girlcolor="d05050"; #作者為女性時的字色 $username_leng="15"; #姓名欄輸入最大字元,一中文字等於兩字元 $subject_leng="30"; #主題欄輸入最大字元,一中文字等於兩字元 ############讀取輸入資料########## #$|=1; if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $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 if ($html eq "OFF"); $value =~ s/; close (BBS); $count=0; @lines = reverse @display; foreach (@lines){ ($mark,$subject,$username,$useremail,$userurl,$usersex,$userip,$chktime,$chkfilename,$replytime,$replytotle)=split(/∥/); if ($mark =~ /BBSmark/){ $count++; } } $no=$count+1; ###########計算分頁######### $maxpage=int($count/$entryno); if ($count/$entryno != int($count/$entryno)){ $maxpage++; } if ($maxpage < 1){ $maxpage=1; } ############討論區主頁########### print<$title EOF &header; print<

選擇搜尋目標:
請輸入關鍵字:

人氣指數: EOF #######計算人氣######## open(COUNT,"$countfile"); @counters=; close(COUNT); foreach (@counters) { ($lastip,$counter)=split("∥"); if ($ENV{'REMOTE_ADDR'} ne $lastip) { $counter++; open(COUNT,">$countfile"); #flock(COUNT,2); print COUNT "$ENV{'REMOTE_ADDR'}∥$counter\n"; #flock(COUNT,8); close(COUNT); print "$counter\n"; } else { print "$counter"; } } ########主畫面及計算分頁########## print<

HTML開關: $html

貼圖開關: $allow_img

主題總數: $count

符號說明：

1.New表示為今日新發表主題
2.Up表示為今日有新的回應文章

EOF $temp=0; $stop=0; $more=0; $flag=0; $con=0; if ($page eq ""){ $min=0; $max=$entryno; } if ($page ne ""){ $min=(($page-1)*$entryno)+1; $max=$page*$entryno; } foreach (@lines){ if ($stop == 1){ $more=1; break; } if ($mark eq "BBSmark"){ $no--; if ($temp >=$min -1 && $temp <=$max -1){ ($mark,$subject,$username,$useremail,$userurl,$usersex,$userip,$chktime,$chkfilename,$replytime,$replytotle)=split(/∥/); $sexcolor=$boycolor if ($usersex eq "m"); $sexcolor=$girlcolor if ($usersex eq "w"); print "\n"; print "\n"; print "\n"; print "\n"; print "" if ($replytime ne ""); print "" if ($replytime eq ""); print "\n"; $flag=1; } } $temp++; if ($temp >= $max){ $stop=1; } } if ($flag == 0){ print< EOF $con=1; } print "

編號	主題	作者	回應	最後回應時間
$no	$subject"; print "New!" if ($chktime =~ /$date/); print "Up!" if ($replytime =~ /$date/); print "	"; print "" if ($useremail ne ""); print "$username"; print "\n" if ($useremail ne ""); print "	$replytotle	$replytime	$chktime
\ \; 對不起！目前沒有任何文章 \ \;

\n"; if ($con==0){ if ($page eq ""){ &bar(1,$maxpage); }else{ &bar($page,$maxpage); } } print<

管理ID:
管理密碼:

EOF &footer; ##########設定分頁連結以及每十頁成一單位####### sub bar{ local ($i)=0; $curr_page=$_[0]; $max_page=$_[1]; $first=int($curr_page/10)*10+1; $last=$first+9; if ($curr_page < $first){ $first=$first-10; $last=$last-10; } if ($last > $max_page){ $last=$max_page; } print "

["; if ($first > 1){ $prev_page=$first-1; $pi=$prev_page-9; print<$pi - $prev_page | EOF } for($i=$first;$i<=$last;$i++){ if ($i != $curr_page){ print<$i EOF }else{ print " $i "; } if ($i<$last){ print "|"; } } if ($last < $max_page){ $next_page=$last+1; $pi = $next_page+9; print<$next_page - $pi EOF } print "]"; } ###########留言表格######## sub post { print< $title EOF &header; print<

姓名:
E-Mail:
首頁:
性別:	男生女生
主題:
發表內容:

EOF &footer; } #########新主題寫入資料檔######### sub add { $KENWU{'username'} =~ s/∥//; $KENWU{'useremail'} =~ s/∥//; $KENWU{'userurl'} =~ s/∥//; $KENWU{'subject'} =~ s/∥//; &error("請回上頁填寫姓名欄") if ($KENWU{'username'} eq ""); &error("請回上頁填寫文章主題") if ($KENWU{'subject'} eq ""); &error("請回上頁填寫文章內容") if ($KENWU{'comments'} eq ""); if ($KENWU{'useremail'} ne "") { &error("E-MAIL不正確") unless ($KENWU{'useremail'} =~ /.*\@.*\..*/); } if ($KENWU{'userurl'} eq "http://") { $KENWU{'userurl'}=""; } if ($KENWU{'userurl'} ne "") { &error("網址不正確") if ($KENWU{'userurl'} !~ /^http:\/\/[\w\W]+\.[\w\W]+$/); } &error("標題不得超過$subject_leng字元，一個中文字等於2字元") if (length($KENWU{'subject'}) > $subject_leng); &error("標題不得少於2字元，一個中文字等於2字元") if (length($KENWU{'subject'}) < 2); &error("姓名不得超過$username_leng字元，一個中文字等於2字元") if (length($KENWU{'username'}) > $username_leng); &error("姓名不得少於2字元，一個中文字等於2字元") if (length($KENWU{'username'}) < 2); $KENWU{'comments'} =~ s/\cM\n/
/g; open(DATA,">>$datafile"); #flock(DATA,2); print DATA "BBSmark∥$KENWU{'subject'}∥$KENWU{'username'}∥$KENWU{'useremail'}∥$KENWU{'userurl'}∥$KENWU{'usersex'}∥$ENV{'REMOTE_ADDR'}∥$time∥$filename∥∥0\n"; #flock(DATA,8); close(DATA); open(BBS,">$data_path/$filename\.htm"); print BBS "$title\n"; print BBS "\n"; print BBS "\n" if ($backgif eq ""); print BBS "\n" if ($backgif ne ""); print BBS<

$title

$subject

[回應本文|張貼文章|回$title|回首頁]

EOF $sexcolor=$boycolor if ($KENWU{'usersex'} eq "m"); $sexcolor=$girlcolor if ($KENWU{'usersex'} eq "w"); print BBS "\n" if ($KENWU{'useremail'} ne ""); print BBS "\n" if ($KENWU{'useremail'} eq ""); if ($KENWU{'userurl'} ne "") { print BBS "\n"; print BBS "\n"; } print BBS<

文章主題:	$KENWU{'subject'}
發表時間:	$time
發表作者:	$KENWU{'username'}
$KENWU{'username'}
作者首頁:	$KENWU{'userurl'}
發表內容:	$KENWU{'comments'} $ENV{'REMOTE_ADDR'}

回應本文

EOF close(BBS); chmod (0666,"$data_path/$filename\.htm"); &success("發表完成，轉送回討論區中..."); } ############執行搜尋功能########### sub srch { &error("請選擇搜尋目標") if ($KENWU{'srh'} eq ""); &error("請輸入關鍵字") if ($KENWU{'keyword'} eq ""); print<$title EOF &header; print<

選擇搜尋目標:
請輸入關鍵字:

查詢關鍵字"$KENWU{'keyword'}"的結果：

EOF open (DATA, $datafile); @display=; close (DATA); $keywords = quotemeta $KENWU{'keyword'}; $num=0; @lines = reverse @display; foreach (@lines) { ($mark,$subject,$username,$useremail,$userurl,$usersex,$userip,$chktime,$chkfilename,$replytime,$replytotle)=split(/∥/); if ($mark eq "BBSmark") { if (($KENWU{'srh'} eq "srhname") && ($username =~ /$keywords/i)) { $match=1; &list; } if (($KENWU{'srh'} eq "srhsubject") && ($subject =~ /$keywords/i)) { $match=1; &list; } } } if (!$match) { print "\n"; } print "

編號	主題	作者	回應	最後回應時間
\ \; 對不起，找不到您要的資料！ \ \;

\n"; &footer; } #############搜尋結果顯示########## sub list { $num++; $sexcolor=$boycolor if ($usersex eq "m"); $sexcolor=$girlcolor if ($usersex eq "w"); print "$num\n"; print "$subject"; print "New!" if ($chktime =~ /$date/); print "Up!" if ($replytime =~ /$date/); print "\n"; print ""; print "" if ($useremail ne ""); print "$username"; print "\n" if ($useremail ne ""); print "\n"; print "$replytotle\n"; print ""; print "$replytime" if ($replytime ne ""); print "$chktime" if ($replytime eq ""); print "\n"; } ##########刪除文章############## sub delete { &error("您至少要選一篇要刪除的文章") if ($KENWU{'delmark'} eq ""); if (($KENWU{'id'} eq $manageid) && ($KENWU{'pwd'} eq $managepass)) { open (DATA, $datafile); @lines=; close (DATA); $num=0; open (DATA, ">$datafile"); foreach (@lines) { ($mark,$subject,$username,$useremail,$userurl,$usersex,$userip,$chktime,$chkfilename,$replytime,$replytotle)=split(/∥/); $del=0; foreach $delete (@delete) { if ($chkfilename eq $delete) { $del=1; last; } } if ($del==1) { print DATA ""; unlink ("$data_path/$chkfilename\.htm"); } else { print DATA "$_"; } } } else { &error("錯誤的ID及密碼組合"); } &success("刪除動作完成，轉送回$title"); } ##########回應寫入資料檔############## sub reply { &error("請回上頁填寫姓名欄") if ($KENWU{'username'} eq ""); &error("請回上頁填寫文章內容") if ($KENWU{'comments'} eq ""); &error("姓名不得超過$username_leng字元，一個中文字等於2字元") if (length($KENWU{'username'}) > $username_leng); &error("姓名不得少於2字元，一個中文字等於2字元") if (length($KENWU{'username'}) < 2); if ($KENWU{'userurl'} eq "http://") { $KENWU{'userurl'}=""; } if ($KENWU{'useremail'} ne "") { &error("E-MAIL不正確") unless ($KENWU{'useremail'} =~ /.*\@.*\..*/); } if ($KENWU{'userurl'} ne "") { &error("網址不正確") if ($KENWU{'userurl'} !~ /^http:\/\/[\w\W]+\.[\w\W]+$/); } $KENWU{'comments'} =~ s/\cM\n/
/g; open (DATA, $datafile); @lines=; close (DATA); open (DATA,">$datafile"); foreach (@lines) { ($mark,$subject,$username,$useremail,$userurl,$usersex,$userip,$chktime,$chkfilename,$replytime,$replytotle)=split(/∥/); if ($mark eq "BBSmark") { if ($KENWU{'replymark'} eq $chkfilename) { $replytotle++; print DATA "$mark∥$subject∥$username∥$useremail∥$userurl∥$usersex∥$userip∥$chktime∥$chkfilename∥$time∥$replytotle\n"; &reply_add; } else {print DATA "$_";} } else {&error("無標記");} } close (DATA); &success("回覆文章張貼完成"); } ###############回應文章寫入HTML############ sub reply_add { open (BBS,"$data_path/$chkfilename\.htm"); @reply = ; close(BBS); open(BBS,">$data_path/$chkfilename\.htm"); foreach $reply_line (@reply) { if ($reply_line =~ //) { print BBS "

\n"; print BBS "\n"; print BBS "\n"; print BBS "\n"; print BBS "\n"; $sexcolor=$boycolor if ($KENWU{'usersex'} eq "m"); $sexcolor=$girlcolor if ($KENWU{'usersex'} eq "w"); print BBS "\n" if ($KENWU{'useremail'} ne ""); print BBS "\n" if ($KENWU{'useremail'} eq ""); if ($KENWU{'userurl'} ne "") { print BBS "\n"; print BBS "\n"; } print BBS "\n"; print BBS "

發表時間:	$time
發表作者:	$KENWU{'username'}
$KENWU{'username'}
作者首頁:	$KENWU{'userurl'}
發表內容:	$KENWU{'comments'} \n"; print BBS " $ENV{'REMOTE_ADDR'}

\n"; print BBS "

\n"; print BBS "\n"; } else { print BBS "$reply_line"; } } close(BBS); } ##########各顯示介面之最上方HTML碼######## sub header { if ($backgif ne "") { print< EOF } else { print< EOF } if ($titlegif ne "") { print< $title

EOF } else { print<

$title

EOF } print<[\n張貼文章 |\n回$title |\n回到首頁\n]

EOF } #########各顯示介面最下方HTML碼，請勿刪除######## sub footer { print<

EOF } ########錯誤畫面########## sub error { &header; print $_[0]; &footer; exit; } #######成功畫面######### sub success { print<$title EOF &header; print $_[0]; &footer; exit; } #########結束#########