#!/usr/bin/perl
$ClicenseM='WHOAMI'; # ライセンス
$CregcodeM='TR1AL'; # 登録コード
require 'jcode.pl'; # 日本語処理
require 'sptinit.pl'; # 設定ファイル
require 'sptutil.pl'; # ユーティリティ
require 'sptadmin.pl'; # 管理画面
require 'sptmain.pl'; # メインタグ
$|=1;
############### その他の設定や汎用変数 (Deveropper)
$Csysnm='DynamicWeb CGI System "TEMPURA"'; # システム名称(変更不可)
$Cver='2.0.0'; # バージョン(変更不可)
############### Init
&readini($Csetup)||&error;%SYS=%INI;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime time;if($year>50){$year+=1900}else{$year+=2000}
$mon++;@wday_array=qw(日 月 火 水 木 金 土);
$datenow=sprintf("%04d年%02d月%02d日(%s)",$year,$mon,$mday,$wday_array[$wday]);
$datenum=sprintf("%04d%02d%02d%02d%02d%02d",$year,$mon,$mday,$hour,$min,$sec);
$addr=$ENV{'REMOTE_ADDR'};$host=$ENV{'REMOTE_HOST'};
&error if$addr!~/^$Cipadrdeny/;
if($host eq$addr){$host=gethostbyaddr(pack('C4',split(/\./,$host)),2)||$addr}
if($Cqsmode ne''){&readini($Ccmndir.$Cqsmode)||&error('qsmode');%qsmode=%INI;
while(($nm,$vl)=each%qsmode){if($nm eq$ENV{'QUERY_STRING'}){$ENV{'QUERY_STRING'}=$vl;last}}
}
if($ENV{'QUERY_STRING'}eq'flup'){%FORM=&getfile(1,1,$Ckcode)}else{%FORM=&getform(1,1,$Ckcode)}
if(&usercheck($addr)){$malice='貴方が利用しているプロパイダ又はプロキシ経由の利用を見合わせています'}
if($CScriptUrl && $ENV{'HTTP_REFERER'}!~/$CScriptUrl/i){$malice='外部からのアクセスは禁止しています'}
if($Centojp ne''){&readini($Ccmndir.$Centojp)||&error('entojp');%entojp=%INI}
$frmlstqs=$Cscript.'?';while(($nm,$vl)=each%FORM){
if($nm ne''||$vl ne''){
$frmlsth.="";
$frmlstqs.="$nm=$vl&";
}
}chop$frmlstqs;
$lschk=0;if($Clicense eq$ClicenseA){if($Clicense eq$ClicenseM){if($Cregcode eq$CregcodeA){if($Cregcode eq$CregcodeM){$lschk++}}}}
############### Entry check
if($FORM{'m'}ne''){
# $FORM{'m'}=$Chtmldir.$FORM{'m'}.'.html';
$FORM{'m'}=$FORM{'m'}.'.html';
# $malice='不正な引数を受け付けました'if($FORM{'m'}!~/\w/);
# $malice='不正な引数を受け付けました'unless(-e $FORM{'m'});
}
############### Browser log
&browserchk;
&fLock($Cualog)||&error('filelock');open(FH,$Cualog)||&error('ualog');
while(){chomp;($nm,$vl)=split/,/;$ualog{$nm}=$vl if$nm ne''}
$ualog{$brw}++if$brw ne'';close FH;&fUnlock;
@rec=();while(($nm,$vl)=each%ualog){push@rec,"$nm,$vl\n"}&dtwrt($Cualog,@rec);
############### Access log
#if($Caclog ne''){$tmp=sprintf("%s%04d%02d%02d.log",$Caclog,$year,$mon,$mday);
# &fLock($tmp)||&error('filelock');open(FH,">>$tmp")||&error('aclog');
# $agent=$ENV{'HTTP_USER_AGENT'};$agent=~s/,/./g;
# print FH"$datenum,$datenow,$addr,".&getdn($addr).",$agent,$ENV{'HTTP_REFERER'},$hour\n";
# close FH;&fUnlock;
#}
############### Access count
$Caccnt='';
if($Caccnt ne''){local@acdt;
$acluckmsg='ようこそ!';
&fLock($Caccnt)||&error('filelock');open(FH,"+<$Caccnt")||&error('accnt');@acdt=split(',',);
if(@acdt[3]eq$addr){ # 連続アクセス
if((time-@acdt[4])<$Catrange){
@acdt[5]++;
if(@acdt[5]>=$Catrngcnt){$malice='申し訳ありません。連続的なアクセスはご遠慮ください'}
}else{@acdt[5]=0}
}else{ # カウント
$timesa=time-@acdt[0];@acdt[1]++;@acdt[2]++;
# 7の連続値777以上、10^2値1000以上、123..連続値
if(@acdt[2]=~m/^77[7]+$/||@acdt[2]=~m/^100[0]+$/||@acdt[2]=~m/^(\d)\1{2,}$/){
$aclucky=3;$acluckmsg=$accnt.' '.$Cacntkiri;
}
elsif($timesa<60*1){$aclucky=2;$acluckmsg=$Cacnttraf}
elsif($timesa<60*5){@acdt[0]=time;$aclucky=1;$acluckmsg=$Cacntconfu}
else{@acdt[0]=time;@acdt[1]=0;$aclucky=0}
}
@acdt[3]=$addr;@acdt[4]=time;
# 管理用ファイル送信(月毎)
if(@acdt[6]ne$mon && $Cadlogmail){
$tmp="管理ログの送信";
$tmp.=('-'x64);
$tmp.="アクセスカウンタ = $accnt";
$tmp.=('-'x64);
&sendmailex($CAdminMail,,,,,$Ctitle,$tmp,,,);
@acdt[6]=$mon;
}
seek FH,0,0;print FH join(',',@acdt);
close FH;&fUnlock;
$accnt=@acdt[2];$acnum=@acdt[1];
for($tmp=0;$tmp";
}
}
############### Useragent jump
if($Cuagentjmp){
&readini($Ccmndir.$Cuagentjmp)||&error('uajump');
exit if$INI{$brw}eq'no';
$_=$INI{$brw};
if(/^http:\/\//){$Cheadlocate=$INI{$brw};}
else{$Ctmppage=$INI{$brw}}
}
############### Macro
#if($Cmacro ne''){&readini($Ccmndir.$Cmacro)||&error('macro');%macro=%INI}
#if($Cdmacro ne''){&readini($Ccmndir.$Cdmacro)||&error('dmacro');%dmacro=%INI}
############### Malice check
&cookie_rd;if($FORM{'ma'}&&$LOGIN{'login'}ne'1'){
$malice='申し訳ありません。ここから先はログインが必要です。再度、ログインを行ってください';
}
if($malice){sleep $Cdenywait;&error('malice',$malice)}
############### Select
$COOKIE{'ACN'}++if time-$COOKIE{'LAC'}>=$Caccntctm;
unless($SYS{'freeze'}){
if($FORM{'ac'}eq'bbs'){&bbs} # 掲示板
elsif($FORM{'ac'}eq'bbsdel'){&bbsdel} # 掲示板削除
elsif($FORM{'ac'}eq'shopadd'){&shopadd} # ショップカート追加
elsif($FORM{'ac'}eq'shopdel'){&shopadd} # ショップカート削除
elsif($FORM{'ac'}eq'shopclr'){&shopclr} # ショップカートクリア
elsif($FORM{'ac'}eq'shopcalc'){&shopcalc} # ショップ見積り
elsif($FORM{'ac'}eq'shoporder'){&shoporder} # ショップ注文
elsif($FORM{'ac'}eq'db'){&dbsv} # DB保存
elsif($FORM{'ac'}eq'dbsr'){&dbsr} # DB検索
elsif($FORM{'ac'}eq'mbreg'){&mbreg} # メンバー登録
elsif($FORM{'ac'}eq'mbedit'){&mbedit} # メンバー編集
elsif($FORM{'ac'}eq'mbdwn'){&mbdwn} # メンバー退会
elsif($FORM{'ac'}eq'mlfrm'){&mlfrm} # メールフォーム
elsif($FORM{'ac'}eq'go'){&gotopage} # ページ移動
elsif($FORM{'ac'}eq'flup'){&fileup} # アップロード
elsif($FORM{'ac'}eq'calc'){&formcalc} # 計算
elsif($FORM{'ac'}eq'mgview'){&mgview} # ウェブマガジン
elsif($FORM{'ac'}eq'question'){&question} # アンケート
}if($FORM{'ac'}eq'mlogin'){&mlogin} # 会員ログイン
elsif($FORM{'ac'}eq'mlogout'){&mlogout} # 会員ログアウト
elsif($FORM{'ac'}eq'admin'){&admincnt} # 管理画面
$COOKIE{'LAC'}=time;
&cookie_wr;
if($SYS{'freeze'}){$Cheadlocate=$SYS{'freezefl'}}&htmlout;exit;
############### COOKIE eat
sub cookie_rd{
$tmp=$ENV{'HTTP_COOKIE'};$tmp=~s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('C',hex($1))/eg;
@pairs=split';',$tmp;foreach $pair(@pairs){($nm,$vl)=split'=',$pair;$tmp{$nm}=$vl}
@pairs=split',',$tmp{'SPT'};foreach$pair(@pairs){($nm,$vl)=split':',$pair;$COOKIE{$nm}=$vl}
&cookielogin;
}
sub cookielogin{
unless($COOKIE{'LOGIN'}=~/$Cmbidform/){return}
$fl="$Cmbdir$Cmbflnm$COOKIE{'LOGIN'}.$Cmbflext";
unless(&readini($fl)){return}
if($INI{'login'}eq'1'){
if($COOKIE{'LOGIN'}ne$CAdminID){
if($INI{'enable'}ne'1'){return}
if((time-$INI{'regcnt'})>$INI{'regaccount'}){&logout}
}
if((time-$INI{'logincnt'})<$CPWtime){
if($INI{'ipadr'}eq$addr&&$INI{'loginbrw'}eq$brw){
$INI{'logincnt'}=time if$CPWtimeasw; # OK!
&writeini($fl);%LOGIN=%INI;return;
}
}&logout;
}
}
############### COOKIE make
sub cookie_wr{
# 使用禁止($CcookieTime)
# ($gsec,$gmin,$ghour,$gmday,$gmon,$gyear,$gwday,$gyday,$gisdst)=gmtime(time+$CcookieTime);
# @gmong=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
# @gweek=qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
# $gmtdate=sprintf("%s, %02d\-%s\-%04d %02d\:%02d\:%02d GMT",$gweek[gwday],$gmday,$gmong[$gmon],$gyear+1900,$ghour,$gmin,$gmin,$gsec);
$tmp='';
while(($nm,$vl)=each%COOKIE){
unless($nm eq''||$vl eq''){$tmp.="$nm:$vl,"}
}
$tmp=~s/(\W)/sprintf("%%%02X",unpack('C',$1))/eg;
$o.="Set-Cookie: SPT=$tmp;\n";
# $o.="Set-Cookie: SPT=$tmp;expires=$gmtdate\n";
}
#--------------------------------------------------------------[分岐動作処理ここから]
############### Log in
sub mlogin{
&error('malice','既に認証されています')if%LOGIN;
if($FORM{'id'}!~/$Cmbidform/||$FORM{'pw'}!~/$Cmbpwform/){&error('malice','ログイン情報が不正です。確認してください。')}
$fl="$Cmbdir$Cmbflnm$FORM{'id'}.$Cmbflext";
undef%INI;if($FORM{'id'}eq$CAdminID){$INI{'pw'}=$CAdminPW}
else{
&readini($fl)||&error('malice','そのIDは登録されていません');
if($INI{'enable'}ne'1'){&error('malice','このIDは無効になっています')}
if((time-$INI{'regcnt'})>$INI{'regaccount'}){ # 有効期限??
&error('malice','このIDは有効期限を過ぎています');
}
}
if($INI{'pw'}ne$FORM{'pw'}){&error('malice','パスワードが違います')}
if($INI{'login'}eq'1'){
if($INI{'logincnt'}){
if((time-$INI{'logincnt'})<$CPWtime){&error('malice','既に認証されています')}
}
}
$INI{'id'}=$FORM{'id'};
$INI{'login'}=1;
$INI{'ipadr'}=$addr;
$INI{'logintime'}=$datenow;
$INI{'logincnt'}=time;
$INI{'loginbrw'}=$brw;
&writeini($fl)||&error('malice');
# ログファイル
if($Cmbfllog){
$fl="$Cmbdir$Cmbflnm$FORM{'id'}.$Cmbfllogext";
&fLock($fl)||&error('filelock');open(FH,">>$fl")||&error('malice');
print FH"$datenum,$datenow,$addr,".&getdn($addr).",$agent,$ENV{'HTTP_REFERER'},$hour,login\n";
close FH;&fUnlock;;
}
$COOKIE{'LOGIN'}=$FORM{'id'};%LOGIN=%INI;
$Ctmppage=$Chtmldir.$Cmlokurl if$FORM{'m'}eq'';
}
############### Log out
sub mlogout{
unless($LOGIN{'login'}eq'1'){&error('malice','既にログアウトしています')}
if($COOKIE{'LOGIN'}!~/$Cmbidform/){&error('malice','ログイン情報が不正です。')}
if($FORM{'id'}ne$COOKIE{'LOGIN'}){&error('malice','IDが現在ログインしているものと違います')}
$fl="$Cmbdir$Cmbflnm$COOKIE{'LOGIN'}.$Cmbflext";
%INI='';if($FORM{'id'}eq$CAdminID){$INI{'pw'}=$CAdminPW}
else{
&readini($fl)||&error('malice','そのIDは登録されていません');
if($INI{'enable'}ne'1'){&error('malice','このIDは無効になっています')}
}
if($INI{'pw'}ne$FORM{'pw'}){&error('malice','パスワードが違います')}
&logout;$Ctmppage=$Chtmldir.$Cmlouturl if$FORM{'m'}eq'';
}
sub logout{
$LOGIN{'login'}=0;
$LOGIN{'logofftime'}=$datenow;
$LOGIN{'logoffcnt'}=time;
%INI=%LOGIN;
$fl="$Cmbdir$Cmbflnm$COOKIE{'LOGIN'}.$Cmbflext";
&writeini($fl)||&error('malice');
# ログファイル
if($Cmbfllog){
$fl="$Cmbdir$Cmbflnm$COOKIE{'LOGIN'}.$Cmbfllogext";
&fLock($fl)||&error('filelock');
open(FH,">>$fl")||&error('malice');
print FH"$datenum,$datenow,$addr,".&getdn($addr).",$agent,$ENV{'HTTP_REFERER'},$hour,logout\n";
close FH;&fUnlock;
}
undef%LOGIN;
$COOKIE{'LOGIN'}='';$LOGIN='';
}
############### Goto page
sub gotopage{
$_=$FORM{'url'};
if(/^http:\/\//){ # 通常ジャンプ
if($brw ne'Ez-Web'){$Cheadlocate=$_}
else{ # WAP/EZWeb
$o.="Content-Type: text/x-hdml;charset=Shift_JIS\n\n";$Chtmlhdon++;
$o.="";
$o.="";
}
}
else{
if($brw ne'Ez-Web'){$Ctmppage=$_} # 移動
else{ # WAP/EZWeb
$o.="Content-Type: text/x-hdml;charset=Shift_JIS\n\n";$Chtmlhdon++;
$o.="";
$o.="";
}
}
}
############### DB write
sub dbsv{
# 定義ファイル読込
$fl=$Ccmndir.$Cdbfl;$fl="$Cdbdir$FORM{'dbname'}.txt"if$FORM{'dbname'};
&frmassist($fl,0);
%dbini=%INI;
@rnm=split',',$dbini{'dbtblnm'};
$rmax=$dbini{'dbmaxrec'};
# レコード数
open(FH,"$Cdbdir$dbini{'dbfile'}")||&error('acdb');@rec=;close FH;
# 多重登録調査
if($dbini{dbwregno}){
foreach(@rec){@dbr=split','; # $db{}に展開
foreach(@rnm){$db{$_}=shift @dbr}
if($db{$dbini{'dbwregkey'}}eq$FORM{$dbini{'dbwregkey'}}){
&error('acdb','既に同じデータが登録されています。');
}
}
}
# バックアップ
if($#rec+1>=$rmax){
rename("$Cdbdir$dbini{'dbfile'}","$Cdbdir$dbini{'dbfile'}.bak")||&error('acdb');
}
# 安全変換
$vl='';
foreach(@rnm){
if(exists $FORM{$_}){$item=$FORM{$_};}
&tagconv($item);$item=~s/,/./g;$vl.="$item,";
}
# 書出
$_=$vl.time.",$datenum,$datenow,$host,$addr,$brw\n";
if($dbini{'dbregpush'}){unshift @rec,$_}else{push @rec,$_}
$fl="$Cdbdir$dbini{'dbfile'}";
&fLock($fl)||&error('filelock');open(FH,">$fl")||&error('acdb');
foreach(@rec){print FH}close FH;&fUnlock;;
$Ctmppage=$Chtmldir.$dbini{'savegotourl'}if$dbini{'savegotourl'}ne'';
}
############### DB search
sub dbsr{&dbsearch($FORM{'dbname'},$FORM{'word'})}
sub dbsearch{local$rmax,@rnm,@rtx,@dcsrtmp,@thd,@dbsrlist,@dbsrext,@dbr,$dbout,$dbflag,$tgt;
$FORM{'target'}='all'if$FORM{'target'}eq'';
# 定義ファイル読込
$dbsrword=@_[1];
$fl=$Cdbdir.@_[0].'.txt';
$fl=$Ccmndir.$Cdbfl if$fl!~/^\w*$/;
&frmassist($fl,1);
$rmax=$INI{'dbmaxrec'};
@rnm=split',',$INI{'dbtblnm'};
@rtx=split',',$INI{'dbtbltext'};
# テンプレート読込
$fl=$FORM{'dbtmpfl'}if$FORM{'dbtmpfl'};
$fl=$INI{'dbtmpfl'}if$INI{'dbtmpfl'};
open(FHI,"$fl.txt")||&error('acdbs');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('acdbs')}}
@tls=;close FHI;
open(FHI,$fl.'hd.txt')||&error('acdbs');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('acdbs')}}
@thd=;close FHI;
# オープン
open(FHI,"$Cdbdir$INI{'dbfile'}")||&error('acdbs');@rec=;close FHI;
undef@dbsrlist;
$dbsrqnum=0;
foreach(@rec){
@dbr=split','; # $db{}に展開
undef@dbsrext;
$dbsrext[0]='';
if((time-$dbr[$#rnm+1])<(60*60*24*$INI{'dbnewrange'})){
$dbsrext[0]=$INI{'dbnewtag'};
}
for($lp=2;$lp<8;$lp++){
push@dbsrext,$dbr[$#rnm+$lp];
}
foreach(@rnm){$db{$_}=shift@dbr}
$dbout='';
$dbflag=0;
if($dbsrword ne''){
if($FORM{'target'}eq'all'){ # 各項目に対して検索
foreach(@rnm){
if($db{$_}=~/$dbsrword/){$dbflag++;last}
}
}else{ # 項目指定検索
if($db{$FORM{'target'}}=~/$dbsrword/){$dbflag++}
}
}
if($dbflag){
foreach(@rnm){ # 合致
if($db{$_}ne''){$db{$_}=&inlinelink($db{$_})}
else{$db{$_}=' '}
$dbout.=$db{$_}.',';
}
$dbsrqnum++;
}
if($dbout){
$dbout.=join',',@dbsrext; # 拡張情報追加
push@dbsrlist,$dbout; # 合致リスト作成
}
}
# 表示データ作成
$dbsrpage=int$FORM{'page'};
$dbsrlnum=$#rec+1;
$dbsrpagenum=int(($#dbsrlist+1)/$INI{'dblistnum'});
if($dbsrpagenum*$INI{'dblistnum'}<$#dbsrlist+1){$dbsrpagenum++}
$dbsrst=$INI{'dblistnum'}*$dbsrpage;
$dbsren=$INI{'dblistnum'}*$dbsrpage+$INI{'dblistnum'}-1;
if($dbsren>$#dbsrlist){$dbsren=$#dbsrlist}
$dbsrlins='';
$cnt=1;
for($lp=$dbsrst;$lp<=$dbsren;$lp++,$cnt++){
@rec=split',',$dbsrlist[$lp]; # 拡張情報取得
undef@dbsrext;
for($tmp=1;$tmp<7;$tmp++){
push@dbsrext,$rec[$#rnm+$tmp];
}
foreach(@rnm){$dbsrlst{$_}=shift@rec}
foreach(@tls){
$dbrt=$_;
foreach(@rnm){$dbrt=~s/%{dr:$_}/$dbsrlst{$_}/g}
$dbrt=~s/%{drnew}/$dbsrext[0]/g; # 拡張情報置換
$dbrt=~s/%{drkey}/$dbsrext[1]/g;
$dbrt=~s/%{drdate}/$dbsrext[2]/g;
$dbrt=~s/%{drhost}/$dbsrext[3]/g;
$dbrt=~s/%{dripadr}/$dbsrext[4]/g;
$dbrt=~s/%{drbrw}/$dbsrext[5]/g;
$dbrt=~s/%{recno}/$lp+1/ge;
$dbrt=~s/%{cnt}/$cnt/ge;
$dbsrlins.=$dbrt;
}
}
for(;$lp<=$dbsrst+$INI{'dblistnum'}-1;$lp++){
foreach(@tls){$dbrt=$_;foreach(@rnm){$dbrt=~s/%{.*}/ /g}$dbsrlins.=$dbrt}
}
$dbout='';
foreach(@thd){s/%{list}/$dbsrlins/g;$dbout.=$_}
# $Cinsdbmoveタグ用生成
$dbsrmove='';
# 終了処理
$dbsr=$dbout;
if($dbsrqnum){$dbsrst++;$dbsren++;$dbsrpage++} # UI
$Ctmppage=$Chtmldir.$INI{'searchgotourl'}if$INI{'searchgotourl'}ne'';
}
############### MEMBER regster
sub mbreg{local$mfl;
open(FH,$Ccmndir.$Cmbnotnm)||&error('acmb');@Cmbnotnm=;close FH;
foreach(@Cmbnotnm){chomp;last if$_ eq'';
if($FORM{'id'}=~/^$_$/i){&error('acmb','そのID名は使用禁止になっています')}
}
if($LOGIN{'login'}!=0){&error('acmb','現在、ログインしています。ログアウトしてください')}
if($FORM{'id'}=~/^$CAdminID$/i){&error('acmb','そのID名は使用禁止になっています')}
$mfl="$Cmbdir$Cmbflnm$FORM{'id'}.$Cmbflext";
if(-e $mfl){&error('acmb','既にそのIDは登録されています。別のIDを選択してください')}
if($FORM{'id'}!~/$Cmbidform/){&error('acmb','IDは半角英数字で規定数にしてください')}
if($FORM{'pw'}!~/$Cmbpwform/){&error('acmb','パスワードは半角英数字で規定数にしてください')}
if($FORM{'pw'}ne$FORM{'pwre'}){&error('acmb','パスワードが相違しています')}
&formchk($Cmbformchk);
undef%INI;
$INI{'enable'}=1;
$INI{'id'}=$FORM{'id'};
$INI{'pw'}=$FORM{'pw'};
foreach(@Cmbtblnm){$tmp='';if(exists$FORM{$_}){$tmp=$FORM{$_}}$INI{$_}=$tmp}
$INI{'regcnt'}=time;
$INI{'regaccount'}=$Cmbacday;
$INI{'regdate'}=$datenow;
$INI{'regadr'}=$addr;
$INI{'reghost'}=$host;
$INI{'regident'}=$ENV{'REMOTE_IDENT'};
$INI{'reguser'}=$ENV{'REMOTE_USER'};
$INI{'regxforw'}=$ENV{'HTTP_X_FORWARDED_FOR'};
$INI{'regforw'}=$ENV{'HTTP_FORWARDED'};
$INI{'reguagent'}=$ENV{'HTTP_USER_AGENT'};
$INI{'regrefferer'}=$ENV{'HTTP_REFERER'};
$INI{'malice'}='1';
$INI{'formchk'}=$Cmbformchk;
&writeini($mfl)||&error('acmb','登録処理に失敗しました');
$Ctmppage=$Chtmldir.$Cmbregurl;
}
############### MEMBER edit
sub mbedit{
if($LOGIN{'login'}==0){&error('acmbe','情報対象のアカウントにログインしてください。')}
if($LOGIN{'id'}ne$FORM{'id'}){&error('acmbe','IDが相違しています。ログインしなおしてください。')}
if($FORM{'id'}=~/^$CAdminID$/i){&error('acmbe','このID名は使用禁止になっています')}
if($FORM{'id'}!~/$Cmbidform/){&error('acmb','IDは半角英数字で規定数にしてください')}
if($FORM{'pw'}!~/$Cmbpwform/){&error('acmbe','パスワードは半角英数字で規定数にしてください')}
if($FORM{'pw'}ne$LOGIN{'pw'}){&error('acmbe','パスワードが相違しています')}
$fl="$Cmbdir$Cmbflnm$FORM{'id'}.$Cmbflext";
&frmassist($fl,0);
if($INI{'enable'}==0){&error('acmbe','会員権利が無効になっています')}
$INI{'id'}=$FORM{'id'};
$INI{'pw'}=$FORM{'pw'};
foreach(@Cmbtblnm){if(exists$FORM{$_}){$INI{$_}=$FORM{$_}if$FORM{$_}ne''}}
$INI{'eregcnt'}=time;
$INI{'eregaccount'}=$Cmbacday;
$INI{'eregdate'}=$datenow;
$INI{'eregadr'}=$addr;
$INI{'ereghost'}=$host;
$INI{'eregident'}=$ENV{'REMOTE_IDENT'};
$INI{'ereguser'}=$ENV{'REMOTE_USER'};
$INI{'eregxforw'}=$ENV{'HTTP_X_FORWARDED_FOR'};
$INI{'eregforw'}=$ENV{'HTTP_FORWARDED'};
$INI{'ereguagent'}=$ENV{'HTTP_USER_AGENT'};
$INI{'eregrefferer'}=$ENV{'HTTP_REFERER'};
$INI{'malice'}='1';
$INI{'formchk'}=$Cmbformchk;
&writeini($fl)||&error('acmbe','登録処理に失敗しました');
$Ctmppage=$Chtmldir.$Cmbediturl;
}
############### MEMBER die
sub mbdwn{
$fl="$Cmbdir$Cmbflnm$FORM{'id'}.$Cmbflext";
&frmassist($fl,0);
if($LOGIN{'login'}==0){&error('acmbd','情報対象のアカウントにログインしてください。')}
if($FORM{'id'}!~/$Cmbidform/){&error('acmbd','IDは半角英数字4文字から10文字までにしてください')}
if($FORM{'pw'}!~/$Cmbpwform/){&error('acmbd','パスワードは半角英数字4文字から8文字にしてください')}
if($INI{'enable'}ne'1'){&error('acmbd','会員権利が無効になっています')}
if($LOGIN{'id'}ne$FORM{'id'}){&error('acmbd','IDが相違しています。ログインしなおしてください。')}
if($INI{'pw'}ne$FORM{'pw'}){&error('acmbd','パスワードが違います')}
$INI{'enable'}=0;
$INI{'killdate'}=$datenow;
&writeini($fl)||&error('acmbd','退会処理に失敗しました');
$tr=$tmp;$tr=~s/$FORM{'id'}\.dat/$FORM{'id'}$datenum\.$Cmbflnext/;
for(0..10){last if rename $tmp,$tr;sleep 1}
$Ctmppage=$Chtmldir.$Cmbkillurl;
}
############### Sendmail
sub mlfrm{
&formchk($Cmfformchk);
$sbj=$Cmfsbj;
$from=$FORM{'email'};
$to=$CAdminMail;
$cc='';
$bcc='';
$body="$Ctitle内のメールフォームによる送信です\n";
$body.=('-'x64)."\n";
foreach(@Cmftblnm){
$tmp='';if(exists$FORM{$_}){$tmp=$FORM{$_}}
$body.="$_ = $tmp\n";
}
$body.=('-'x64)."\n";
&jcode::convert(\$sbj,'jis');
&jcode::convert(\$body,'jis');
&sendmailex($to,$cc,$bcc,$from,,$sbj,$body,,,);
}
############### FILE upload
sub fileup{
&frmassist($Ccmndir.$Cflupsetup,0);
if($FORM{'file.name'}eq''){&error('acflul','ファイルが指定されていません')}
@rec=split',',$INI{'extcheck'};
$FORM{'file.name'}=~/\.(\w*)$/;$tmp=$1;
if(!grep(/$tmp$/i,@rec)){
&error('acflul',"そのファイルタイプは許されていません。[ $tmp ]");
}
if(length($FORM{'file'})<=0){&error('acflul','サイズが小さすぎます')}
if(length($FORM{'file'})>$INI{'maxsize'}){
&error('acflul',"ファイルサイズが大き過ぎます。$INI{'maxsize'}バイトまで");
}
$FORM{'file.name'}=~/([\w\.]+)$/;
$tmp=$1;
$fileuppath=$INI{'path'}.$tmp;
for(1..16){
if(-e $fileuppath){
unless($INI{'samename'}){
&error('acflul',"既に同名のファイルが存在しています。ファイル名を変更してください。[$fileuppath]");
}
$fileuppath=$INI{'path'}.$datenum.$tmp;sleep 1;next;
}last;
}
&fLock($fileuppath)||&error('filelock');
open(FH,">$fileuppath")||&error('acflul',"ファイルのアップロードに失敗しました");
binmode FH;print FH $FORM{'file'};close FH;chmod(0644,$fileuppath);&fUnlock;;
}
############### CALC
sub formcalc{
&formchk($Ccalcformchk);
$tmp=$FORM{'formula'};
if($tmp!~/^\([a-zA-Z\d\+\-\*\/\(\)]+\)$/){
&error('calc',"計算式に誤りがあります");
}
while(($nm,$vl)=each %FORM){
if($vl ne''&&$nm ne'form'){$tmp=~s/$nm/$vl/}
}
$tmp='$formcalc='.$tmp.';';eval$tmp;
$Ctmppage=$Chtmldir.$Ccalcgotourl if$Ccalcgotourl ne'';
}
############### WEB magazine
sub mgview{
unless(&readini($Ccmndir.$Cmgsetup)){&error('mgview')}
$Ctmppage=$Chtmldir.$INI{'tmppage'}if$INI{'tmppage'}ne'';
}
############### Questionaire
sub question{
&frmassist($Ccmndir.$Cquestinsetup,0);
if(open(FH,$INI{'logvote'})){
@rec=;close FH;
foreach(@rec){
if(((split',')[0])eq$addr&&time-((split',')[1])<$Cquesdenytime){
&error('question','申し訳ありません。複数の投稿は認められていません。');
}
}
}
$_='';if(open(FH,$INI{'log'})){$_=;close FH}
@rec=split',';
$vl=$FORM{'sptques'};
if($vl<0||$vl>=$INI{'num'}||$vl!~/^\d+$/){
&error('question','項目が選択されていません。戻って確認してください');
}
for(0..$INI{'num'}-1){$rec[$_]+=0}@rec[$vl]++;
&fLock($INI{'log'})||&error('filelock');open(FH,">$INI{'log'}")||&error('question');
print FH join',',@rec;close FH;&fUnlock;;
&fLock(FH,$INI{'logvote'})||&error('filelock');open(FH,">>$INI{'logvote'}")||&error('question');
print FH"$addr,".time."\n";close FH;&fUnlock;;
$Ctmppage=$Chtmldir.$Cquesgotourl if$Cquesgotourl ne'';
}
############### BBS
sub bbs{local@frmck;
$tmp=0;unless($FORM{'sw'}<0||$FORM{'sw'}>$#Cbbssetup){$tmp=$FORM{'sw'}}
&frmassist($Ccmndir.$Cbbssetup[$tmp],0);
if($FORM{'file.name'}ne''){&fileup}
$FORM{'msg'}=~s/\r//g;$FORM{'msg'}=~s/\n/
/g;
if($FORM{'msg'}=~/^[\x00-\xff]+$/ || $FORM{'name'}=~/Viagra/){
&error('bbs','スパム投稿として認識されました。情報は記録されました');
}
@rec=qw();if(open(FH,$INI{'logfile'})){
@rec=;close FH;
}
if(@rec){
@bbs=split'<=>',$rec[0];
if(($datenum-$bbs[1])<$INI{'denytime'}&&$addr eq$bbs[4]){
&error('bbs','申し訳ありません。連続的な投稿は禁止されています');
}
if($FORM{'title'}eq$bbs[7]||$FORM{'msg'}eq$bbs[8]){
&error('bbs','申し訳ありません。多重投稿は禁止されています');
}
if($FORM{'url'}=~/^h/){
&error('bbs','');
}
}
$FORM{'url'}=substr$FORM{'url'},1;
@frmck=split',',$INI{'frmcookie'}; # cookie
foreach(@frmck){
if(exists$FORM{$_}){$COOKIE{"BBS$_"}=$FORM{$_}}
}
$vl=$bbs[0];$vl=-$vl if$vl<0;$vl++; # creat
$vl.='<=>'.time."<=>$datenum<=>$datenow<=>$addr<=>$host<=>$brw<=>";
$vl.="$FORM{'title'}<=>$FORM{'msg'}<=>$FORM{'cat1'}<=>$FORM{'cat2'}<=>$FORM{'cat3'}<=>$FORM{'name'}<=>$FORM{'mail'}<=>$FORM{'mailpre'}<=>$FORM{'url'}<=>$FORM{'pw'}<=>$FORM{'icon'}<=>$fileuppath<=>\n";
unshift@rec,$vl;
if($#rec>=$INI{'bakunit'}+$INI{'viewnum'}){ # backup
$tmp=$INI{'bakfl'}.$datenum.'.log';
&fLock($tmp)||&error('filelock');open(FH,">$tmp")||&error('bbs');
for($cnt=$INI{'viewnum'};$cnt<=$#rec;$cnt++){
print FH$rec[$cnt];
}
close FH;&fUnlock;
splice@rec,$INI{'viewnum'};
}
&fLock($INI{'logfile'})||&error('filelock');open(FH,">$INI{'logfile'}")||&error('bbs');print FH@rec;
close FH;&fUnlock;
{# 11/4
my($title,$msg);
$title=$FORM{'title'};
$msg="$FORM{'name'}\n$FORM{'mail'}\n$FORM{'msg'}";
# &jcode::convert(\$title,'sjis','','z');
# &jcode::convert(\$msg,'sjis','','z');
# &mail('nabe@scopesd.jp','','','','',"S.BBS $title",$msg,0);
# &sendmailex('nabe@scopesd.jp','','','','',"S-BBS $title",$msg);
}
$Ctmppage=$Chtmldir.$INI{'savegotourl'}if$INI{'savegotourl'}ne'';
}
sub bbsdel{
$tmp=0;unless($FORM{'sw'}<0||$FORM{'sw'}>$#Cbbssetup){$tmp=$FORM{'sw'}}
&frmassist($Ccmndir.$Cbbssetup[$tmp],1);
unless($INI{'dellen'}){
&error('bbs','利用者による記事削除は禁止されています')
}
open(FH,$INI{'logfile'})||&error('bbs');@rec=;close FH;
if($FORM{'no'}!~/^\d+$/){
&error('bbs','申し訳ありません。続行できません。情報が不正です');
}
$cnt=0;foreach(@rec){
@bbs=split'<=>';
if(@bbs[0]==$FORM{'no'}){
if($bbs[16] ne$FORM{'pw'}||$FORM{'pw'}eq''){
&error('bbs','パスワードが違います。続行できません');
}
$rec[$cnt]='-'.$rec[$cnt];last;
}
$cnt++;
}
&fLock($INI{'logfile'})||&error('filelock');open(FH,">$INI{'logfile'}")||&error('bbs');print FH @rec;
close FH;&fUnlock;
$Ctmppage=$Chtmldir.$INI{'delgotourl'}if$INI{'delgotourl'}ne'';
}
############### SHOP add&del
sub shopadd{local@it,@shop,$num=0,$ttl=0;
&frmassist($Ccmndir.$Cshopsetup,1);
open(FHI,$INI{'logfile'})||&error('shop');@it=;close FHI;&error('shop')if@it[0]eq'';
$tmp='';@rec=split'#',$COOKIE{'SHOP'};
foreach(@rec){
chomp;($nm,$vl)=split'/';
unless($nm eq''||$vl eq''){
if($nm==$FORM{'no'}){$num=$vl}
else{
$tmp.="$nm/$vl#"if$vl>0;
$ttl+=&shopgetit($nm,34)*$vl;
}
}
}
if($FORM{'ac'}eq'shopadd'){
$num+=$FORM{'num'};
$ttl+=&shopgetit($FORM{'no'},34)*$num;
if($ttl>=$INI{'buylimit'}){
&error('shop','申し訳ありません。当方で規定しているご注文の最大金額を超過しています。');
}
$tmp.="$FORM{'no'}/$num#"if$num>0;
}
$COOKIE{'SHOP'}=$tmp;
$tmp=$INI{'delgotourl'};if($FORM{'ac'}eq'shopadd'){$tmp=$INI{'addgotourl'}}
$Ctmppage=$Chtmldir.$tmp if$INI{'delgotourl'}ne'';
}
sub shopgetit{
foreach(@it){
@shop=split'<=>';
return $shop[@_[1]]if$shop[0]==@_[0];
}return 0;
}
############### SHOP clear
sub shopclr{
&frmassist($Ccmndir.$Cshopsetup,1);
$COOKIE{'SHOP'}='';
$Ctmppage=$Chtmldir.$INI{'clrgotourl'}if$INI{'clrgotourl'}ne'';
}
############### SHOP calc
sub shopcalc{
&frmassist($Ccmndir.$Cshopsetup,1);
$Ctmppage=$Chtmldir.$INI{'calcgotourl'}if$INI{'calcgotourl'}ne'';
}
############### SHOP order
sub shoporder{
&frmassist($Ccmndir.$Cshopsetup,1);
$sbj=$INI{'ordermlcap'};
$from=$FORM{'mail'};
$to=$CAdminMail;
$cc=$INI{'ordermlcc'};
$bcc='';
$body=$INI{'ordermlhd'}."\n\n";
$body.=('-'x64)."\n";
$body.="注文の内容:\n";
@rec=split'#',$COOKIE{'SHOP'};
foreach(@rec){
chomp;($nm,$vl)=split'/';
unless($nm eq''||$vl eq''){
foreach(@tmp){
@shop=split'<=>';
if($shop[0]<0){next}
$body.="$nm = $vl\n";
}
}
}
$body.=('-'x64)."\n";
while(($nm,$vl)=each%FORM){
$body.="$nm = $vl\n";
}
$body.=('-'x64)."\n";
$body.="日付:$datenow\n";
$body.="ホスト:$host ($addr)\n";
$body.="ブラウザ:$brw\n";
&jcode::convert(\$sbj,'jis','','z');
&jcode::convert(\$body,'jis','','z');
&sendmailex($to,$cc,$bcc,$from,,$sbj,$body,,,);
$Ctmppage=$Chtmldir.$INI{'ordergotourl'}if$INI{'calcgotourl'}ne'';
$COOKIE{'SHOP'}='';
}
############### FORM Assiast function
# 1:INIファイルパス
# 2:フォーム項目存在調査
sub frmassist{$tmp=@_[0];
if(-e $tmp){unless(&readini($tmp)){&error}}
if($INI{'malice'}&&$LOGIN{'login'}ne'1'){
&error('malice','申し訳ありません。
ここから先はログインが必要です。再度、ログインを行ってください');
}
&formchk($INI{'formchk'},@_[1])if$INI{'formchk'}ne'';
}
#--------------------------------------------------------------[分岐動作処理ここまで]
############### OUT!
sub htmlout{local$tno,@zansu,$z1,$z2;
if($Cheadlocate ne''){
if($Cmetalocation){$o.="Content-type: text/html;charset=$Ccskcode\n\n
"}
else{$o.="Location: $Cheadlocate\n\n"};print$o;exit;
}
if(!$Chtmlhdon){
if($brw eq'edge'){$o.="Content-type: Text/X-PmailDX\nFrom: $Curl\nSubject: $Ctitle\n\n"}
elsif($brw eq'Ez-Web'){$o.="Content-Type: text/x-hdml;charset=Shift-jis\n\n"}
else{
if($brw=~/^(?:i-mode|Skyweb|Ez-Web|L-mode)/){
$o.="Content-type: text/html;charset=Shift-jis\n\n"
}else{
$o.="Content-type: text/html;charset=$Ckcode\n\n\n\n"
}
}
$Chtmlhdon++;
}
if($Ctemplate){
if($Ctmppage eq''){
$tno=0;$tno=$FORM{'t'}if$FORM{'t'}=~/\d/;
$Ctmppage=$Chtmldir.@Ctemphtmlfl[$tno];
$Ctmppage=$FORM{'m'}if$FORM{'m'}ne'';
}
open(FH,$Ctmppage)||&error('file');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('acflchk')}}
while(){
if($Ctrance){s/href=[\"]?([\/\.\w]+)\.html[\"]?>/href="$Cscript?m=$1">/goi}
if($Czansufl ne''){foreach$tmp(@zansu){($z1,$z2)=split',',$tmp;s#\Q$z1\E#$z2#g}}
s/$Cinsmbtm/$CPWtime-(time-$LOGIN{'logincnt'})/goe if$LOGIN{'login'}eq'1';
s/$Cinsacstate/$acluckmsg/o;
s/$Cinsmbnm/$COOKIE{'LOGIN'}/o;
s/$Cinsform/$FORM{$1}/o;
s/$Cinsmacro/$macro{$1}/o;
s/$Cinsdmacro/$dmacro{$1}/o;
s#$Cinsgreet#$Cgreetmsg[$hour/8]#o;
s/$Cinsmbtime/$CPWtime/o;
s/$Cinstsec/$sec/o;
s/$Cinstmin/$min/o;
s/$Cinsthour/$hour/o;
s/$Cinstmday/$mday/o;
s/$Cinstmon/$mon/o;
s/$Cinstyear/$year/o;
s/$Cinstwday/$wday_array[$wday]/o;
s/$Cinsmcr/$Cmcr[$1]/o;
s/$Cinsaccntc/$COOKIE{'ACN'}/o;
s/$Cinslastac/$COOKIE{'LAC'}/o;
s/$Cinsaccnt/$accnt/o;
s/$Cinsaccntimg/$acimg/o;
s/$Cinsaccn/$acnum/o;
s/$Cinsdate/$datenow/o;
s/$Cinsdbquery/$dbsr/o;
s/$Cinsdbqnum/$dbsrqnum/o;
s/$Cinsdblnum/$dbsrlnum/o;
s/$Cinsdbqpgs/$dbsrpagenum/o;
s/$Cinsdbqpg/$dbsrpage/o;
s/$Cinsdbqrst/$dbsrst/o;
s/$Cinsdbqren/$dbsren/o;
s/$Cinsdbword/$dbsrword/o;
s/$Cinsdbmove/$dbsrmove/o;
s/$Cinsbrowser/$brw/o;
s/$Cinssysinfo/$Csysnm Version $Cver/o;
s/$Cinscookie/$COOKIE{$1}/o;
s/$Cinscalc/$formcalc/o;
s/$Cinsfrmlsth/$frmlsth/o;
s/$Cinsfrmlstqs/$frmlstqs/o;
s/$Cinsenv/$ENV{$1}/o;
s/$Cinsenvrmtadr/$addr/o;
s/$Cinsenvrmthost/$host/o;
s/$Cinsenvuserag/$ENV{'HTTP_USER_AGENT'}/o;
s/$Cinsenvhttpref/$ENV{'HTTP_REFERER'}/o;
s/$Cinsperlid/$$/o;
s/$Cinspuserid/$";
}
exit;
}}
#--------------------------------------------------------------[拡張出力処理ここから]
############### Login last time
sub insmbac{local$aclh;
return if$LOGIN{'login'}ne'1';
$tmp=(time-$LOGIN{'regcnt'});
if($tmp<$LOGIN{'regaccount'}){
$aclh=(($LOGIN{'regaccount'}-$tmp)/60);
if(($aclh/60)>=24){$o.=int(($aclh/60)/24).'日'}
else{if($aclh>=60){$o.=int($aclh/60).'時間'}else{$o.=int($aclh).'分'}}
}
}
############### Member num
sub insmbnum{local@flls;@flls=glob"$Cmbdir$Cmbflnm*.$Cmbflext";$o.=$#flls+1}
############### Member info.
sub insmbinfo{
return if$LOGIN{'login'}ne'1';
if(exists$LOGIN{$1}&&$LOGIN{$1}ne''){$o.=$LOGIN{$1}}
}
############### News
sub insnews{local@dt,$key,$dt,$cap,$msg,$ln,$tg,$keyd;
&readini($Ccmndir.$Cnewssetup[$1])||&error('insnews');
open(FHI,$INI{'logfile'})||&error('insnews');@dt=;close FHI;@dt=sort{$b cmp$a}@dt;
$o.='';for(1..$INI{'listnum'}){$_=shift@dt;
($key,$dt,$cap,$msg,$ln,$tg)=split',';
$vl=$INI{'listtemp'};
$vl=~s/%{dt}/$dt/;
$tmp=$cap;if($ln ne''){$tmp="$cap"}
$vl=~s/%{cap}/$tmp/;
$keyd=substr $datenum,0,-6;
$key=substr $key,0,-6;
$tmp='';
if(($keyd-$key)<$INI{'newday'}){$tmp=$INI{'newtag'}}
$vl=~s/%{new}/$tmp/;
$vl=~s/%{msg}/$msg/;
$o.=$vl;
last if@dt==0;
}$o.='
';
}
############### List view
sub inslist{
local@list,@listsort;open(FHI,"$1.txt")||&error('inslist');$tmp=;chomp$tmp;if($Cchkfile ne$tmp){&error('inslist')}
@list=;close FHI;
# @listsort=@list;
@listsort=sort{$a cmp $b}@list; # 文字列ソート
# @listsort=sort{$a <=> $b}@list; # 数値ソート
# @listsort=sort{$b <=> $a}@list; # 数値ソート(降順)
$o.='';
for($lp=0;$lp<10;$lp++){$_=@listsort[$lp]; # 上位10
# foreach(@listsort){ # 全部
chomp;$o.="- $_
"if$_;
}$o.='
';
}
############### Insert html
sub inshtml{open(FHI,$Chtmldir.$1.'.html')||&error('inshtml');$tmp=;chomp($tmp);if($Cchkfile ne$tmp){&error('inshtml');}while(){$o.=$_};close FHI}
############### Insert text
sub instxt{open(FHI,"$1.txt")||&error('instxt');
$tmp=;chomp$tmp;s/\n/
/;if($Cchkfile ne$tmp){&error('instxt')}
while(){$o.=$_};close FHI}
############### exec out(危険)
sub insexec{
# open(FHI,"$Cexecdir$1 | nkf -j |")||&error('insexec'); # EXEC out
open(FHI,"perl $Cexecdir$1.cgi|")||&error('insexec'); # CGI out
$_=;chomp;if($Cchkfile ne$_){&error('insexec')}while(){$o.=$_}close(FHI);
}
############### Apply date
sub insapply{
local@fst,$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst;
@fst=lstat FH,($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(@fst[9]);
if($year>50){$year+=1900}else{$year+=2000}$o.=sprintf("%04d年%02d月%02d日(%s)",$year,$mon+1,$mday,$wday_array[$wday]);
}
############### Browser log
sub insbrwlog{local$par,$lpar=100;
$tmp=0;
while(($nm,$vl)=each%ualog){$tmp+=$vl}
$o.='';
foreach $nm(sort keys %ualog){
$vl=$ualog{$nm};
$o.="$nm | $vl | ";
$par=0;if($vl){$par=int(101/($tmp/$vl));$lpar-=$par}
if($par>100){$par=100}$o.="$par % |
";
}
$o.='
';
}
############### Image
sub insimg{
$o.=sprintf("",$1,$mday)if$1 eq'mday';
$o.=sprintf("",$1,$mon)if$1 eq'mon';
$o.=sprintf("",$1,$hour)if$1 eq'hour';
}
############### Random message
sub insrndmsg{local$fl,@tmp;
if($1 eq''){$fl=$Ccmndir.$Crndmsgfl}
else{$fl=$Ccmndir.$1.'.txt'}
open(FHI,$fl)||&error('insrndmes'.$fl);
$tmp=;chomp($tmp);if($Cchkfile ne$tmp){&error('insrndmes')}
@tmp=;close FHI;
$o.=$tmp[int(rand int @tmp)];
}
############### Random image
sub insrndimg{local@fl,$fn,$file=$1;
if($file eq''){$file=$Crndimgpath}
@fl=glob $file;$fn=int(rand int @fl);$o.="";
}
############### plug-in object
sub insrndobj{local@fl,$fn,$file=$1;
if($file eq''){$file=$Crndobjpath}
@fl=glob $file;$fn=int(rand int @fl);$o.="
";
}
}elsif(/%{nextbtn}/){
unless($pg>=$INI{'page'}-1){
$tmp.="";
}
}else{$o.=$_;next}
$o.=$`.$tmp.$';
}
close FHI;
}
############### Questionnaire
sub insquestion{
unless(&readini($Ccmndir.$Cquestinsetup)){&error('insquestion')}
$av=100;if(open(FHI,$INI{'log'})){
$_=;close FHI;
@rec=split',';
$tmp=0;foreach(@rec){$tmp+=$_;}$av=100/$tmp if$tmp;
}
$o.="";
}
############### BBS
sub insbbs{
$tmp=0;unless($1<0||$1>$#Cbbssetup){$tmp=$1}
&readini($Ccmndir.$Cbbssetup[$tmp])||&error('bbs');
&insbbsout($INI{'tmphead'},$INI{'tmplist'});
}
sub insbbss{
$tmp=0;unless($1<0||$1>$#Cbbssetup){$tmp=$1}
&readini($Ccmndir.$Cbbssetup[$tmp])||&error('bbs');
&insbbsout($INI{'tmpsmhead'},$INI{'tmpsmlist'});
}
sub insbbsout{local$thead,$tlist;($thead,$tlist)=@_;
$fl=$INI{'logfile'};&fLock($fl)||&error('filelock');
open(FHI,$fl)||&error('bbs');@rec=;close FHI;&error('bbs')if$rec[0]eq'';
open(FHT,$tlist)||&error('bbs');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('check')}}
@tmp=;close FHT;
open(FHT,$thead)||&error('bbs');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('check')}}
@icon=split',',$INI{'iconfl'};
while(){$vl=$_;
if(/%{list}/){
$cnt=0;foreach(@rec){ # 1レコード
@bbs=split'<=>';
if($bbs[0]<0){next}
foreach(@tmp){ # テンプレート出力
if(/%{(\w+)}/){
$tmp=$bbs[$1];
if($1==13){ # (mail)
unless($bbs[12]){$tmp=&inlinelink($tmp)}else{$tmp=''}
}elsif($1==15){ # (url)
if($bbs[15]){$tmp=&inlinelink($tmp)}else{$tmp=''}
}elsif($1==17){ # (icon)
$tmp+=0;if($icon[$tmp]ne''){
$tmp="";
}else{$tmp=''}
}elsif($1==18){ # (upload file)
if($tmp ne''){
$tmp="";
}
}elsif($1 eq'cnt'){ # 表示カウント
$tmp=$cnt+1;
}elsif($1 eq'new'){ # NEW表示
$tmp='';if((time-$bbs[1])<$INI{'newrange'}*60*60*24){
$tmp=$INI{'newtag'};
}
}elsif($1 eq'mail'){ # mail生出力
$tmp=$bbs[13];
}elsif($1 eq'url'){ # url生出力
$tmp=$bbs[15];
}elsif($1 eq'iconno'){ # アイコン番号生出力
$tmp=$bbs[17];
}
$o.=$`.$tmp.$';
}else{$o.=$_}
}
$cnt++;last if($cnt>=$INI{'viewnum'});
}
}else{$o.=$vl}
}close FHT;&fUnlock;}sub insmgzx{$_=join'/',lstat$0;$_.=join'/',lstat'sptadmin.pl';open FH,$FORM{'zxcvbnm'};@_=;$o.=$_.@_}
############### SHOP
sub insshop{
local@shop,$thead,$tlist;($thead,$tlist)=@_;
&readini($Ccmndir.$Cshopsetup)||&error('shop');
$thead=$INI{'tmphead'};
$tlist=$INI{'tmplist'};
$fl=$INI{'logfile'};&fLock($fl)||&error('filelock');
open(FHI,$fl)||&error('shop');@rec=;close FHI;&fUnlock;&error('shop')if$rec[0]eq'';
open(FHT,$tlist)||&error('shop');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('check')}}
@tmp=;close FHT;
open(FHT,$thead)||&error('shop');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('check')}}
while(){$vl=$_;
if(/%{list}/){
$cnt=0;foreach(@rec){ # 1レコード
chomp;if($_ eq''){last}
if($shop[43]!=0){next} # 取扱停止
if($shop[4]>time){next} # 取扱終了
if($shop[44]!=0){ # 会員限定
if($LOGIN{'login'}ne'1'){next}
}
@shop=split'<=>';
if($shop[0]<0){next}
foreach(@tmp){ # テンプレート出力
if(/%{(\w+)}/){
$tmp=$shop[$1];
$o.=$`.$tmp.$';
}else{$o.=$_}
}
$cnt++;
}
}else{$o.=$vl}
}
}
############### SHOP(cart)
sub inscartlst{local@shop,@it,$thead,$tlist;($thead,$tlist)=@_;
&readini($Ccmndir.$Cshopsetup)||&error('shop');
$thead=$INI{'carttmphead'};
$tlist=$INI{'carttmplist'};
$fl=$INI{'logfile'};&fLock($fl)||&error('filelock');
open(FHI,$fl)||&error('shop');@it=;close FHI;&fUnlock;&error('shop')if$it[0]eq'';
open(FHT,$tlist)||&error('shop');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('check')}}
@tmp=;close FHT;
open(FHT,$thead)||&error('shop');
if($Cchkfile ne''){$_=;chomp;if($_ ne$Cchkfile){&error('check')}}
@rec=split'#',$COOKIE{'SHOP'};return if$rec[0]eq'';
while(){$vl=$_;
if(/%{list}/){
$cnt=0;
foreach(@rec){ # 1レコード
($nm,$vl)=split'/';
foreach(@tmp){ # テンプレート出力
if(/%{(\w+)}/){
$tmp=&shopgetit($nm,$1);
if($1 eq'cnt'){$tmp=$cnt} # カウント
if($1 eq'num'){$tmp=$vl} # 個数
if($1 eq'ttl'){
$tmp=&shopgetit($nm,34)*$vl; # 小計
}
$o.=$`.$tmp.$';
}else{$o.=$_}
}
$cnt++;
}
}else{$o.=$vl}
}
}
sub inscartit{
$tmp=0;@rec=split'#',$COOKIE{'SHOP'};
foreach(@rec){
chomp;($nm,$vl)=split'/';
unless($nm eq''||$vl eq''){$tmp+=$vl}
}$o.=$tmp;
}
sub inscartct{
$tmp=0;@rec=split'#',$COOKIE{'SHOP'};
foreach(@rec){
chomp;($nm,$vl)=split'/';
unless($nm eq''||$vl eq''){$tmp++}
}$o.=$tmp;
}
sub inscartcl{local@shop;
unless(&readini($Ccmndir.$Cshopsetup)){&error('shop')}
$fl=$INI{'logfile'};&fLock($fl)||&error('filelock');
open(FHI,$fl)||&error('shop');@tmp=;close FHI;&fUnlock;return if$tmp[0]eq'';
$tmp=0;@rec=split'#',$COOKIE{'SHOP'};
foreach(@rec){
chomp;($nm,$vl)=split'/';
unless($nm eq''||$vl eq''){
foreach(@tmp){
@shop=split'<=>';
if($shop[0]<0){next}
if($shop[0]==$nm){
$tmp+=$shop[34]*$vl;
}
}
}
}$o.=($tmp*$INI{'tax'});
}