#!/usr/local/bin/perl ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); @wday_array = ('日','月','火','水','木','金','土'); $date_now = sprintf("%04d年%01d月%01d日(%s)%02d時%02d分%02d秒",$year +1900,$mon +1,$mday,$wday_array[$wday],$hour,$min,$sec); $hhmm = sprintf("%02d:%02d",$hour,$min); $tim = 9; $pmon=$mon; $ppmon=$pmon+1; require 'jcode.pl'; $log="./puta.dat"; $kakolog="./kako.dat"; $COPYRIGHT='

[戻る]'."\n"; $COPYRIGHT2='

カウンター

'."\n"; if($ENV{'QUERY_STRING'}){ ($value=$ENV{'QUERY_STRING'}) =~ s/[\n\r\+ ]//g; $value =~ s/%(\w\w)/pack("C", hex($1))/eg; $value =~ s/
☆新商品!
キーワード:
登録:
   (送信文字の語尾に?を付けると、ニャン子が返事をします)
   (送信文字の語尾に。を付けると、新商品一覧に登録します)
EOL open(IN,$log); @olds=; close(IN); open(IN,$kakolog); @kako=; close(IN); if ($FORM{'b'}) { $ccc = $uname; (@fff) = split(/・/,$olds[0]); foreach $fff(@fff) { if ($fff =~ m/$ccc/) { push(@bbb,"・$fff");} } if ($bbb[0] ne "") { @henji = "検索結果:"; push(@henji,"@bbb"); print "

@henji

\n"; } else { @henji = "検索結果:該当するものはありませんでした。"; print "

@henji

\n"; } } if ($FORM{'a'}) { (@kkk) = split(/・/,$kako[0]); foreach $kkk(@kkk) { if ($uname !~ /(?)$/) { if ($kkk =~ /?/) { push(@ans,"・$kkk");} } else { if ($kkk !~ /。/) { if ($kkk !~ /?/) { push(@ans,"・$kkk"); } } } } $ccc = substr($uname,0,4); @henji = "☆ニャン子で~す:"; @henji2 = "追加登録しました:"; srand(time); @aaa = @ans; @eee = @aaa; (@fff) = split(/・/,$olds[0]); foreach $fff(@fff) { if ($fff =~ m/$ccc/) { push(@bbb,"・$fff");} } if ($bbb[0] ne "") { @henji = "関連情報だよ~:"; push(@henji,"@bbb"); } else { foreach $eee(@eee) { if ($eee =~ m/$ccc/) { push(@bbb,"$eee");} } if ($bbb[0] ne "") { @bbbb = split(/・/,splice(@bbb,rand @bbb,1)); push(@henji,"@bbbb"); } else { @bbbb = split(/・/,splice(@aaa,rand @aaa,1)); push(@henji,"@bbbb");} } (@mmm) = split(/>/,$olds[0]); foreach $mmm(@mmm) { $mmm =~ s/r/r>/g; } if (@mmm[200] ne "") { pop(@mmm);} if ($uname =~ /。/||$uname =~ /。/) { $new="・$uname($ppmon/$mday)
"; open(OUT,"> $log"); print OUT $new,@mmm; close(OUT); print "@henji2$new\n";} else { $new="・$uname
"; open(OUT,"> $kakolog"); print OUT $new,@kako; close(OUT); print "

@henji

\n";} } print "

@olds\n"; print $COPYRIGHT,"\n"; print $COPYRIGHT2,"\n"; ########################### #送信 ########################### sub Send { require 'mimew.pl'; $subject = "新商品!" ; $mess = "$uname"; $mess =~ s/^\.\n/\.\./; $mess =~ s/\n\.\n/\n\.\.\n/g; open(IN,"$MailAddFile") || &error("メールアドレスファイルを開けません。"); @mails=; close(IN); foreach $mail (@mails){ $mail =~ s/[\r\n]//g; ($mail)=(split(/\,/,$mail))[0]; if($mail =~ /\@/){ &jcode'convert(*subject,'jis'); &jcode'convert(*mess,'jis'); open(SMTP,"| $SendmailCmnd $mail"); print SMTP <<"EOL"; From: $AdminMail To: $mail Subject: $subject Content-Transfer-Encoding: 7bit Content-Type: text/plain $subject $mess EOL close(SMTP); } } } exit; ########################### #エラー ########################### sub error { ($word)=@_; print <<"EOL"; Content-type: text/html WebMail Error

$word

$COPYRIGHT

EOL } exit; ################################################# # フォームからの読み込み ################################################# sub GetFormdata { local($buffer,$name,$value,@pairs); if ($ENV{'REQUEST_METHOD'} eq "POST"){ read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }else{ $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/,$buffer); foreach (@pairs) { ($name, $value) = split(/=/, $_); $value =~ tr/+/ /; $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; &jcode'convert($value,'sjis'); $value =~ s/[\r\n]/\n/g; $FORM{$name} = $value; } } exit; ################################################# # 送信終了 ################################################# sub after { print <<"EOL"; Content-type: text/html WebMail

メールを送信しました。 $new

EOL }