#!/usr/bin/perl #****************************************************************************** #atlink.cgi - Automatic Link Ver.2.03 # #Version :2.03 #modified :2001/02/25 #Copyright :The Room #E-Mail :dream@lib.net #URL :http://dream.lib.net/room/ # #これはフリー素材です。 #転載・商用目的の利用の際には、メールをお願いします。 # #****************************************************************************** #1行目のperlのディレクトリ指定は、サーバによって異なります。 #詳しくは、管理者にお聞きください。 #****************************************************************************** #jcode.pl のパス $jcode = './jcode.pl'; #データ保存ファイルのパス $datafile = 'data.dat'; #管理用パスワード $adminpass = 'mk6256'; #ホームページURL $homeurl = 'http://www.kassai.co.jp/limeheart/index.html'; #****************************************************************************** #登録を管理人しかできないようにする場合は 1 を設定。 # サイト登録時には上で設定した管理用パスワードを設定してください。 $adminonly = 1; #上で 1 を設定した場合に表示するコメント $adminmsg = '管理人しか実行できません。'; #****************************************************************************** #カテゴリー表示方法 # 0-羅列 / 1-セレクトボックス $catinditype = 0; #バナーの登録・表示を行うなら 1 を設定。 $banner = 1; #コメントの入力を必須にするなら 1 を設定。 $commentent = 0; #メールアドレスの入力を必須にするなら 1 を設定。 $mailent = 0; #上で 1 を設定した場合のバナー表示サイズ（縦,横) # (0,0)の設定をすると、サイズは固定されません。 @bannersize = (88,31); #1ページに表示するサイト数 $pagein = 30; #コメント文字数制限（半角） $commentlimit = 300; #****************************************************************************** #タイトル $title = 'ライムハート特選リンク'; #ページ上部に表示するタイトル $pagetop = '
ホーム>リンク
'; #BODYタグ $bodytag = ''; #スタイルシート設定 # 必要の無い方は削除してください。 $stylesheet = < EOD #リンク表示のバナー・題名の背景色 $linkcolor1 = '#ffffff'; #リンク表示のコメント部の背景色 $linkcolor2 = '#ffffff'; #リンク表示の枠の色 $linkcolor3 ='#ffffff'; #タイトル・バナーを表示する、テーブル横幅の割合 # 100までの数値で指定してください。 $tablecols = 30; #リンクのターゲット $linktarget = '_blank'; #****************************************************************************** require $jcode; #データ受け取り $cl = $ENV{"CONTENT_LENGTH"}; if( $cl > 0 ){ read(STDIN, $qs, $cl ); }else{ $qs = $ENV{"QUERY_STRING"}; } @contents = split(/&/,$qs); foreach $i (0 .. $#contents) { local($key,$text)= split(/=/,$contents[$i]); $esearchkey = $text if $key eq 'searchkey'; $text =~ s/\+/ /g; $text =~ s/%(..)/pack("c",hex($1))/ge; $text =~ s/\r\n/\n/g; $text =~ s/\n//g; &jcode'convert(*text,'sjis'); $text =~ s//>/g; $act = $text if $key eq 'act'; $cat = $text if $key eq 'cat'; $page = $text if $key eq 'page'; $sitecat = $text if $key eq 'sitecat'; $sitename = $text if $key eq 'sitename'; $siteurl = $text if $key eq 'siteurl'; $sitebanner = $text if $key eq 'sitebanner'; $sitecomment = $text if $key eq 'sitecomment'; $sitemail = $text if $key eq 'sitemail'; $sitepass = $text if $key eq 'sitepass'; $burl = $text if $key eq 'burl'; $bpass = $text if $key eq 'bpass'; $searchkey = $text if $key eq 'searchkey'; $cond = $text if $key eq 'cond'; $act2 = $text if $key eq 'act2'; $newcat = $text if $key eq 'newcat'; $chgcat = $text if $key eq 'chgcat'; push(@selcatd,$text) if $key eq 'selcat'; } $cat ||= 0; $page ||= 0; if ($act eq "srh1"){&srh1;} elsif ($act eq "reg1"){®1;} elsif ($act eq "reg2"){®2;} elsif ($act eq "chg1"){&chg1("変更");} elsif ($act eq "chg2"){&chg2;} elsif ($act eq "chg3"){&chg3;} elsif ($act eq "del1"){&chg1("削除");} elsif ($act eq "del2"){&del2;} elsif ($act eq "del3"){&del3;} elsif ($act eq "adm1"){&adm1;} elsif ($act eq "adm2"){&adm2;} &indicate; #***************************************************************************** sub adm2{ #管理 my ($a1,$a2,@temp1,@temp2,@temp3); if ($sitepass ne $adminpass){&error("パスワードが間違っています。");} if (($act2 eq "カテゴリーを作成") && ($newcat eq "")){ &error("新しいカテゴリー名を入力してください。"); } elsif ($act2 eq "チェックしたカテゴリーを変更"){ &error("変更後のカテゴリー名を入力してください。") if $chgcat eq ""; &error("変更するカテゴリーを選択してください。") if $selcatd[0] eq ""; &error("カテゴリーは１つしか選択できません。") if $selcatd[1]; } elsif ($act2 eq "チェックしたカテゴリーを削除"){ &error("削除するカテゴリーを選択してください。") if $selcatd[0] eq ""; } if ($act2 eq ""){ open(IN,$datafile); eval{flock(IN,1)}; $a1=; close(IN); chop($a1);@temp1=split(/<>/,$a1); }else{ open(IO,"+<$datafile"); eval{flock(IO,2)}; $a1=;chomp($a1); @temp1=split(/<>/,$a1);$a1=""; if ($act2 eq "カテゴリーを作成"){ push(@temp1,$newcat); @log=; foreach(@temp1){$a1.=$_."<>";} $msg = "カテゴリーを作成しました。"; } elsif ($act2 eq "チェックしたカテゴリーを変更"){ $temp1[$selcatd[0]]=$chgcat; @log=; foreach(@temp1){$a1.=$_."<>";} $msg = "カテゴリーを変更しました。"; }else{ $a2=0; foreach(@selcatd){$temp2[$_]=1;} for(0 .. $#temp1){ if ($temp2[$_] == 0){ $a1.="$temp1[$_]<>"; $temp3[$_]=$a2; $a2++; } } while(){ @temp2=split(/<>/,$_); if ($temp3[$temp2[0]] ne ""){ push(@log,$temp3[$temp2[0]]."<>$temp2[1]<>$temp2[2]<>$temp2[3]<>$temp2[4]<>$temp2[5]<>$temp2[6]<>\n"); } } @temp1=split(/<>/,$a1); $msg = "カテゴリーを削除しました。"; } truncate(IO,0); seek(IO,0,0); print IO $a1."\n"; print IO @log; close(IO); } $msg="$msg

