#! /usr/local/bin/perl
# ＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃
# /////apeboard+ for webmaster Ver.1.02 (Shift_JIS)/////
# Copyright (C) 2000,by 2apes.com
# All rights reserved
# Script written by Taishi Yokoyama
# web site : http://www.2apes.com
# e-mail : support@2apes.com
# Script 翻譯 by 老婆的窩
# web site: http://www.bestsystemsdirect.com/loupou/
# e-mail: lou_pou@hotmail.com
# ＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃
################# 請勿修改此檔 ######################
#require './jcode.pl';
require './boardini.cgi';
require './skinini.cgi';
# End of the setting ----------------------------------------------------------------
# -------------------------------------------------------------------------
# Do not modify here
# -------------------------------------------------------------------------
&form_decord;
&get_cookie($mt_cookiename);
$ck_pwd = $cookie{'pwd'};
$command = $FORMDATA{'command'};
$tgtid = $FORMDATA{'target'};
$pwd = $FORMDATA{'pwd'};
$msgnum = $FORMDATA{'msgnum'};
$old_pwd = $FORMDATA{'old_pwd'};
$new_pwd = $FORMDATA{'new_pwd'};
$cknew_pwd=$FORMDATA{'cknew_pwd'};
if ($msgnum eq ''){
$msgnum = 0;
}
if ($command eq 'read' || $command eq 'f_read'){
&read_mes_res;
} elsif ($command eq 'res_mes'){
&res_message;
&read_mes_res;
} elsif ($command eq 'remove'){
&remove_message;
&read_mes_res;
} elsif ($command eq 'cg_mtpwd'){
&shw_chpwd;
} elsif ($command eq 'cg_and_ck'){
&check_change;
&mt_login;
} else {
&mt_login;
}
exit(0);
# -------------------------------------------------------------------------
# ???????????????????????
# -------------------------------------------------------------------------
sub form_decord{
local($query,@assocarray,$assoc,$property,$value);
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
} else {
$query= $ENV{'QUERY_STRING'};
}
@assocarray = split(/&/, $query);
foreach (@assocarray) {
($property, $value) = split(/=/);
$value =~ tr/+/ /;
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;
$value =~ s/\r\n/\r/g;
$value =~ s/\n/\r/g;
$value =~ s/ \r \r//g;
$value =~ s/\ \r\ \r//g;
$value =~ s/ \r/\r/g;
$value =~ s/\ \r/\r/g;
$value =~ s/\r\r\r\r//g;
$value =~ s/&/&/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/,/\0/g;
if ($tagset eq 'off') {
$value =~ s/"/"/g;
}
# jcode.pl ???文字?????換 -------------------------------
#&jcode'convert(*value,'sjis');
#&jcode'h2z_sjis(*value);
# ?????格納 ------------------------------------------------
if ($property eq 'target'){
push(@RM,$value);
} else {
$FORMDATA{$property} = $value;
}
}
}
# -------------------------------------------------------------------------
# ??用??????入力?面?表示
# -------------------------------------------------------------------------
sub read_mes_res {
# ???????????? --------------------------------------
&lock_open(TXT, "+<$datafile");
@txt = <TXT>;
&unlock_close(TXT);
($encoded_pass) = splice(@txt, 0, 1);
chop($encoded_pass);
if ($command ne 'f_read') {
&get_cookie($mt_cookiename);
$pwd = $cookie{'pwd'};
}
if ($encoded_pass eq '' || &mismatch_password($pwd, $encoded_pass)) {
&print_error("Incorrect password, please try again.");
}
# ??????調?? --------------------------------------------
$volume = scalar(@txt);
# 表示範??設定 ------------------------------------------------
$msgstart = $msgnum;
if ($msgstart < 0) {
$msgstart = 0;
}
$msgend = $msgnum + $data_out;
if ($msgend > $volume) {
$msgend = $volume;
}
# ?面?表示??前?設定 ----------------------------------------
if ($command eq 'f_read') {
undef %cookie;
$cookie{'pwd'} = $pwd;
&print_cookie($mt_cookiename, 1);
}
print "Content-type: text/html; charset=big5\n\n";
# ???部分?作成??換 ----------------------------------------
print "<html>\n";
print "<head>\n";
print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=big5\">\n";
print "<title>管理者頁面</title>\n";
print "</head>\n";
print "<body>\n";
print "<center>\n";
print " <br>\n";
print "<b><font size=\"6\" face=\"Arial,Helvetica\">管理者頁面</font></b><br>\n";
print "<form method=\"post\" action=\"$masterurl\">\n";
print "此頁面為管理者頁面 <br>，非管理者請離開。<br>\n";
print "<br>\n";
print "<br>\n";
print "<a href=\"$bbsurl\">回初始頁面</a><br><br>\n";
# 投稿?表示 ----------------------------------------------------
for ($i = $msgstart; $i < $msgend; $i++) {
($dispid,$dispname,$dispicon,$dispmail,$dispurl,$dispdate,$disppwd,$dispsubject,$dispmsg,$disphost,$dispres) = split(/,/, $txt[$i]);
$dispname =~ s/\0/,/g;
$dispicon =~ s/\0/,/g;
$dispmail =~ s/\0/,/g;
$dispurl =~ s/\0/,/g;
$disppwd =~ s/\0/,/g;
$dispsubject =~ s/\0/,/g;
$dispmsg =~ s/\0/,/g;
$disphost=~ s/\0/,/g;
$dispres =~ s/\0/,/g;
chomp($dispres);
$dat_tmp = $dateline;
($d_year,$d_mon,$d_day,$d_weekstr,$d_hour,$d_min) = split(/&/, $dispdate);
if ($addzero_md eq 'on') {
if ($d_mon < 10) {
$d_mon = "0$d_mon";
}
if ($d_day <10) {
$d_day = "0$d_day";
}
if ($d_hour < 10) {
$d_hour = "0$d_hour";
}
if ($d_min < 10) {
$d_min = "0$d_min";
}
}
$dat_tmp =~ s/year/$d_year/i;
$dat_tmp =~ s/month/$d_mon/i;
$dat_tmp =~ s/day/$d_day/i;
$dat_tmp =~ s/week/$d_weekstr/i;
$dat_tmp =~ s/hour/$d_hour/i;
$dat_tmp =~ s/minute/$d_min/i;
# 名前??????????????? ----------------------------
if($dispmail ne '') {
$dispname = '<a href="mailto:' . $dispmail . '">' . $dispname . '</a>';
}
# URL??????? ---------------------------------------------
if($dispurl ne '') {
$dispurl = '- <a href="' . $dispurl . '" TARGET="_blank">' - Website - '</a>';
}
# ???部分?作成（親部分） ------------------------------------
print "<table width=\"500\" border=\"0\" bgcolor=\"#FFFFFF\" cellpadding=\"5\" cellspacing=\"1\">\n";
print "<tr>\n";
print "<td bgcolor=\"#666666\" width=\"40\" align=\"center\" nowrap>\n";
print "<input type=\"checkbox\" name=\"target\" value=\"$dispid\">\n";
print "</td>\n";
print "<td bgcolor=\"#CCCCCC\" width=\"458\">[$dispid] <b>$dispsubject </b></td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td valign=\"top\" align=\"center\" bgcolor=\"#666666\" width=\"40\" nowrap><font color=\"#FFFFFF\">內容</font></td>\n";
print "<td bgcolor=\"#CCCCCC\" width=\"458\">\n";
print "<font size=\"2\"><font color=\"#CCOOOO\"><$dat_tmp></font>[$disphost]</font> <br>\n";
print "<b>$dispsubject</b> by $dispname $dispurl<br>\n";
print "<p>$dispmsg</p>\n";
print "</blockquote>\n";
# ???部分?作成（子部分） ------------------
open(RES, $res_file) || &print_error('Unable to open the reply.');
$reshtml = join('',<RES>);
close(RES);
@part_res = split(/:&:/, $dispres);
$res_volume = scalar(@part_res);
for ($j = 0; $j < $res_volume; $j++) {
($dresnum,$dresname,$dresicon,$dresmail,$dresurl,$dresdate,$drespwd,$dressubject,$dresmsg,$dreshost) = split(/<>/, $part_res[$j]);
$res_dat_tmp = $dateline;
($dres_year,$dres_mon,$dres_day,$dres_weekstr,$dres_hour,$dres_min) = split(/&/, $dresdate);
if ($addzero_md eq 'on') {
if ($dres_mon < 10) {
$dres_mon = "0$dres_mon";
}
if ($dres_day <10) {
$dres_day = "0$dres_day";
}
}
if($addzero_hm eq 'on') {
if ($dres_hour < 10) {
$dres_hour = "0$dres_hour";
}
if ($dres_min < 10) {
$dres_min = "0$dres_min";
}
}
$res_dat_tmp =~ s/year/$dres_year/i;
$res_dat_tmp =~ s/month/$dres_mon/i;
$res_dat_tmp =~ s/day/$dres_day/i;
$res_dat_tmp =~ s/week/$dres_weekstr/i;
$res_dat_tmp =~ s/hour/$dres_hour/i;
$res_dat_tmp =~ s/minute/$dres_min/i;
# 名前??????????????? ----------------------------
if($dresmail ne '') {
$dresname = '<a href="mailto:' . $dresmail . '">' . $dresname . '</a>';
};
# URL??????? ---------------------------------------------
if($dresurl ne '') {
$dresurl = '- <a href="' . $dresurl . '" TARGET="_blank">' - Website - '</a>';
}
print "<hr width=\"96%\">\n";
print " <font size=\"2\"><font color=\"#CCOOOO\"><$res_dat_tmp></font>[$dreshost]<input type=\"checkbox\" name=\"target\" value=\"$dresnum\">＝刪除用＝</font> <br>\n";
print " <b>$dressubject</b> by $dresname $dresurl<br>\n";
print "<blockquote>\n";
print "<p>$dresmsg</p>\n";
print "</blockquote>\n";
}
if ($reshtml =~ /ressubject<!--s-->/i){
print "</td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td valign=\"top\" align=\"center\" bgcolor=\"#666666\" width=\"40\"><font color=\"#FFFFFF\">標題</font></td>\n";
print "<td bgcolor=\"#CCCCCC\" width=\"458\">\n";
print "<input type=\"text\" name=\"subject$dispid\" size=\"30\">\n";
}
print "</td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td valign=\"top\" align=\"center\" bgcolor=\"#666666\" width=\"40\" nowrap><font color=\"#FFFFFF\">回覆</font></td>\n";
print "<td bgcolor=\"#CCCCCC\" width=\"458\">\n";
print "<textarea name=\"resp$dispid\" cols=\"60\" rows=\"4\"></textarea>\n";
print "</td>\n";
print "</tr>\n";
print "</table><br>\n";
}
# ????作成?文字列??換 ------------------------------------
$nextmsg = $msgend ;
print "<table width=\"500\" border=\"0\" bgcolor=\"#666666\" cellpadding=\"5\">\n";
print "<tr align=\"center\">\n";
print "<td>\n";
print "<select name=\"command\">\n";
print "<option value=\"res_mes\" selected>回覆</option>\n";
print "<option value=\"remove\">刪除</option>\n";
print "<option value=\"cg_mtpwd\">變更管理密碼</option>\n";
print "</select>\n";
print "<input type=\"submit\" name=\"submit\" value=\"寄出\">\n";
print "</td>\n";
print "</tr>\n";
print "</table>\n";
print "</form>\n";
print "<table width=\"500\" border=\"0\">";
print "<tr>\n";
print "<td><a href=\"$masterurl?command=read\"><font face=\"Arial,Helvetica\" size=\"4\"><B>< 新訊息</b></font></a></td>\n";
if ($data_out + $msgnum + 1 > $volume) {
print "<td align=\"right\"><font size=\"5\"> </font><td>\n";
} else {
print "<td align=\"right\"><a href=\"$masterurl?command=read&msgnum=$nextmsg\"><font face=\"Arial,Helvetica\" size=\"4\"><b>舊訊息 ></b></font></a><td>\n";
}
print "</tr>\n";
print "</table>\n";
print "</center>\n";
print "<p> </p>\n";
print "</body>\n";
print "</html>\n";
exit(0);
}
# -------------------------------------------------------------------------
# ???????????書?????????
# -------------------------------------------------------------------------
sub res_message {
if (!@RM) {
&print_error('請先選擇檔案');
}
# ???????????? --------------------------------------
&get_cookie($mt_cookiename);
$ck_pwd = $cookie{'pwd'};
&lock_open(TXT, "+<$datafile");
@txt = <TXT>;
($encoded_pass) = splice(@txt, 0, 1);
chop($encoded_pass);
if (&mismatch_password($ck_pwd, $encoded_pass)) {
&unlock_close(TXT);
&print_error("密碼有效期已過,<br> 請重新登入");
}
# ????象???投稿?決定 ------------------------------------
@tmp = @RM;
foreach $tgtid(@tmp){
if ($tgtid =~ /_/i){
&print_error("請指定訊息以便回覆");
}
$index = &find_msg;
if ($index < 0) {
&unlock_close(TXT);
&print_error("這個檔案不存在");
}
($dispid,$dispname,$dispicon,$dispmail,$dispurl,$dispdate,$disppwd,$dispsubject,$dispmsg,$disphost,$dispres) = split(/,/, $txt[$index]);
chomp($dispres);
# ???????整?? ------------------------------------------
$respnum = 'resp' . "$dispid";
$subjnum = 'subject' . "$dispid";
$resp = $FORMDATA{"$respnum"};
$r_subj=$FORMDATA{"$subjnum"};
$resp =~ s/\r/<br>/g;
# ???使用不可?場合（URL ???????） --------------------
if ($tagset eq 'off') {
if ($autolink ne '') {
$resp =~ s/(http:\/\/[\w\.\/\~\-\+\=\#\%\&\?\(\)]+)/<a href="$1" target="_blank">$autolink<\/a>/ig;
} else {
$resp =~ s/(http:\/\/[\w\.\/\~\-\+\=\#\%\&\?\(\)]+)/<a href="$1" target="_blank">$1<\/a>/ig;
}
}
# ???使用可?場合?各?理 ------------------------------------
if ($tagset eq 'on') {
$resp =~ s/(<[^&]*)<br>([^&]*>)/$1$2/gi;
if ($tagimg eq 'on') {
$resp =~ s/(<(img([^&]+))>)/$1<img$3>/gi;
}
$resp .= "</a>" x (
($resp =~ s/(<(a href=([^&]+))>)/<a href=$3>/gi)
- ($resp =~ s/<\/a>/<\/a>/gi)
);
if ($tagfnt eq 'on') {
$resp .= "</font>" x (
($resp =~ s/(<(font([^&]*))>)/<font$3>/gi)
- ($resp =~ s/<\/font>/<\/font>/gi)
);
}
$resp .= "</b>" x (
($resp =~ s/<b>/<b>/gi)
- ($resp =~ s/<\/b>/<\/b>/gi)
);
$resp .= "</i>" x (
($resp =~ s/<i>/<i>/gi)
- ($resp =~ s/<\/i>/<\/i>/gi)
);
$resp =~ s/("[^ "<>]+)>/$1">/gi;
}
# 作業?分岐 ----------------------------------------------------
@part_res = split(/:&:/, $dispres);
# 日付?取得 ----------------------------------------------------
$datestr = &get_date_string;
# 記事番??設定 ------------------------------------------------
$id = 1;
for ($i = 0; $i < @part_res; $i++) {
($thisid) = split(/<>/, $part_res[$i]);
($pnum,$cnum) = split(/_/,$thisid);
if ($cnum >= $id) {
$id = $cnum + 1;
}
}
$id = "$dispid" . '_' . "$id";
# host 情報?取得 -----------------------------------------------
$host = $ENV{'REMOTE_HOST'};
$addr = $ENV{'REMOTE_ADDR'};
if ($host eq $addr) {
$host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr;
}
# 書???情報?整列 --------------------------------------------
$oneline = "$dispid,$dispname,$dispicon,$dispmail,$dispurl,$dispdate,$disppwd,$dispsubject,$dispmsg,$disphost,$dispres$id<>$master_name<>master<>$admin<>$indexurl<>$datestr<>$ckpwd<>$r_subj<>$resp<>$host:&:\n";
if ($res_sort eq 'on'){
splice(@txt, $index, 1);
seek(TXT, 0, 0);
print TXT "$encoded_pass\n";
unshift(@txt, $oneline);
} else {
splice(@txt, $index, 1, $oneline);
seek(TXT, 0, 0);
print TXT "$encoded_pass\n";
}
} print TXT @txt;
&unlock_close(TXT);
}
# -------------------------------------------------------------------------
# ??????削除????????
# -------------------------------------------------------------------------
sub remove_message {
if (!@RM) {
&print_error('Please select the file first.');
}
&get_cookie($mt_cookiename);
$ck_pwd = $cookie{'pwd'};
&lock_open(TXT, "+<$datafile");
@txt = <TXT>;
($encoded_pass) = splice(@txt, 0, 1);
chop($encoded_pass);
if (&mismatch_password($ck_pwd, $encoded_pass)) {
&unlock_close(TXT);
&print_error("密碼有效期已過,<br> 請重新登入");
}
@tmp = @RM;
foreach $tgtid(@tmp){
if ($tgtid =~ m/\d+_\d+/) {
($pnum,$cnum) = split (/_/, $tgtid);
$tgtid = $pnum;
}
$index = &find_msg;
if ($index < 0) {
&unlock_close(TXT);
&print_error("這個檔案不存在");
}
($dispid,$dispname,$dispicon,$dispmail,$dispurl,$dispdate,$disppwd,$dispsubject,$dispmsg,$disphost,$dispres) = split(/,/, $txt[$index]);
if ($cnum) {
$tgtrsid = "$tgtid" . '_' ."$cnum";
chomp($dispres);
@part_res = split(/:&:/, $dispres);
for ($i = 0; $i < @part_res; $i++) {
($dresnum,$dresname,$dresicon,$dresmail,$dresurl,$dresdate,$drespwd,$dressubject,$dresmsg,$dreshost) = split(/<>/, $part_res[$i]);
if ($tgtrsid eq $dresnum) {
splice(@part_res, $i, 1);
$dispres = join(':&:',@part_res);
$oneline = "$dispid,$dispname,$dispicon,$dispmail,$dispurl,$dispdate,$disppwd,$dispsubject,$dispmsg,$dreshost,$dispres:&:\n";
$oneline =~ s/,:&:/,/i;
splice(@txt, $index, 1, $oneline);
last;
}
}
} else {
splice(@txt, $index, 1);
}
}
unshift(@txt, ("$encoded_pass\n"));
seek(TXT, 0, 0);
print TXT @txt;
truncate(TXT, tell(TXT));
&unlock_close(TXT);
}
# -------------------------------------------------------------------------
# 管理者用?????入力?面?表示
# -------------------------------------------------------------------------
sub mt_login {
print "Content-type: text/html; charset=big5\n";
print "\n";
print "<html>\n";
print "<head>\n";
print "<title>apeboard for webmaster</title>\n";
print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=big5\">\n";
print "</head>\n";
print "<body bgcolor=\"#FFFFFF\" text=\"#003366\">\n";
print "<div align=\"center\">\n";
print "<table width=\"90%\" height=\"90%\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\">\n";
print "<tr>\n";
print "<td align=\"center\">\n";
print "<form method=\"post\" action=\"$masterurl\">\n";
print "<input type=\"hidden\" name=\"command\" value=\"f_read\">\n";
print "<b><font size=\"4\" color=\"#CC0000\" face=\"Arial,Helvetica\">++管理頁面++</font></b><br><br>\n";
print "請輸入管理密碼<br><br>\n";
print "<input type=\"password\" name=\"pwd\" size=\"10\"> ";
print "<input type=\"submit\" name=\"submit\" value=\"登入\">\n";
print "</form>";
print "</td>\n";
print "</tr>\n";
print "</table><br><br>\n";
print "</div>\n";
print "</body>\n";
print "</html>\n";
exit(0);
}
# -------------------------------------------------------------------------
# 管理者用??????更?面?表示
# -------------------------------------------------------------------------
sub shw_chpwd {
print "Content-type: text/html; charset=big5\n";
print "\n";
print "<html>\n";
print "<head>\n";
print "<title>apeboard for webmaster</title>\n";
print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=big5\">\n";
print "</head>\n";
print "<body bgcolor=\"#FFFFFF\" text=\"#003366\">\n";
print "<div align=\"center\">\n";
print "<table width=\"90%\" height=\"90%\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\">\n";
print "<tr>\n";
print "<td align=\"center\">\n";
print "<form method=\"post\" action=\"$masterurl\">\n";
print "<input type=\"hidden\" name=\"command\" value=\"cg_and_ck\">\n";
print "<b><font size=\"4\" color=\"#CC0000\" face=\"Arial,Helvetica\">++管理頁面++</font></b><br><br>\n";
print "密碼為4-8英文字母或數字<br><br>\n";
print "目前的管理密碼：\n";
print "<input type=\"password\" name=\"old_pwd\" size=\"10\"><br><br>";
print "更新後的管理密碼：\n";
print "<input type=\"password\" name=\"new_pwd\" size=\"10\"><br><br>";
print "確認<br><br>\n";
print "新的管理密碼：\n";
print "<input type=\"password\" name=\"cknew_pwd\" size=\"10\"><br><br>";
print "<input type=\"submit\" name=\"submit\" value=\"確定\">\n";
print "</form>";
print "</td>\n";
print "</tr>\n";
print "</table><br><br>\n";
print "</div>\n";
print "</body>\n";
print "</html>\n";
exit(0);
}
# -------------------------------------------------------------------------
# 管理者用????????????更
# -------------------------------------------------------------------------
sub check_change {
&lock_open(TXT, "+<$datafile");
@txt = <TXT>;
($encoded_pass) = splice(@txt, 0, 1);
chop($encoded_pass);
if ($encoded_pass eq '' || &mismatch_password($old_pwd, $encoded_pass)) {
&unlock_close(TXT);
&print_error("密碼錯誤");
}
if ($new_pwd ne $cknew_pwd) {
&unlock_close(TXT);
&print_error('新密碼要跟確認的密碼相同');
}
if ($new_pwd eq '' || length($new_pwd) < 4) {
&unlock_close(TXT);
&print_error('密碼設定錯誤');
}
$encmaster = &encode_pwd($new_pwd);
seek(TXT, 0, 0);
print TXT "$encmaster\n";
&unlock_close(TXT);
print "Content-type: text/html; charset=big5\n";
print "\n";
print "<html>\n";
print "<head>\n";
print "<title>++完成更動++</title>\n";
print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=big5\">\n";
print "</head>\n";
print "<body bgcolor=\"#FFFFFF\" text=\"#003366\">\n";
print "<div align=\"center\">\n";
print "<table width=\"90%\" height=\"90%\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\">\n";
print "<tr>\n";
print "<td align=\"center\">\n";
print "<form method=\"post\" action=\"$masterurl\">\n";
print "<input type=\"hidden\" name=\"command\" value=\"f_read\">\n";
print "<b><font size=\"4\" color=\"#0000CC\" face=\"Arial,Helvetica\">密碼已變動</font></b><br><br>\n";
print "管理密碼已更改,<br>\n";
print "請以新密碼重新登入<br><br>\n";
print "<input type=\"password\" name=\"密碼\" size=\"10\"> ";
print "<input type=\"submit\" name=\"確定\" value=\"登入\">\n";
print "</form>";
print "</td>\n";
print "</tr>\n";
print "</table><br><br>\n";
print "</div>\n";
print "</body>\n";
print "</html>\n";
exit(0);
}
# -------------------------------------------------------------------------
# ??????探???????
# -------------------------------------------------------------------------
sub find_msg {
local($i, $foundindex, $dispid);
$foundindex = -1;
for ($i = 0; $i < @txt; $i++) {
($dispid) = split(/,/, $txt[$i]);
if ($tgtid == $dispid) {
$foundindex = $i;
last;
}
}
return $foundindex;
}
# -------------------------------------------------------------------------
# ??????????????
# -------------------------------------------------------------------------
sub lock_open {
local(*FILE, $lk_name) = @_;
if (!open(FILE, $lk_name)) {
&print_error("Unable to open $lk_name");
}
if ($lock) {
eval("flock(FILE, 2)"); # 2=LOCK_EX
if ($@) {
&print_error("$@ - 抱歉, 不支援 flock.\$uselock = 0");
}
}
seek(FILE, 0, 0);
}
# -------------------------------------------------------------------------
#????????????????
# -------------------------------------------------------------------------
sub unlock_close {
local(*FILE) = @_;
if ($lock) {
eval("flock(FILE, 8)"); # 8=LOCK_UN
}
close(FILE);
}
# -------------------------------------------------------------------------
# ??????暗?化
# -------------------------------------------------------------------------
sub encode_pwd {
local($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
local(@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
local($pass) = @_;
local($encpass, $salt1, $salt2);
$salt1 = $token[(time | $$) % scalar(@token)];
$salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
$encpass = crypt($pass, "$salt1$salt2");
return $encpass;
}
# -------------------------------------------------------------------------
# ??????照合
# -------------------------------------------------------------------------
sub mismatch_password {
local($pass, $encodedpass) = @_;
if ($encodedpass ne crypt($pass, $encodedpass)) {
return 1;
} else {
return 0;
}
}
# -------------------------------------------------------------------------
# ????取得???????
# -------------------------------------------------------------------------
sub get_cookie {
local($mt_cookiename) = @_;
local($key, $value, @pairs, $pair);
@sqpairs = split(/;\s/, $ENV{'HTTP_COOKIE'});
foreach $sqpair (@sqpairs) {
($sqkey, $sqvalue) = split(/=/, $sqpair);
if ($sqkey eq $mt_cookiename) {
$sqvalue =~ s/:/; /g;
$sqvalue =~ s/_/=/g;
@pairs = split(/;\s/, $sqvalue);
foreach $pair (@pairs) {
($key, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$key =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$cookie{$key} = $value;
}
last;
}
}
}
# -------------------------------------------------------------------------
# ?????作???????
# -------------------------------------------------------------------------
sub make_cookie {
local($mt_cookiename) = @_;
local(@sqcookie, $sqstr);
local($encode) = '\%\+\;\,\=\&\_\:';
while (($key, $value) = each %cookie) {
$key =~ s/([$encode])/'%'.unpack("H2", $1)/eg;
$value =~ s/([$encode])/'%'.unpack("H2", $1)/eg;
$key =~ s/\s/\+/g;
$value =~ s/\s/\+/g;
push(@sqcookie, "${key}_${value}");
}
$sqstr = join(':', @sqcookie);
return "$mt_cookiename=$sqstr; ";
}
# -------------------------------------------------------------------------
# ????表示???????
# -------------------------------------------------------------------------
sub print_cookie {
local($mt_cookiename, $hours, $domain) = @_;
local($cookiestr) = &make_cookie($mt_cookiename);
print "Set-Cookie: $cookiestr;";
if ($domain) {
print " domain=$domain;";
}
print "\n";
}
# -------------------------------------------------------------------------
# 現在日時?得???????
# -------------------------------------------------------------------------
sub get_date_string {
local(@week) = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
local($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
$year += 1900;
$mon++;
# 文字列化?? --------------------------------------------------
$weekstr = $week[$weekday];
# return "$year/$mon/$day ($weekstr) $hour:$min";
return "$year&$mon&$day&$weekstr&$hour&$min";
}
# -------------------------------------------------------------------------
# ???表示???????
# -------------------------------------------------------------------------
sub print_error {
local($msg) = @_;
print "Content-type: text/html; charset=big5\n";
print "\n";
print "<html>\n";
print "<head>\n";
print "<title>$msg</title>\n";
print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=big5\">\n";
print "</head>\n";
print "<body bgcolor=\"#FFFFFF\" text=\"#003366\">\n";
print "<div align=\"center\">\n";
print "<table width=\"90%\" height=\"90%\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\">\n";
print "<tr>\n";
print "<td align=\"center\">\n";
print "<h2>$msg</h2><br>\n";
print "Please try again.";
print "<a href=\"mailto:$admin\">$admin</a>";
print "<font color=\"#CC0000\">請按 BACK 回初始頁面</font><br><br>";
print "<a href=\"$indexurl\">BACK</a>\n";
print "</td>\n";
print "</tr>\n";
print "</table><br><br>\n";
print "</div>\n";
print "</body>\n";
print "</html>\n";
exit(0);
}
# End of Script