#!/usr/bin/perl

##======================================================##
##  AmigoDatabase [汎用データベース]                    ##
##  Copyright(C)2000 cgi-amigo.com All Rights Reserved  ##
##  http://www.cgi-amigo.com/                           ##
##  mail:webmaster@cgi-amigo.com                        ##
##======================================================##

# このスクリプトは無料でご利用頂けますが著作権は放棄していません。
# 同梱の利用規定ファイル(kitei.txt)の利用規定を厳守の上ご利用下さい。
# ファイルを紛失した場合はhttp://www.cgi-amigo.com/kitei.htmlよりご確認下さい。
# 最新バージョンもhttp://www.cgi-amigo.com/よりご確認頂けます。

##########################################################

$Ver='9.85';
&Lrequire('./db-setup.cgi');
&Lrequire("$DataDir/config/db-config.cgi");
&Lrequire('./lib/db-html.cgi');
&Lrequire('./lib/db-mail.cgi');
srand(time()^($$+($$<<15)));
$PID=$$?$$:int(rand(10000)+1);
$NowTime=time;
$NowTimeGm=$NowTime+$TimeZone*3600;
$TODAY=&GetDate($NowTime,'{yyyy}/{mm}/{dd}({w}) {hhhh}:{nn}:{ss}');
#$Copyright=qq(<center><table><tbody><tr><td height="10"></td></tr></tbody></table><table border="1" bgcolor="#ffffff"><tbody><tr><td align="middle"><font style="font-size: 11pt">&nbsp;- <a href="http://www.cgi-amigo.com/" style="color : blue;">AmigoDatabase</a> -&nbsp;</font></td></tr></tbody></table></center></body></html>);
$SIG{INT}=$SIG{HUP}=$SIG{QUIT}=$SIG{TERM}=$SIG{__WARN__}=\&SIGExit;
$DomainName=!$ENV{REMOTE_HOST}||$ENV{REMOTE_HOST}eq$ENV{REMOTE_ADDR}?gethostbyaddr(pack('C4',split(/\./,$ENV{REMOTE_ADDR})),2)||$ENV{REMOTE_ADDR}:$ENV{REMOTE_HOST};
$Agent=&AgentCheck;
$Copyright=qq(- <a href="http://www.cgi-amigo.com/">AmigoDatabase</a> -</body></html>) if($Agent ne 'pc');
%REC=(
'User'=>{ 'UserNum'=>0,'UserType'=>1,'Pass'=>2,'Mail'=>3,'Rtime'=>4,'UpTime'=>5 },
'Data'=>{ 'DataNum'=>0,'UserNum'=>1,'Count'=>2,'Mark1'=>3,'Mark2'=>4,'Rtime'=>5,'UpTime'=>6,'Ip'=>7 },
'UJudge'=>{ 'JudgeNum'=>0,'JudgeType'=>1,'UserNum'=>2,'UserType'=>3,'Pass'=>4,'Mail'=>5,'JDate'=>6,'UpFlag'=>7 },
'DJudge'=>{ 'JudgeNum'=>0,'JudgeType'=>1,'DataNum'=>2,'UserNum'=>3,'JDate'=>4,'UpFlag'=>5 });
$i=5; foreach(sort keys%{$CNF{UserItem}{Save}}){ ($REC{User}{$_} ne '') and next; $i++; $REC{User}{$_}=$i; $REC{UJudge}{$_}=$i+2; }
$i=7; foreach(sort keys%{$CNF{DataItem}{Save}}){ ($REC{Data}{$_} ne '') and next; $i++; $REC{Data}{$_}=$i; $REC{DJudge}{$_}=$i-2; }
%UserType=('h'=>'検索のみ [フォームメール可]','hf'=>'検索のみ [フォームメール不可]','v'=>"$CNF{Set}{DataName}登録可 [フォームメール可]",'vf'=>"$CNF{Set}{DataName}登録可 [フォームメール不可]");
&GetFormData;
@cmd{'ac','ar','c','ca','uj','uja','dj','dja','ia','iaa','id','ida','js','b','bd','rs','rsa',
'cr','cra','ci','cia','ce','cea','loa','ur','ura','uc','uro','pc','pca','ue','uea','uda','dr',
'dra','de','dep','dea','dda','j','v','pr','pra','lo','s','dl','aul','adl','dp','fm','fma','lt'}='';
($FORM{cmd} eq '') and $FORM{cmd}='ur';
!exists$cmd{$FORM{cmd}}?&Error('コマンドが不正です。'):&{$FORM{cmd}};
sub ac { &Lrequire('./lib/db-ac.cgi'); &AdminCertify }
sub ar { &Lrequire('./lib/db-ac.cgi'); &AdminRoom }
sub c  { &Lrequire('./lib/db-c.cgi'); &Config }
sub ca { &Lrequire('./lib/db-c.cgi'); &ConfigAct }
sub uj { &Lrequire('./lib/db-uj.cgi'); &UserJudge }
sub uja{ &Lrequire('./lib/db-uj.cgi'); &UserJudgeAct }
sub dj { &Lrequire('./lib/db-dj.cgi'); &DataJudge }
sub dja{ &Lrequire('./lib/db-dj.cgi'); &DataJudgeAct }
sub ia { &Lrequire('./lib/db-ia.cgi'); &ItemAdd }
sub iaa{ &Lrequire('./lib/db-ia.cgi'); &ItemAddAct }
sub id { &Lrequire('./lib/db-id.cgi'); &ItemDelete }
sub ida{ &Lrequire('./lib/db-id.cgi'); &ItemDeleteAct }
sub js { &Lrequire('./lib/db-js.cgi'); &JsSet }
sub b  { &Lrequire('./lib/db-b.cgi'); &Backup }
sub bd { &Lrequire('./lib/db-b.cgi'); &BackupDelete }
sub rs { &Lrequire('./lib/db-rs.cgi'); &ResetSet }
sub rsa{ &Lrequire('./lib/db-rs.cgi'); &ResetSetAct }
sub cr { &Lrequire('./lib/db-cr.cgi'); &CountReset }
sub cra{ &Lrequire('./lib/db-cr.cgi'); &CountResetAct }
sub ci { &Lrequire('./lib/db-ci.cgi'); &CsvImport }
sub cia{ &Lrequire('./lib/db-ci.cgi'); &CsvImportAct }
sub ce { &Lrequire('./lib/db-ce.cgi'); &CsvExport }
sub cea{ &Lrequire('./lib/db-ce.cgi'); &CsvExportAct }
sub loa{ &Lrequire('./lib/db-loa.cgi'); &LogOutAdmin }
sub ur { &Lrequire('./lib/db-ur.cgi'); &UserRegist }
sub ura{ &Lrequire('./lib/db-ur.cgi'); &UserRegistAct }
sub uc { &Lrequire('./lib/db-uc.cgi'); &UserCertify }
sub uro{ &Lrequire('./lib/db-uc.cgi'); &UserRoom }
sub pc { &Lrequire('./lib/db-pc.cgi'); &PassChange }
sub pca{ &Lrequire('./lib/db-pc.cgi'); &PassChangeAct }
sub ue { &Lrequire('./lib/db-ue.cgi'); &UserEdit }
sub uea{ &Lrequire('./lib/db-ue.cgi'); &UserEditAct }
sub uda{ &Lrequire('./lib/db-uda.cgi'); &UserDeleteAct }
sub dr { &Lrequire('./lib/db-dr.cgi'); &DataRegist }
sub dra{ &Lrequire('./lib/db-dr.cgi'); &DataRegistAct }
sub de { &Lrequire('./lib/db-de.cgi'); &DataEdit }
sub dep{ &Lrequire('./lib/db-de.cgi'); &DataEditPart }
sub dea{ &Lrequire('./lib/db-de.cgi'); &DataEditAct }
sub dda{ &Lrequire('./lib/db-dda.cgi'); &DataDeleteAct }
sub j  { &Lrequire('./lib/db-j.cgi'); &Jump }
sub v  { &Lrequire('./lib/db-v.cgi'); &Vote }
sub pr { &Lrequire('./lib/db-pr.cgi'); &PassReissue }
sub pra{ &Lrequire('./lib/db-pr.cgi'); &PassReissueAct }
sub lo { &Lrequire('./lib/db-lo.cgi'); &LogOut }
sub s  { &Lrequire('./lib/db-s.cgi'); &Search }
sub dl { &Lrequire('./lib/db-s.cgi'); &DataList }
sub aul{ &Lrequire('./lib/db-s.cgi'); &AdminUserList }
sub adl{ &Lrequire('./lib/db-s.cgi'); &AdminDataList }
sub dp { &Lrequire('./lib/db-dp.cgi'); &DataPart }
sub fm { &Lrequire('./lib/db-fm.cgi'); &FormMail }
sub fma{ &Lrequire('./lib/db-fm.cgi'); &FormMailAct }
sub lt { &Lrequire('./lib/db-lt.cgi'); &LockTest }