" if $msg; &hphead; print < $msg
現在のカテゴリー

EOD for(0 .. $#temp1){ print "$temp1[$_]
"; } print <


＊複数のカテゴリーを同時に削除できます。
＊削除したカテゴリーに属していたリンクも全て削除されます。


カテゴリー名

＊選択した１つのカテゴリーの名前を変更します。


新しいカテゴリー名

＊新たにカテゴリーを作成します。
EOD &hpfoot; } #***************************************************************************** sub adm1{ #管理 &hphead; print <
パスワードを入力してください。

パスワード
EOD &hpfoot; } #***************************************************************************** sub del3{ #削除 my (@temp1,@log); &error("パスワードが間違っています。") if ($adminonly) && ($sitepass ne $adminpass); open(IO,"+<$datafile"); eval{flock(IO,2)}; while(){ @temp1 = split(/<>/,$_); unless (($temp1[2] eq $siteurl) && (($temp1[6] eq $sitepass) || ($adminpass eq $sitepass))){ push(@log,$_); } } truncate(IO,0); seek(IO,0,0); print IO @log; close(IO); &hphead; print <
削除が完了しました。

ご利用ありがとうございました。


戻る

EOD &hpfoot; } #***************************************************************************** sub del2{ #削除 my (@temp1,@temp2); $siteurl =~ s/ //g; &error("登録したサイトURLを入力してください。") if !$siteurl; &error("パスワードを入力してください。") if !$sitepass; &error("パスワードが間違っています。") if ($adminonly) && ($sitepass ne $adminpass); open(IN,$datafile); eval{flock(IN,1)}; my $a1=; while(){ @temp1=split(/<>/,$_); if (($temp1[2] eq $siteurl) && (($temp1[6] eq $sitepass) || ($adminpass eq $sitepass))){ @temp2 = @temp1; last; } } close(IN); &error("サイトURLかパスワードが間違っています。") if !$temp2[1]; @temp1=split(/<>/,$a1); &hphead; print "

"; print < 以下のサイトを削除します。よろしければ削除ボタンを押してください。

カテゴリー $temp1[$temp2[0]]
サイト名 $temp2[1]
URL $temp2[2]

EOD &hpfoot; } #***************************************************************************** sub chg3{ #変更 &error("パスワードが間違っています。") if ($adminonly) && ($bpass ne $adminpass); &datacheck; my (@temp1,@log); open(IO,"+<$datafile"); eval{flock(IO,2)}; while(){ @temp1 = split(/<>/,$_); unless (($temp1[2] eq $burl) && (($temp1[6] eq $bpass) || ($adminpass eq $bpass))){ push(@log,$_); } } splice(@log,1,0,"$sitecat<>$sitename<>$siteurl<>$sitebanner<>$sitecomment<>$sitemail<>$sitepass<>\n"); truncate(IO,0); seek(IO,0,0); print IO @log; close(IO); @temp1 = split(/<>/,$log[0]); &hphead; print <
変更が完了しました。

カテゴリー $temp1[$sitecat]
サイト名 $sitename
URL $siteurl
バナー $sitebanner
コメント $sitecomment
メールアドレス $sitemail
パスワード $sitepass

戻る

EOD &hpfoot; } #***************************************************************************** sub chg2{ #変更 my (@temp1,@temp2); $siteurl =~ s/ //g; &error("登録したサイトURLを入力してください。") if !$siteurl; &error("パスワードを入力してください。") if !$sitepass; &error("パスワードが間違っています。") if ($adminonly) && ($sitepass ne $adminpass); open(IN,$datafile); eval{flock(IN,1)}; my $a1=; while(){ @temp1=split(/<>/,$_); if (($temp1[2] eq $siteurl) && (($temp1[6] eq $sitepass) || ($adminpass eq $sitepass))){ @temp2 = @temp1; last; } } close(IN); &error("サイトURLかパスワードが間違っています。") if !$temp2[1]; @temp1=split(/<>/,$a1); &hphead; print "

"; print < 以下のフォームに必要事項を入力し、変更ボタンを押してください。

EOD if ($banner){ print < EOD } print <
カテゴリー
サイト名
URL
バナー
（無い場合は無記入）
コメント
（半角$commentlimit字以内）
メールアドレス
パスワード
（半角英数字8字以内）

EOD &hpfoot; } #***************************************************************************** sub chg1{ #変更 $act=substr($act,0,3)."2"; &hphead; print "

"; print "".$adminmsg."

" if $adminonly; print < 登録されているサイトの$_[0]を行います。

登録したURL
パスワード
EOD &hpfoot; } #***************************************************************************** sub reg2{ #登録 &error("パスワードが間違っています。") if ($adminonly) && ($sitepass ne $adminpass); &datacheck; my (@log,@temp1); open(IO,"+<$datafile"); eval{flock(IO,2)}; while(){ @temp1=split(/<>/,$_); if ($temp1[2] eq $siteurl){ close(IO); &error("このURLは既に登録されています。"); } push(@log,$_); } splice(@log,1,0,"$sitecat<>$sitename<>$siteurl<>$sitebanner<>$sitecomment<>$sitemail<>$sitepass<>\n"); truncate(IO,0); seek(IO,0,0); print IO @log; close(IO); @temp1 = split(/<>/,$log[0]); &hphead; print <
登録が完了しました。
以下の情報は、忘れないようにメモしておいてください。

カテゴリー $temp1[$sitecat]
サイト名 $sitename
URL $siteurl
バナー $sitebanner
コメント $sitecomment
メールアドレス $sitemail
パスワード $sitepass

戻る

EOD &hpfoot; } #***************************************************************************** sub reg1{ #登録 &hphead; print "

"; print "".$adminmsg."

" if $adminonly; print < 以下のフォームに必要事項を入力し、決定ボタンを押してください。

EOD if ($banner){ print < EOD } print <
カテゴリー
サイト名
URL
バナー
（無い場合は無記入）
コメント
（半角$commentlimit字以内）
メールアドレス
パスワード
（半角英数字8字以内）

EOD &hpfoot; } #****************************************************************************** sub srh1{ #検索 &hphead; print <
登録されているサイトの検索を行います。