##########################################################

##################
#   AgentCheck   #
##################
sub AgentCheck{
my$agent=$ENV{HTTP_USER_AGENT};
my$type;
if($agent=~/^(J-PHONE|Vodafone|SoftBank)\//i or $ENV{HTTP_X_JPHONE_MSNAME}){
    $type='j';
    my@agent=split("/",$agent);
    foreach(@agent){
        if($_=~/^SN(\w+)\s+(\w+)$/i){ $PHONEID=$1; last; }
    }
}elsif($agent=~/^((KDDI-)?[A-Z]+[A-Z0-9]+\s+)?UP\.Browser\//i){
    $type='ez';
    $PHONEID=$ENV{HTTP_X_UP_SUBNO};
}elsif($agent=~/^DoCoMo/i){
    $type='i';
    my@agent=split(/[\/\s\(\);]+/,$agent);
    foreach(@agent){
        if($_=~/^ser(\w+)$/i){ $PHONEID=$1; last; }
    }
}else{ $type='pc' }
return($type);}

##########################################################

################
#   Lrequire   #
################
sub Lrequire{ my$lib=shift;
my$name=(split/\//,$lib)[-1];
eval{ require"$lib" } or &Die("$nameを呼び出せません。");}

##########################################################

################
#   Location   #
################
sub Location{ my$url=shift;
if(!$LocationType){ print"Location: $url\n\n" }
else{ print"Content-type: text/html\n\n";
    print qq(<HTML><HEAD><META HTTP-EQUIV="REFRESH" CONTENT="0;URL=$url"></HEAD></HTML>);
}exit;}

##########################################################

################
#   DumpData   #
################
sub DumpData{ my$name=shift; my($buff);
foreach$key(sort keys%{$name}){ $buff.="\%$key=("; &DumpRefType(${$name}{$key},0) }
sub DumpRefType{ my($ref,$level)=@_;
    if(ref$ref eq 'ARRAY'){ &DumpArray($ref) }
    elsif(ref$ref eq 'HASH'){ &DumpHash($ref,$level) }
}sub DumpArray{ my$ref=shift;
    foreach(0..$#{$ref}){
        ${$ref}[$_]=~/[\x5c]$/ and ${$ref}[$_].='\\';
        ${$ref}[$_]=~s/'/’/g;
    }$buff.="[\'".join("','",@{$ref})."\'],\n";
}sub DumpHash{ my($ref,$level)=@_;
    $level++;
    $level!=1 and $buff.='{';
    $buff.="\n";
    foreach(sort keys%{$ref}){
        my$tmp=$_;
        $tmp=~/[\x5c]$/ and $tmp.='\\';
        $tmp=~s/'/’/g;
        $buff.=qq('$tmp'=>);
        if(ref${$ref}{$_}){ &DumpRefType(${$ref}{$_},$level) }
        else{ my$tmp=${$ref}{$_};
            $tmp=~/[\x5c]$/ and $tmp.='\\';
            $tmp=~s/'/’/g;
            $buff.=qq('$tmp',\n);
        }
    }$level--;
    $buff.=$level?"},\n":");\n\n";
}$buff;}

##########################################################

############
#   Lock   #
############
sub Lock{ my($n,$lax)=@_;
if($LockType==1){
    my$lock="$LockDir/$n.lk1";
    my$handle='LOCK'.$n;
    if(!open($handle,">$lock")){
        $lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
    }flock($handle,2);
    $LockFile{$n}=1;
    return(1);
}elsif($LockType==2){
    my$lock="$LockDir/$n.lk2";
    my$locking="$LockDir/$n-".time."-$PID".&GetRandKey(10).'.lk2';
    for(my$i=50; $i>=0; $i--){
        if(rename($lock,$locking)){
            $LockFile{$n}=$locking;
            return(1);
        }eval("select undef,undef,undef,0.1");
        if($@){ sleep 1; $i-=9; }
    }opendir(LDIR,$LockDir);
    my@files=readdir(LDIR);
    closedir(LDIR);
    foreach(@files){
        if(/^$n\-(\d+)\-(\w+)\.lk2$/){
            if(time-$1>60){
                if(rename("$LockDir/$_",$locking)){
                    $LockFile{$n}=$locking;
                    return(1);
                }
            }
        }
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==3){
    my$lock="$LockDir/$n.lk3";
    if(-e$lock and $NowTime-(lstat(_))[9]>60){ unlink$lock }
    for(my$i=50; $i>=0; $i--){
        if(symlink(".",$lock)){ $LockFile{$n}=1; return(1); }
        eval("select undef,undef,undef,0.1");
        if($@){ sleep 1; $i-=9; }
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==4){
    my$ldir="$LockDir/$n";
    my$ldir2="$LockDir/del";
    for(my$i=50; $i>=0; $i--){
        if(mkdir($ldir,0755)){ $LockFile{$n}=1; return(1); }
        if($i==0){
            if(mkdir($ldir2,0755)){
                if($NowTime-(stat($ldir))[9]>60){
                    if(rename($ldir2,$ldir)){ $LockFile{$n}=1; return(1); }
                    else{ rmdir($ldir2) }
                }else{ rmdir($ldir2) }
            }
        }else{
            eval("select undef,undef,undef,0.1");
            if($@){ sleep 1; $i-=9; }
        }
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==5){
    my$lock="$LockDir/$n.lk5";
    for(my$i=50; $i>=0; $i--){
        if(!-e$lock){
            if(!open(LOCK,">$lock")){
                $lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
            }close(LOCK);
            $LockFile{$n}=1;
            return(1);
        }if($i==0){
            if($NowTime-(stat($lock))[9]>60){
                if(!open(LOCK,">$lock")){
                    $lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
                }close(LOCK);
                $LockFile{$n}=1;
                return(1);
            }
        }else{
            eval("select undef,undef,undef,0.1");
            if($@){ sleep 1; $i-=9; }
        }
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}else{
    &Error('ロックタイプの設定が不正です。');
}return(0);}

##################
#   GetRandKey   #
##################
sub GetRandKey{ my$i=shift;
my@saltset=('a'..'z','A'..'Z','0'..'9');
my$tmp;
foreach(1..$i){
    $tmp.=$saltset[int(rand(62))];
}$tmp;}

##############
#   Unlock   #
##############
sub Unlock{ my$n=shift;
if($n eq 'ALL'){
    foreach(keys%LockFile){
        (!$LockFile{$_}) and next;
        if($LockType==1){
            my$handle='LOCK'.$_;
            close($handle);
        }elsif($LockType==2){
            rename($LockFile{$_},"$LockDir/$_.lk2");
        }elsif($LockType==3){
            unlink("$LockDir/$_.lk3");
        }elsif($LockType==4){
            rmdir("$LockDir/$_");
        }elsif($LockType==5){
            unlink("$LockDir/$_.lk5");
        }delete($LockFile{$_});
    }
}else{
    if($LockFile{$n}){
        if($LockType==1){
            my$handle='LOCK'.$n;
            close($handle);
        }elsif($LockType==2){
            rename($LockFile{$n},"$LockDir/$n.lk2");
        }elsif($LockType==3){
            unlink("$LockDir/$n.lk3");
        }elsif($LockType==4){
            rmdir("$LockDir/$n");
        }elsif($LockType==5){
            unlink("$LockDir/$n.lk5");
        }delete($LockFile{$n});
    }
}}

##########################################################

##############
#   Myglob   #
##############
sub Myglob{ my($dir,$type)=@_;
my($file,@list);
opendir(DIR,$dir) or &Error('ディレクトリOPENに失敗しました。');
while(defined($file=readdir DIR)){
    $file=~/^\.{1,2}$/ and next;
    ($type ne '' and $file!~/$type$/) and next;
    push(@list,$file);
}closedir(DIR);
return@list;}

##########################################################

################
#   FileOpen   #
################
sub FileOpen{ my($handle,$file,$name)=@_;
if(!open($handle,$file)){
    ($name eq '') and $name=(split/\//,$file)[-1];
    &Error("$nameが開けません。");
}}

################
#   FileRead   #
################
sub FileRead{ local($file,*line,$type,$name)=@_;
if(!open(FILE,$file)){
    ($name eq '') and $name=(split/\//,$file)[-1];
    &Error("$nameが開けません。");
}if($type){ $line=<FILE> }
else{ @line=<FILE> }
close(FILE);}

#################
#   FileWrite   #
#################
sub FileWrite{ my($file,$data,$open,$name)=@_;
if($open){
    if(!open(FILE,">>$file")){
        ($name eq '') and $name=(split/\//,$file)[-1];
        &Error("$nameが開けません。");
    }
}else{ open(FILE,">$file") }
if(ref$data eq 'ARRAY'){ print FILE @{$data} }
elsif(ref$data eq 'HASH'){ foreach(values%{$data}){ print FILE $_ } }
else{ print FILE $data }
close(FILE);}

################
#   FileMove   #
################
sub FileMove{ my($in,$out)=@_;
if(!open(IN,$in)){
    my$name=(split/\//,$in)[-1];
    &Error("$nameが開けません。");
}binmode(IN);
if(!open(OUT,">$out")){
    my$name=(split/\//,$out)[-1];
    &Error("$nameが開けません。");
}binmode(OUT);
while(<IN>){ print OUT $_ }
close(IN);
close(OUT);
unlink($in);}

##########################################################

#################
#   UrlDecode   #
#################
sub UrlDecode{ my$buff=shift;
$buff=~tr/+/ /;
$buff=~s/%([0-9a-fA-F]{2})/chr(hex($1))/eg; $buff;}

#################
#   UrlEncode   #
#################
sub UrlEncode{ my$buff=shift;
$buff=~s/([^ ])/sprintf('%%%02X',ord($1))/eg;
$buff=~tr/ /+/; $buff;}

#################
#   TagEncode   #
#################
sub TagEncode{ my$buff=shift;
$buff=~s/</&lt;/g;
$buff=~s/>/&gt;/g;
$buff;}

#################
#   TagDecode   #
#################
sub TagDecode{ my$buff=shift;
$buff=~s/&lt;/</g;
$buff=~s/&gt;/>/g;
$buff;}

##################
#   HtmlEncode   #
##################
sub HtmlEncode{ my$buff=shift;
$buff=~s/</&lt;/g;
$buff=~s/>/&gt;/g;
$buff=~s/&(?!(?:amp|quot|lt|gt);)/&amp;/g;
$buff=~s/"/&quot;/g;
$buff;}

##################
#   HtmlDecode   #
##################
sub HtmlDecode{ my$buff=shift;
$buff=~s/&lt;/</g;
$buff=~s/&gt;/>/g;
$buff=~s/&amp;/&/g;
$buff=~s/&quot;/"/g;
$buff;}

##########################################################

################
#   SidCheck   #
################
sub SidCheck{ my$dir=shift; local(*id);
&FileRead("$dir/submit.dat",*id,1);
($id eq $FORM{SID}) and &Error('同一内容の２重送信です。<BR>送信ボタンは１度だけ押すようにして下さい。'); 1;}

############
#   Html   #
############
sub Html{ my$file=shift;
($file=~/^\//) and &Error('テンプレートの指定が不正です。');
($file=~/\.\./) and &Error('テンプレートの指定が不正です。');
print"Content-Type: text/html\n\n";
require"./lib/template/$file";
print$Copyright;exit;}

#############
#   Error   #
#############
sub Error{ $msg=shift;
foreach(@UpFile){
    my$file=(-e"$UpDir/tmp/$_")?"$UpDir/tmp/$_":"$UpDir/$_";
    unlink$file;
}&Unlock('ALL');
&Html('error.html');}

###########
#   Die   #
###########
sub Die{ ($msg,$NoHead)=@_;
$NoHead or print"Content-type: text/html\n\n";
print$msg;exit;}

###############
#   SIGExit   #
###############
sub SIGExit{ &Unlock('ALL'); exit(1);}

##########################################################

###################
#   GetFormData   #
###################
sub GetFormData{ my$buff;
if($ENV{REQUEST_METHOD} eq 'POST'){
    if($ENV{CONTENT_TYPE}=~/^multipart\/form-data/){
        foreach(values%{$CNF{Upload}{FileSize}}){ $ClenMax+=$_*1024 }
        ($ENV{CONTENT_LENGTH} > $ClenMax) and &Error('送信データが大きすぎます。');
        &Multipart(16384,$UpDir,"$UpDir/tmp",100,20);
        return(1);
    }else{ ($ENV{CONTENT_LENGTH} > $ClenMax) and &Error('送信データが大きすぎます。');
        read(STDIN,$buff,$ENV{CONTENT_LENGTH});
    }
}else{ $buff=$ENV{QUERY_STRING} }
foreach(split(/&/,$buff)){
    ($key,$val)=split(/=/,$_,2);
    $key=&UrlDecode($key);
    $val=&UrlDecode($val);
    &$JCODE(\$key,'sjis');
    &$JCODE(\$val,'sjis');
    $key=&HtmlEncode($key);
    $val=&HtmlEncode($val);
    $val=~s/\t//g;
    $val=~s/(?:\r\n|\r)/\n/g;
    if($FORM{$key} ne '' and $val ne ''){
        $FORM{$key}.="\0";
        $divided{$key}=1;
    }else{ push(@keys,$key) }
    $FORM{$key}.=$val;
}foreach(keys%divided){
    $FORM{$_}=~s/,/，/g;
    $FORM{$_}=~s/\0/,/g;
}}

#################
#   Multipart   #
#################
sub Multipart{ my($bufsize,$dir,$dir2,$maxbound,$fnmax)=@_;
&Secure(scalar@MyUrl,undef,undef,undef,$CNF{Check}{Proxy},$CNF{Check}{Domain},$CNF{Check}{Vip});
stat($dir);  &Error('保存ディレクトリが不正です。') unless -d _ && -w _;
stat($dir2); &Error('保存ディレクトリが不正です。') unless -d _ && -w _;
binmode(STDIN);
my($boundary)=$ENV{CONTENT_TYPE}=~/boundary="([^"]+)"/;
($boundary)=$ENV{CONTENT_TYPE}=~/boundary=(\S+)/ unless$boundary;
(!$boundary) and &Error('バウンダリがありません。');
$boundary="--".$boundary;
my$blen=length$boundary;
my($buf,$bpos,$name,$macie,$head,$lpos,@head,$cd,$ct,$file);
my$left=$ENV{CONTENT_LENGTH};
my$loop=0;
MAIN:while(1){
    my$read=($left > $bufsize+$maxbound-length($buf))?$bufsize+$maxbound-length($buf):$left;
    read(STDIN,$buf,$read,length($buf))!=$read and &Error('データの読み取りに失敗しました。(1)');
    $left-=$read;
    while(($bpos=index($buf,$boundary))==-1){
        ($left==0 and $buf eq '') and &Error('不正なデータです。(1)');
        if($name ne ''){
            if($file ne ''){
                if($macie){ print UPFILE substr($buf,128,$bufsize); undef$macie; }
                else{ print UPFILE substr($buf,0,$bufsize) }
            }else{ $FORM{$name}.=substr($buf,0,$bufsize) }
        }$buf=substr($buf,$bufsize);
        $read=($left > $bufsize)?$bufsize:$left;
        read(STDIN,$buf,$read,length($buf))!=$read and &Error('データの読み取りに失敗しました。(2)');
        $left-=$read;
    }$left-=read(STDIN,$buf,2,length($buf));
    if($name ne ''){
        if($file ne ''){
            if($macie){ print UPFILE substr($buf,128,$bpos-2); undef$macie; }
            else{ print UPFILE substr($buf,0,$bpos-2) }
            undef$file;
        }else{ $FORM{$name}.=substr($buf,0,$bpos-2) }
    }close(UPFILE);
    undef$name;
    last MAIN if substr($buf,$bpos+$blen,2) eq "--";
    substr($buf,0,$bpos+$blen+2)='';
    $read=$left > $bufsize+$maxbound-length($buf)?$bufsize+$maxbound-length($buf):$left;
    read(STDIN,$buf,$read,length$buf)!=$read and &Error('データの読み取りに失敗しました。(3)');
    $left-=$read;
    undef$head;
    while(($lpos=index($buf,"\r\n\r\n"))==-1){
        ($left==0 and $buf eq '') and &Error('不正なデータです。(2)');
        $head.=substr($buf,0,$bufsize);
        $buf=substr($buf,$bufsize);
        $read=($left > $bufsize)?$bufsize:$left;
        (read(STDIN,$buf,$read,length$buf)!=$read) and &Error('データの読み取りに失敗しました。(4)');
        $left-=$read;
    }$head.=substr($buf,0,$lpos+2);
    @head=split("\r\n",$head);
    ($cd)=grep(/^\s*Content-Disposition:/i,@head);
    ($ct)=grep(/^\s*Content-Type:/i,@head);
    ($ct=~/application\/x-macbinary/i) and $macie=1;
    ($name)=$cd=~/\bname="?([^"]+)"?/i;
    ($file)=$cd=~/\bfilename="?([^"]+)"?/i;
    if($file ne ''){
        ($file)=$file=~/([^:\/\\]+)$/;
        my$flen=length$file;
#        ($flen > $fnmax) and &Error("$fileのファイル名が長すぎます。<BR>(現在：$flen文字 最大：$fnmax文字)");
        $file=~/\.\./ and &Error('ファイル名が不正です。');
#        $file=~/[^\-_0-9A-Za-z\.]/ and &Error('ファイル名に使用出来ない文字が含まれています。');
        $file!~/^(.*)\.(\w+)$/ and &Error('ファイルに拡張子がありません。');
        my$type=lc($2);
        $CNF{Upload}{FileType}{$name}{$type} or &Error('この種類のファイルは<BR>アップロードが禁止されています。');


#ファイル名変更
my($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
my$f1 = sprintf("%4d%02d%02d%02d%02d%02d",
$year+1900, ++$mon, $mday, $hour, $min, $sec);
my$f2 = int(rand(10000)+1);
$file = qq($f1-$f2.$type);
#END




        if(-e"$dir/$file" or -e"$dir2/$file"){
            my($nm1,$nm2,$nm3)=($1,2,$2);
            while(-e$dir."/$nm1($nm2).$nm3" or -e$dir2."/$nm1($nm2).$nm3"){ $nm2++ }
            $file="$nm1($nm2).$nm3";
        }$SizeMax{$file}=$CNF{Upload}{FileSize}{$name};
        open(UPFILE,">$dir/$file") or &Error('添付ファイルを書き込めませんでした。');
        binmode(UPFILE);
        push(@UpFile,$file);
        $FORM{$name}=$file;
    }elsif(length$name and exists$FORM{$name}){
        $FORM{$name}.="\0";
        $divided{$name}=1;
    }substr($buf,0,$lpos+4)='';
    $loop++; ($loop>=1000) and &Error('ループエラー');
}foreach(@UpFile){
    $size=-s"$dir/".$_;
    $size=eval{ $size/1024 };
    $size=sprintf("%.2f",$size);
    ($size > $SizeMax{$_}) and &Error("$_が最大サイズを超えています。<BR>(現在：$size\KB 最大：$SizeMax{$_}\KB)");
}foreach$key(keys%FORM){
    $val=$FORM{$key};
    &$JCODE(\$key,'sjis');
    &$JCODE(\$val,'sjis');
    $key=&HtmlEncode($key);
    $val=&HtmlEncode($val);
    $val=~s/\t//g;
    $val=~s/(?:\r\n|\r)/\n/g;
    $FORM{$key}=$val;
}foreach(keys%divided){
    $FORM{$_}=~s/,/，/g;
    $FORM{$_}=~s/\0/,/g;
}if($FORM{Preview}==1){
    foreach(0..$#UpFile){ &FileMove("$dir/$UpFile[$_]","$dir2/$UpFile[$_]") }
    my@tmps=&Myglob($dir2);
    my%tmps;
    foreach(@tmps){
        ($_ eq 'index.html') and next;
        if($NowTime-(stat("$dir2/$_"))[9]>3600){ unlink("$dir2/$_"); next; }
        $tmps{$_}=(stat("$dir2/$_"))[9];
    }if(keys%tmps>$CNF{Upload}{TempMax}){
        foreach(sort{ $tmps{$a}<=>$tmps{$b} }keys%tmps){
            unlink("$dir2/$_");
            delete$tmps{$_};
            (keys%tmps<=$CNF{Upload}{TempMax}) and last;
        }
    }
}}

##########################################################

###############
#   GetDate   #
###############
sub GetDate{ my($time,$format,$gm)=@_;
my$tp=$gm?0:$TimeZone*3600;
($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime($time+$tp);
my@mon=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my@jwday=qw(日 月 火 水 木 金 土);
my@ewday=qw(Sun Mon Tue Wed Thu Fri Sat);
$year+=1900; $mon++;
if($format ne ''){
    $format=~s/{yyyy}/$year/ or
        $format=~s/{yy}/substr($year,2,4)/e or
        $format=~s/{y}/'平成'.($year-1988)/e;
    $format=~s/{mmm}/$mon[$mon-1]/ or
        $format=~s/{mm}/sprintf('%02d',$mon)/e or
        $format=~s/{m}/$mon/;
    $format=~s/{dd}/sprintf('%02d',$mday)/e or
        $format=~s/{d}/$mday/;
    $format=~s/{ww}/$jwday[$wday]/ or
        $format=~s/{w}/$ewday[$wday]/;
    $format=~s/{HH}/$hour<12?'午前':'午後'/e or
        $format=~s/{H}/$hour<12?'AM':'PM'/e;
    $format=~s/{hhhh}/sprintf('%02d',$hour)/e or
        $format=~s/{hhh}/$hour/ or
        $format=~s/{hh}/sprintf('%02d',($hour>11?$hour-12:$hour))/e or
        $format=~s/{h}/($hour>11?$hour-12:$hour)/e;
    $format=~s/{nn}/sprintf('%02d',$min)/e or
        $format=~s/{n}/$min/;
    $format=~s/{ss}/sprintf('%02d',$sec)/e or
        $format=~s/{s}/$sec/;
}$format;}

###############
#   Encrypt   #
###############
sub Encrypt{ my$buff=shift;
my@saltset=('a'..'z','A'..'Z','0'..'9','.','/');
return crypt($buff,$saltset[int(rand(64))].$saltset[int(rand(64))]);}

################
#   AutoLink   #
################
sub AutoLink{ my$buff=shift;
my$url='[\w\-\+\.\~\/\?\&\=\#\%\:\!\*\'\,\(\)\;\@\$]+';
my$mail='[\w\-\+\.]+';
$buff=~s/((?:s?https?|ftp):\/\/$url\.$url)|([\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC])*($mail\@$mail\.$mail)/$3?qq($2<A href="mailto:$3">$3<\/A>):qq(<A href="$1" target="$CNF{Set}{AutoTarget}">$1<\/A>)/ego;
$buff;}

##################
#   UnAutoLink   #
##################
sub UnAutoLink{ my$buff=shift;
$buff=~s/<A href="(?:mailto:)?([^"]+)"(?: target="$CNF{Set}{AutoTarget}")?>\1<\/A>/$1/gio;
$buff;}

#################
#   SetCookie   #
#################
sub SetCookie{ my($cookname,$cookval,$cookexp)=@_;
my$expires;
if($cookexp){
    my@Month=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
    my@Week=(Sun,Mon,Tue,Wed,Thu,Fri,Sat);
    my($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime(time+$cookexp*86400);
    $expires=sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$Week[$wday],$mday,$Month[$mon],$year+1900,00,00,00);
}$cookname=&UrlEncode($cookname);
$cookval=&UrlEncode($cookval);
print"Set-Cookie: $cookname=$cookval; expires=$expires\n"; 1;}

#################
#   GetCookie   #
#################
sub GetCookie{ my$cookname=shift;
foreach(split(/;/,$ENV{HTTP_COOKIE})){
    $_=&UrlDecode($_);
    my($key,$val)=split(/=/);
    $key=~s/\s//g;
    $buff{$key}=$val;
}foreach(split(/\,/,$buff{$cookname})){
    my($key,$val)=split(/<>/);
    $key=&HtmlEncode($key);
    $val=&HtmlEncode($val);
    $COOKIE{$key}=$val;
}1;}

##############
#   Secure   #
##############
sub Secure{ my($ref,$method,$admin,$sid,$proxy,$domain,$vip,$lax)=@_;
if($ref){
    undef$found;
    if($ENV{HTTP_REFERER} eq ''){
        if($MobileAccess==1 and $Agent ne 'pc'){ $found=1 }
        else{ $found=0 }
    }else{ foreach(@MyUrl){ if($ENV{HTTP_REFERER}=~/^\Q$_\E/){ $found=1; last } } }
    (!$found) and $lax?return(0):&Error('設置サイト外からの呼び出しです。<BR>なおセキュリティソ\フトやファイアウォールの影響で<BR>本エラーとなる場合がございますので<BR>ご利用の環境をご確認下さい。');
}&MethodCheck if($method);
&AdminCheck if($admin ne '');
&SidCheck($sid) if($sid and $SidChkMode);
&ProxyCheck($proxy,$domain,$vip); 1;}

###################
#   MethodCheck   #
###################
sub MethodCheck{ &Error('METHOD形式が不正です。<BR>POST形式でのみ送信できます。') if($ENV{REQUEST_METHOD} !~ /POST/i); 1;}

##################
#   AdminCheck   #
##################
sub AdminCheck{
if($CNF{AdminPass} ne ''){
    if($FORM{AdminPass} eq ''){
        &GetCookie("$CNF{Cookie}{Name}(Admin)");
        $FORM{AdminPass}=$COOKIE{AdminPass};
    }my$pass=$CryptMode?crypt($FORM{AdminPass},$CNF{AdminPass}):$FORM{AdminPass};
    ($pass ne $CNF{AdminPass}) and &Error('管理用パスワードが違います。');
}1;}

##################
#   ProxyCheck   #
##################
sub ProxyCheck{ my($proxy,$domain,$vip,$error,$perror)=@_;
if($proxy){
    if($DomainName=~/squid|proxy|cache|delegate|keeper|^firewall|^dns|^mail|^www|^ns\d{0,2}\.|us$|uk$|au$|fi$|ca$|de$|kr$|tw$|it$|edu$|com$|org$|net$/i || 
    $ENV{HTTP_USER_AGENT}=~/squid|via|delegate|httpd|proxy|cache|Turing|ANONYM/i || !$ENV{REMOTE_ADDR} ||
    defined $ENV{HTTP_X_FORWARDED_FOR} || defined $ENV{HTTP_FORWARDED} || defined $ENV{HTTP_PROXY_CONNECTION} || defined $ENV{HTTP_XROXY_CONNECTION} || defined $ENV{HTTP_XONNECTION} || 
    defined $ENV{HTTP_VIA} || defined $ENV{HTTP_CLIENT_IP} || defined $ENV{HTTP_X_LOCKING} || defined $ENV{HTTP_SP_HOST} || defined $ENV{HTTP_CACHE_INFO} || defined $ENV{HTTP_CACHE_CONTROL}
    ){ $error=1; $perror=1; }
}if(!$error and $domain){ unless(&DomainCheck('out')){ $error=1 } }
if($error  and $vip){ unless(&DomainCheck('vip')){ $error=0 } }
if($error){ if($perror){ &Error('只今、プロキシ経由の更新を制限しております。<BR>ブラウザ設定でプロキシを使用しないドメイン欄に<BR>ここのURLのドメインを設定してください。<BR>ご迷惑をおかけして申し訳ありませんが<BR>ご理解の程よろしくお願い致します。') }
    &Error('只今、あなたが使用しているホストからの<BR>データ更新を制限しております。<BR>可能でしたら他のホストを使用して<BR>もう一度アクセスしてください。');
}1;}

###################
#   DomainCheck   #
###################
sub DomainCheck{ my($type,@DomainList)=@_;
if($type eq 'out'){ @DomainList=@{$CNF{Domain}{Out}} }
else{ @DomainList=@{$CNF{Domain}{Vip}} }
foreach(@DomainList){
    return(1) if($_ eq '');
    if(/(\d\.)/){ if($ENV{REMOTE_ADDR}=~/^$_/){ return(0) } }
    else{ if(index($DomainName,$_) >= 0){ return(0) } }
}1;}

#################
#   AccessLog   #
#################
sub AccessLog{ my($dir,$action)=@_; local(*AccessLogLines);
&FileRead("$dir/access.log",*AccessLogLines);
if(@AccessLogLines >= $CNF{AcsLog}{Max}){
    if($CNF{AcsLog}{File}){ &AcsBackup(\@AccessLogLines,$CNF{AcsLog}{File},$dir,'dat') }
    @AccessLogLines=();
}unshift(@AccessLogLines,"[$TODAY] - $DomainName - $ENV{REMOTE_ADDR} - $ENV{HTTP_USER_AGENT} - $ENV{HTTP_X_FORWARDED_FOR} - $action\n");
&FileWrite("$dir/access.log",\@AccessLogLines); 1;}

#################
#   AcsBackup   #
#################
sub AcsBackup{ my($line,$max,$dir,$type)=@_;
my@Files=&Myglob($dir,$type);
my$FileSu=@Files+1;
if(@Files >= $max){
    my$DeleteSu=$FileSu-$max;
    foreach(1..$DeleteSu){ unlink"$dir\/$_\.$type" }
    my$NewName=0;
    foreach($DeleteSu+1..@Files){ $NewName++; rename("$dir\/$_\.$type","$dir\/$NewName\.$type") }
    $FileSu=$NewName+1;
}&FileWrite("$dir/$FileSu.$type",\@{$line}); 1;}

##################
#   TagConvert   #
##################
sub TagConvert{ my($buff,$item,$permit,$link)=@_;
my(@buff,$tag,$text,$TagTmp,$TagName,$property,@OpenTag,$PropertyTmp,$pname,$pval,$found,$CloseTag);
$buff=&HtmlDecode($buff);
@buff=split(/(<[^>]*>)/,$buff,-1);
$buff=&HtmlEncode(shift@buff);
$buff=&AutoLink($buff) if($link);
while(($tag,$text)=splice(@buff,0,2)){
    $text=&HtmlEncode($text);
    $TagTmp=$tag;
    $tag=~s/\n//g;
    if($tag=~/^<(\w+)\s*([^>]*)>$/){
        $TagName=uc$1;
        $property=$2;
        if(exists${${$permit}{$item}}{$TagName}){
            push(@OpenTag,$TagName) if($CNF{Tag}{Close}{$TagName});
            undef$PropertyTmp;
            $property=~s/\'/\"/g;
            while($property=~/[\s]*?([^=\W]+)(=[\s]*?(?:"([^"]*)"|([^ ]+)))?/g){
                if($2 ne ''){ $pname=$1;
                    $pval=$3 ne ''?$3:$4;
                    next if($pname !~ /^[\s]*?(?:$CNF{Tag}{Property}{$TagName})[\s]*?$/i);
                    $pval=~s/"//g;
                    $PropertyTmp.=qq( $pname="$pval");
                }
            }$tag="<$TagName$PropertyTmp>";
        }else{ $tag=&HtmlEncode($TagTmp) }
    }elsif($tag=~/^<\/(\w+)>$/){
        $TagName=uc$1;
        undef$tag;
        undef$found;
        foreach(@OpenTag){ if($TagName eq $_){ $found=1; last } }
        if($found){
            while($CloseTag=pop(@OpenTag)){
                $tag.="</$CloseTag>";
                last if($TagName eq $CloseTag);
            }
        }else{ $tag=&HtmlEncode($TagTmp) }
    }else{ $tag=&HtmlEncode($TagTmp) }
    if($link){ undef$found;
        foreach(@OpenTag){ if($_ eq 'A'){ $found=1; last } }
        $text=&AutoLink($text) unless($found);
    }$buff.="$tag$text";
}foreach(@OpenTag){ $buff.="</$_>" } $buff;}

##########################################################

#####################
#   UserCookieGet   #
#####################
sub UserCookieGet{
&GetCookie("$CNF{Cookie}{Name}(User)");
$FORM{UserNum}=$COOKIE{UserNum} if($FORM{UserNum} eq '');
$FORM{Pass}=$COOKIE{Pass} if($FORM{Pass} eq '') }

#################
#   UserCheck   #
#################
sub UserCheck{
&UserCookieGet;
&FileRead("$UserDir/user.cgi",*UserLines);
undef$found;
foreach(0..$#UserLines){
    my@tmp=split(/<>/,$UserLines[$_]);
    if($FORM{UserNum} eq $tmp[$REC{User}{UserNum}]){
        $found=1; $LineNum=$_; @TargetUser=@tmp;
        return(1) if($FORM{AdminPass} ne '');
        my$pass=$CryptMode?crypt($FORM{Pass},$tmp[$REC{User}{Pass}]):$FORM{Pass};
        ($pass ne $tmp[$REC{User}{Pass}]) and $found=0;
        if($found==0 and $REC{User}{TempPass} ne '' and $tmp[$REC{User}{TempPass}] ne ''){
            my$tpass=$CryptMode?crypt($FORM{Pass},$tmp[$REC{User}{TempPass}]):$FORM{Pass};
            ($tpass eq $tmp[$REC{User}{TempPass}]) and $found=1;
        }last;
    }
}($found!=1) and &Error("$CNF{Set}{UserName}番号又はパスワードに誤りがあります。");}

##########################################################

#######################
#   DataRegistCheck   #
#######################
sub DataRegistCheck{ my$edit=shift;
if($CNF{Check}{DataRegist} and $FORM{AdminPass} eq ''){
    &Error("管理者以外の方の$CNF{Set}{DataName}登録・編集はできません。");
}($edit eq 'edit') and &DataNumCheck;
&UserCheck;
if($TargetUser[$REC{User}{UserType}]=~/^h/ and $FORM{AdminPass} eq ''){
    &Error("$CNF{Set}{UserName}タイプが$CNF{Set}{DataName}登録不可となっている為<BR>登録や編集はできません。");
}}

####################
#   DataNumCheck   #
####################
sub DataNumCheck{
&FileRead("$DataDir/data/data.cgi",*DataLines);
undef$found;
foreach(0..$#DataLines){
    @SplitData=split(/<>/,$DataLines[$_]);
    if($FORM{DataNum} eq $SplitData[0]){
        $found=1; $LineNum2=$_; @TargetData=@SplitData;
        if($FORM{AdminPass} ne ''){ $FORM{UserNum}=$SplitData[1]; return 1; }
        &Error('登録者以外は編集はできません。') if($FORM{UserNum} ne $SplitData[1]); last;
    }
}&Error("$CNF{Set}{DataName}番号が不正です。") unless($found) }

###################
#   ViewConvert   #
###################
sub ViewConvert{ my($all,$rec,$target)=@_;
foreach(keys%{$REC{$rec}}){
    if(${${$all}{Link}}{$_}){ ${$target}[$REC{$rec}{$_}]=&UnAutoLink(${$target}[$REC{$rec}{$_}]) }
    if(${${$all}{Lines}}{$_}){ ${$target}[$REC{$rec}{$_}]=~s/<BR>/\n/g }
    if(${${$all}{Select}}{$_}){ foreach$a(split/,/,${$target}[$REC{$rec}{$_}]){ $Select{$_}{${${$all}{Select}}{$_}{$a}}='selected' } }
    if(${${$all}{CheckBox}}{$_}){ foreach$a(split/,/,${$target}[$REC{$rec}{$_}]){ $CheckBox{$_}{${${$all}{CheckBox}}{$_}{$a}}='checked' } }
    ${$target}[$REC{$rec}{$_}]=&HtmlEncode(${$target}[$REC{$rec}{$_}]);
    $DATA{$_}=${$target}[$REC{$rec}{$_}];
}}

#######################
#   RegistDataCheck   #
#######################
sub RegistDataCheck{ my($all,$nopass)=@_;
foreach(@{${$all}{Necessary}}){
    next if(($_ eq '') or ($_ eq 'Pass' and $nopass));
    if($FORM{$_} eq ''){ $item=${$all}{DataName}{$_}; &Error("$itemが入力されていません。"); }
}while(($a,$b)=each(%{${$all}{Same}})){
    next if(($a eq '' or $b eq '') or (($a eq 'Pass' or $b eq 'Pass') and $nopass));
    if($FORM{$a} ne $FORM{$b}){ ($a,$b)=(${$all}{DataName}{$a},${$all}{DataName}{$b}); &Error("$aと$bの入力が違います。"); }
}while(($item,$maxlen)=each(%{${$all}{Mojisu}})){
    next if(($item eq '') or ($item eq 'Pass' and $nopass));
    $len=length($FORM{$item});
    if($len > $maxlen){ $item=${$all}{DataName}{$item}; &Error("$itemが最大文字数を越えています。<BR>(最大：$maxlen文字 現在：$len文字)"); }
}while(($item,$pattern)=each(%{${$all}{Valid}})){
    next if($item eq '' or $FORM{$item} eq '' or ($item eq 'Pass' and $nopass));
    if($FORM{$item} !~ /$pattern/i){ $item=${$all}{DataName}{$item}; &Error("$itemの入力が不正です。"); }
}while(($item,$pattern)=each(%{${$all}{Invalid}})){
    next if($item eq '' or $FORM{$item} eq '' or ($item eq 'Pass' and $nopass));
    if($FORM{$item} =~ /$pattern/i){ $item=${$all}{DataName}{$item}; &Error("$itemの入力が不正です。"); }
}while(($item,$maxnum)=each(%{${$all}{NumMax}})){
    next if(($item eq '') or ($item eq 'Pass' and $nopass));
    $FORM{$item} eq '' and next;
    if($FORM{$item} > $maxnum){ $item=${$all}{DataName}{$item}; &Error("$itemの数値が大きすぎます。(最大：$maxnum)"); }
}while(($item,$mininum)=each(%{${$all}{NumMini}})){
    next if(($item eq '') or ($item eq 'Pass' and $nopass));
    $FORM{$item} eq '' and next;
    if($FORM{$item} < $mininum){ $item=${$all}{DataName}{$item}; &Error("$itemの数値が小さすぎます。(最小：$mininum)"); }
} }

#########################
#   RegistDataConvert   #
#########################
sub RegistDataConvert{ my($all)=@_;
foreach(@{${$all}{All}}){
    $HFORM{$_}=$FORM{$_};
    $FORM{$_}=&TagConvert($FORM{$_},$_,\%{${$all}{Tag}},${${$all}{Link}}{$_});
    $FORM{$_}=~s/<>/&lt;&gt;/g;
    ${${$all}{Lines}}{$_} ? $FORM{$_}=~s/\n/<BR>/g : $FORM{$_}=~s/\n//g;
}}

#####################
#   RegistPreview   #
#####################
sub RegistPreview{ local($file,$all,$nopass)=@_;
foreach(@{${$all}{All}}){
    ($_ eq 'UserType') and next;
    $PREFORM{$_}=$FORM{$_};
    if(${${$all}{Link}}{$_}!=1 and ${${$all}{PreLink}}{$_}==1){
        (${${$all}{Lines}}{$_}) and $PREFORM{$_}=~s/<BR>/\n/g;
        $PREFORM{$_}=&TagConvert($PREFORM{$_},$_,\%{${$all}{Tag}},${${$all}{PreLink}}{$_});
        (${${$all}{Lines}}{$_}) and $PREFORM{$_}=~s/\n/<BR>/g;
    }
}&Html($file);}

##################
#   _PreHidden   #
##################
sub _PreHidden{
foreach(@{${$all}{All}}){
    ($_ eq 'UserNum' or $_ eq 'DataNum') and next;
    (($_ eq 'Pass' or $_ eq 'Pass2') and $nopass) and next;
    $HFORM{$_}=&HtmlEncode($HFORM{$_});
    print qq(<INPUT type="hidden" name="$_" value="$HFORM{$_}">\n);
}}

##########################################################

##################
#   _KanriMenu   #
##################
sub _KanriMenu{ my$sel=shift;
&FileRead("$UserDir/wait.cgi",*UTempLines);
&FileRead("$DataDir/data/wait.cgi",*DTempLines);
$UtempSu=@UTempLines;
$DtempSu=@DTempLines;
$select{$sel}='selected';
print qq(
<optgroup label="データ登録・修正">
<OPTION value="dr" $select{dr}>管理者$CNF{Set}{DataName}登録</OPTION>
<OPTION value="adl" $select{adl}>登録$CNF{Set}{DataName}一覧</OPTION>
</optgroup>
<optgroup label="管理者設定">
<OPTION value="aul" $select{aul}>登録$CNF{Set}{UserName}一覧</OPTION>
<OPTION value="ur" $select{ur}>管理者$CNF{Set}{UserName}登録</OPTION>
<OPTION value="uj" $select{uj}>$CNF{Set}{UserName}申\請審査 [$UtempSu件]</OPTION>
<OPTION value="dj" $select{dj}>$CNF{Set}{DataName}申\請審査 [$DtempSu件]</OPTION>
<OPTION value="c" $select{c}>環境設定</OPTION>
<OPTION value="ia" $select{ia}>データ種類追加</OPTION>
<OPTION value="id" $select{id}>データ種類削除</OPTION>
<OPTION value="js" $select{js}>登録数ファイル更新</OPTION>
<OPTION value="b" $select{b}>バックアップ作成</OPTION>
<OPTION value="bd" $select{bd}>バックアップ削除</OPTION>
<OPTION value="ci" $select{ci}>CSVファイルインポート</OPTION>
<OPTION value="ce" $select{ce}>CSVファイルエクスポート</OPTION>
<OPTION value="rs" $select{rs}>カウントリセット日時設定</OPTION>
<OPTION value="cr" $select{cr}>カウントリセット実行</OPTION>
<OPTION value="ar" $select{ar}>管理室へ戻る</OPTION>
<OPTION value="loa" $select{loa}>ログアウト</OPTION>
</optgroup>
\n);}

#################
#   _UserMenu   #
#################
sub _UserMenu{ my$sel=shift;
$select{$sel}='selected';
print qq(<OPTION value="pc" $select{pc}>パスワード変更</OPTION>
<OPTION value="ue" $select{ue}>$CNF{Set}{UserName}情報編集</OPTION>\n);
if($TargetUser[$REC{User}{UserType}]=~/^v/ or $FORM{AdminPass} ne ''){
    print qq(<OPTION value="dr" $select{dr}>$CNF{Set}{DataName}登録</OPTION>
    <OPTION value="dl" $select{dl}>登録$CNF{Set}{DataName}一覧</OPTION>);
}print qq(<OPTION value="uro" $select{uro}>メニュートップへ戻る</OPTION>
<OPTION value="lo" $select{lo}>ログアウト</OPTION>\n);}

##########################################################

##################
#   MojiHenkan   #
##################
sub MojiHenkan{ my($line,$type)=@_;
my$hankana=&MojiTable($type);
if($hankana==1){
    $line=~s/([\xB3\xB6-\xBF\xC0-\xC4\xCA-\xCE]{1}[\xDE]{1}|[\xCA-\xCE]{1}[\xDF]{1}|[\x00-\x7F\xA1-\xDF]|[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC])/exists$MTABLE{$1}?$MTABLE{$1}:$1/ego;
}else{
    $line=~s/([\x00-\x7F\xA1-\xDF]|[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC])/exists$MTABLE{$1}?$MTABLE{$1}:$1/ego;
}return($line);}

#################
#   MojiTable   #
#################
sub MojiTable{ my$type=shift;
if($type eq 'search'){
%MTABLE=qw(０ 0 １ 1 ２ 2 ３ 3 ４ 4 ５ 5 ６ 6 ７ 7 ８ 8 ９ 9 
Ａ a Ｂ b Ｃ c Ｄ d Ｅ e Ｆ f Ｇ g Ｈ h Ｉ i Ｊ j Ｋ k Ｌ l Ｍ m 
Ｎ n Ｏ o Ｐ p Ｑ q Ｒ r Ｓ s Ｔ t Ｕ u Ｖ v Ｗ w Ｘ x Ｙ y Ｚ z 
ａ a ｂ b ｃ c ｄ d ｅ e ｆ f ｇ g ｈ h ｉ i ｊ j ｋ k ｌ l ｍ m 
ｎ n ｏ o ｐ p ｑ q ｒ r ｓ s ｔ t ｕ u ｖ v ｗ w ｘ x ｙ y ｚ z 
A a B b C c D d E e F f G g H h I i J j K k L l M m 
N n O o P p Q q R r S s T t U u V v W w X x Y y Z z 
ｧ ァ ｨ ィ ｩ ゥ ｪ ェ ｫ ォ ｬ ャ ｭ ュ ｮ ョ ｯ ッ 
ｱ ア ｲ イ ｳ ウ ｴ エ ｵ オ ｶ カ ｷ キ ｸ ク ｹ ケ ｺ コ ｻ サ ｼ シ ｽ ス ｾ セ ｿ ソ 
ﾀ タ ﾁ チ ﾂ ツ ﾃ テ ﾄ ト ﾅ ナ ﾆ ニ ﾇ ヌ ﾈ ネ ﾉ ノ ﾊ ハ ﾋ ヒ ﾌ フ ﾍ ヘ ﾎ ホ 
ﾏ マ ﾐ ミ ﾑ ム ﾒ メ ﾓ モ ﾔ ヤ ﾕ ユ ﾖ ヨ ﾗ ラ ﾘ リ ﾙ ル ﾚ レ ﾛ ロ ﾜ ワ ｦ ヲ ﾝ ン 
ｳﾞ ヴ ｶﾞ ガ ｷﾞ ギ ｸﾞ グ ｹﾞ ゲ ｺﾞ ゴ ｻﾞ ザ ｼﾞ ジ ｽﾞ ズ ｾﾞ ゼ ｿﾞ ゾ ﾀﾞ ダ ﾁﾞ ヂ 
ﾂﾞ ヅ ﾃﾞ デ ﾄﾞ ド ﾊﾞ バ ﾊﾟ パ ﾋﾞ ビ ﾋﾟ ピ ﾌﾞ ブ ﾌﾟ プ ﾍﾞ ベ ﾍﾟ ペ ﾎﾞ ボ ﾎﾟ ポ);
$hankana=1;
}return($hankana);}

##########################################################

################
#   SendMail   #
################
sub SendMail{ my($type,$to,$from,$cc,$bcc,$fname,$attach)=@_;
my($boundary,$file,$path);
(!$to) and return(0);
if($fname ne ''){
    $name=$fname;
    &$JCODE(\$name,'jis');
    $name=&EncodeM($name);
    $from="$name <$from>";
}my@files=@{$attach};
local($subject,$body)=&$type;
&$JCODE(\$subject,'jis');
&$JCODE(\$body,'jis');
$subject=&EncodeM($subject);
open(ML,"| $CNF{Mail}{Sendmail} -t") or return(0);
# open(ML,">>$DataDir/$type.txt");# ─TEST
print ML "MIME-Version: 1.0\n";
print ML "To: $to\n";
print ML "Cc: $cc\n" if($cc);
print ML "Bcc: $bcc\n" if($bcc);
print ML "From: $from\n";
print ML "Subject: $subject\n";
print ML "X-Mailer: $Ver\n";
print ML "X-Http-Referer: $BaseDir/$MainCGI\n";
print ML "X-User-Agent: $ENV{HTTP_USER_AGENT}\n" if($type=~/_admin$/i);
print ML "X-Host: $ENV{REMOTE_ADDR}\n" if($type=~/_admin$/i);
if(@files>=1){
    $boundary='==='.$PID.time.'===';
    print ML qq(Content-Type: multipart/mixed; boundary="$boundary"\n\n);
    print ML "--$boundary\n";
}print ML "Content-Transfer-Encoding: 7bit\n";
print ML qq(Content-Type: text/plain; charset="ISO-2022-JP"\n\n);
print ML "$body\n";
foreach$path(@files){
    (!-e$path) and next;
    ($file)=$path=~/([^:\/\\]+)$/;
    print ML "--$boundary\n";
    print ML qq(Content-Type: application/octet-stream; name="$file"\n);
    print ML qq(Content-Disposition: attachment; filename="$file"\n);
    print ML "Content-Transfer-Encoding: Base64\n\n";
    my$tmp=&EncodeB(undef,$path,'n');
    print ML "$tmp\n";
}print ML "--$boundary--\n" if(@files>=1);
print ML "\n";
close(ML);}

###############
#   EncodeB   #
###############
sub EncodeB{ my($line,$file,$nflag)=@_;
my($eline,$len)='';
if($file ne ''){ $len=(-s$file);
    if(open(ENCODEB,$file)){ binmode(ENCODEB);
        while(read(ENCODEB,$buff,45)){
            $eline.=substr(pack('u',$buff),1);
            chop($eline);
        }close(ENCODEB);
    }
}else{ $len=length($line);
    while($line=~/(.{1,45})/gs){
        $eline.=substr(pack('u',$1),1);
        chop($eline);
    }
}$eline=~tr|` -_|AA-Za-z0-9+/|;
my$pnum=(3-($len % 3)) % 3;
my$pdg='='x$pnum;
substr($eline,-$pnum,$pnum,$pdg);
if($nflag){
    $eline=~s/(.{76})/$1\n/gs;
    $eline=~s/\n$//;
}return($eline);}

###############
#   EncodeM   #
###############
sub EncodeM{ my$line=shift;
$line='=?ISO-2022-JP?B?'.&EncodeB($line).'?=';
return($line);}

###################
#   MailConvert   #
###################
sub MailConvert{ my$buff=shift;
$buff=&UnAutoLink($buff);
$buff=&HtmlDecode($buff);
$buff=~s/<BR>/\n/g;
return($buff);}

##########################################################