検索文字
条件 AND OR
EOD &hpfoot; } #****************************************************************************** sub indicate{ #リンク表示 my (@log,@temp1,$flag,$msg,$ct,$navibuf); open(IN,$datafile); eval{flock(IN,1)}; $a1=;chomp($a1); @catdata = split(/<>/,$a1); if ($act eq "srh2"){ $searchkey =~ s/　/ /g; @temp1 = split(/ /,lc($searchkey)); while(){ $flag = 0; foreach $i(@temp1){ if (index($_,$i) != -1){ $flag = 1; last if $cond; } elsif ($cond == 0){ $flag = 0; last; } } push(@log,$_) if $flag; } }else{ while(){push(@log,$_) if $_ =~ /^$cat"; if ($act eq "srh2"){ $msg .= "<<前のページ " if $page != 0; $msg .= "次のページ>> " if $log[($page+1)*$pagein] ne ""; }else{ $msg .= "<<前のページ " if $page != 0; $msg .= "次のページ>> " if $log[($page+1)*$pagein] ne ""; } $msg.=""; } $a1 = ($page+1)*$pagein; print <
$navibuf

EOD print $msg."
" if $msg; print < EOD for($page*$pagein .. ($page+1)*$pagein-1){ last if $log[$_] eq ""; @temp1 = split(/<>/,$log[$_]); if (($banner) && ($temp1[3])){ if ($bannersize[0]){ $bnr = "
"; }else{ $bnr = "
"; } }else{ $bnr=""; } print "\n"; } print <
$catdata[$cat] - $ct件
\n$bnr$temp1[1]"; print "$temp1[4]

EOD print "
".$msg if $msg; #print $navibuf; &navi2; &hpfoot; } #****************************************************************************** sub navi2{ #カテゴリー表示 my $buffer; $buffer .= "
"; if ($catinditype == 0){ for(0 .. $#catdata){ if ($_ == $cat){ $buffer .= "▼$catdata[$_]\n" }else{ $buffer .= "▼$catdata[$_]\n"; } } }else{ $buffer .= "
\n\n\n
\n"; } $buffer .= "

\n"; return $buffer; } #****************************************************************************** sub navi1{ #メニュー表示 print <
HOME   表\示   登録   変更   削除   検索   管理
EOD } #****************************************************************************** sub hphead{ #ヘッダ表示 print "Content-type:text/html; charset=shift_jis\n\n"; print < ライムハート☆リンク 香り 灯り 触れ合い サウンド 入浴 安眠休息 和風 アジアン 庭園 美術 水晶・鉱石 マイナスイオン
<<リラックスグッズと癒しアイテム>>お買い物案内/関連法規の表示
　　
$pagetop
EOD #&navi1; } #****************************************************************************** sub hpfoot{ #フッタ表示 # #著作権を消すことを禁じます。 print < EOD exit; } #****************************************************************************** sub error{ #エラー表示 &hphead; print <
$_[0]


EOD &hpfoot; } #****************************************************************************** sub datacheck{ #データチェック if ($sitecat eq ""){&error("カテゴリーを選択してください。");} elsif ($sitename eq ""){&error("サイト名を入力してください。");} elsif ($siteurl eq ""){&error("サイトURLを入力してください。");} elsif (($commentent) && ($sitecomment eq "")){&error("コメントを入力してください。");} elsif (($mailent) && ($sitemail eq "")){&error("メールアドレスを入力してください。");} elsif ($sitepass eq ""){&error("パスワードを設定してください。");} elsif (length($sitepass) > 8){&error("パスワードが長すぎます。");} elsif (length($sitecomment) > $commentlimit){&error("コメントが長すぎます。");} elsif ($sitepass =~ /[^0-9a-zA-Z]/){&error("パスワードは半角英数字のみで設定してください。");} elsif ($siteurl !~ /^https?:\/\/[\w|\:\@\-]+\.[\w|\:\!\#\%\=\&\-\|\@\~\+\.\?\/]+$/i){&error("サイトURLが間違っています。");} elsif (($sitebanner ne "") && ($sitebanner !~ /^https?:\/\/[\w|\:\@\-]+\.[\w|\:\!\#\%\=\&\-\|\@\~\+\.\?\/]+$/i)){&error("バナーURLが間違っています。");} elsif (($mailent) && ($sitemail) && ($sitemail !~ /[\w\.\-\&]+\@[\w\.\-\&]+\.[\w\.\-\&]/)){&error("メールアドレスが間違っています。");} } #******************************************************************************