Thursday, January 11, 2007
URL转向代码
http://www.supercss.com/code/3787.htm
###
###
### 欢迎来到 DarkHexerDesignSripting (DDS)!
###
### 这是我的第一个翻译的Perl程序，而且是最新版本，
### 在这里可以提供免费下载及使用。
### 如果由于此脚本对您产生任何损害，本人盖不负责。
### 在本人服务器上，该程序测试和工作都很不错，
### 不过对一些其他服务器可能会不能正常工作。
###
### 如何安装和使用...
###
### 你必须下载4个文件:
### ".htaccess" 复制到你的根目录下，如果有必要的话请改变文件所设置的路径。
### 注意对cgi脚本参数应设置为"?redir=1".
### "redir.txt" 复制到cgi-bin目录下. chmod 改为 766
### "redir.cgi" chmod 改为 755
### "ad.html" (可以重命名) 复制到任何html目录中。
###
### 改变文件中的 $ADURL 为您的实际 url.
### that should be it..
###
### 请使用"redir.cgi" 来进行WebForward
###
### http://www.darkhexer.de/dds
#!/usr/bin/perl -wT
###
###
### 欢迎来到 DarkHexerDesignSripting (DDS)!
###
### 这是我的第一个翻译的Perl程序，而且是最新版本，
### 在这里可以提供免费下载及使用。
### 如果由于此脚本对您产生任何损害，本人盖不负责。
### 在本人服务器上，该程序测试和工作都很不错，
### 不过对一些其他服务器可能会不能正常工作。
###
### 如何安装和使用...
###
### 你必须下载4个文件:
### ".htaccess" 复制到你的根目录下，如果有必要的话请改变文件所设置的路径。
### 注意对cgi脚本参数应设置为"?redir=1".
### "redir.txt" 复制到cgi-bin目录下. chmod 改为 766
### "redir.cgi" chmod 改为 755
### "ad.html" (可以重命名) 复制到任何html目录中。
###
### 改变文件中的 $ADURL 为您的实际 url.
### that should be it..
###
### 请使用"redir.cgi" 来进行WebForward
###
### http://www.darkhexer.de/dds
$ADURL ="http://www.darkhexer.de/exe/ad.html";
use CGI qw(:standard);
my @eintrag;
print "content-type:text/html\n\n";
if (param("add"))
{
###
### 添加新用户.
### 这儿可能有些小bug...
###
datenlesen ();
my $falsch=0;
my $li = param("li");
my $pw = param("pw");
my $url = param("url");
my $mail = param("mail");
my $head = param("head");
$li =~ s/[^a-z0-9]*//g;
$pw =~ s/[^a-zA-Z0-9]*//g;
$url =~ s/[^a-zA-Z0-9\/\.\:]*//g;
$mail =~ s/[^a-zA-Z0-9\.\@\-]*//g;
$head =~ s/[^a-zA-Z0-9\.\-\ ]*//g;
###
### find out whether everything is in the right order!
###
if ($li ne param("li")){
$falsch=1;
print"Wrong login-name! Use a-z and 0-9 only!
";
}
if ($pw ne param("pw")){
$falsch=1;
print"Wrong password! User a-z, A-Z and 0-9 only!
";
}
if ($url ne param("url")){
$falsch=1;
print"Wrong adress! Use a-z, A-Z, 0-9 and / only!
";
}
if ($mail ne param("mail")){
$falsch=1;
print"Wrong email-adress! Use a-z, A-Z, 0-9, \".\" and \"@\" only!
";
}
if ($head ne param("head")){
$falsch=1;
print"Wrong headline! Use a-z, A-Z, 0-9 and \".\" only!
";
}
$i=0;
while ($Name[$i]){
#print $Name[$i];
if ($li eq $Name[$i]){
$falsch=1;
print"This login already exists!
";
last;
}
$i++;
}
if (param("li") && param("pw") && param("url") && param("mail") && ($falsch ne 1))
{
###
### 看上去可以了... 新用户加入!
###
datenschreiben ();
open (Datei, ">>redir.txt");
print Datei param("li"),";;";
print Datei param("url"),";;";
print Datei param("pw"),";;";
print Datei param("head"),";;";
print Datei param("mail"),";;\n";
close (Datei);
print "Account created.
You can now ";
print"login\n";
print" to your account.";
exit;
}
###
### 提示用户给出需要的数据(如果错误的话就改变)
###
print "You can create a new account:
";
print "Please fill out all fields!";
print "";
exit;
}
if (param("li") && param("pw"))
###
### This part is used to give the Users the possibility to
### log into their accounts to change data or delete account
###
{
datenlesen ();
$ReqLi = param("li");
$ReqPw = param("pw");
$i=0;
while ($Name[$i])
{
if (($Name[$i] eq $ReqLi)&&($Password[$i] eq $ReqPw))
{
$LiOK=1;
$Nummer = $i;
last;
}
$i++;
}
if ($LiOK)
###
### Login is OK, so start edit window
###
{
my $falsch=0;
my $pw="";
if (param("np")){
$pw = param("np");
}
else {
$pw = $Password[$Nummer];
}
my $url = param("url");
my $mail = param("mail");
my $head = param("head");
$pw =~ s/[^a-zA-Z0-9]*//g;
$url =~ s/[^a-zA-Z0-9\/\.\:]*//g;
$mail =~ s/[^a-zA-Z0-9\.\@\-]*//g;
$head =~ s/[^a-zA-Z0-9\.\-\ ]*//g;
if ($pw eq param("np")){
$ReqPw = param("np");
$Password[$Nummer] = param("np");
}
else{
$ReqPw = $Password[$Nummer];
}
if (param("url")){
$Adresse[$Nummer]=param("url");
if (substr($Adresse[$Nummer],length($Adresse[$Nummer])-1,1) eq "/"){
$Adresse[$Nummer]= substr ($Adresse[$Nummer],0,length($Adresse[$Nummer])-1)
}
}
if ($Adresse[$Nummer] eq "*delete*"){
datenschreiben ($Nummer);
print "Account gel鰏cht";
exit;
}
if (param("mail")){
$eMail[$Nummer]=param("mail");
}
if (param("head")){
$Head[$Nummer]=param ("head");
}
print"Login as ",$ReqLi,"
";
print"You can now change your account-data.
";
###
### 找出是否每项都正确!
###
if (($pw ne param("np")) && (param("np"))){
$falsch=1;
print"Wrong password! Use a-z, A-Z and 0-9 only!
";
}
if ($url ne param("url")){
$falsch=1;
print"Wrong URL! Use a-z, A-Z, 0-9 and / only!
";
}
if ($mail ne param("mail")){
$falsch=1;
print"Wrong email-adress! Use a-z, A-Z, 0-9, \".\" and \"@\" only!
";
}
if ($head ne param("head")){
$falsch=1;
print"Wrong headline! use a-z, A-Z, 0-9 and \".\" only!
";
}
if ($falsch ne 1){
datenschreiben ();
}
else {
print"
Data not saved!.
";
}
print"";
print"
}
else
{
print "Login or password not ok!
\n";
print "Click back on your browser and try again";
}
exit;
}
else
{
if (!param("redir") && !param("add"))
{
print"Please type in your login and password.
";
print"";
print"
}
}
if (param("redir"))
###
### This is the main part of the script - here lies the key
### of the actual web-forwarding
###
{
@Url = split(/\//,$ENV{'REDIRECT_URL'});
$UrlNum = 1;
###
### 如果每项工作都不错(登录, 新帐号, 删除等)
###
### 如果有问题的话，请联系我: email@darkhexer.de
###
### print $Url[0],";",$Url[1],";",$Url[2],";",$Url[3],";",$Url[4],";",$Url[5];
$Url[$UrlNum]=lc $Url[$UrlNum];
datenlesen ();
$i=0;
$erfolgreich=0;
while ($Adresse[$i]){
if ($Name[$i] eq $Url[$UrlNum]){
$NewUrl = $Adresse[$i];
$j = $UrlNum+1;
for(@Url)
{
if (defined $Url[$j]) {$NewUrl = $NewUrl."/".$Url[$j]};
$j++;
}
$erfolgreich = 1;
last;
}
$i++;
}
if ($erfolgreich eq 0){
print "File not found!";
print " ",@Url;
}
if ($erfolgreich eq 1){
",$Head[$i]," print"\n";
print"\n";
print"\n";
print"\n";
print"";
}
}
sub datenlesen
### 读取用户数据，并转变为数组以便让我更容易工作
###
{
open (Datei, "redir.txt") || die "File not found";
while()
{
push(@eintrag,$_);
}
close(Datei);
$i=0;
for (@eintrag)
{
my @Data = split(/;;/,$eintrag[$i]);
$Name[$i]=$Data[0];
$Adresse[$i]=$Data[1];
$Password[$i]=$Data[2];
$Head[$i]=$Data[3];
$eMail[$i]=$Data[4];
$i++;
}
}
sub datenschreiben
###
### 将用户数据写入文件
###
{
open (Datei, ">redir.txt");
$i=0;
my $del = $_[0];
for (@Name)
{
if ( (!defined $del) || ($del ne $i) )
{
print Datei $Name[$i],";;";
print Datei $Adresse[$i],";;";
print Datei $Password[$i],";;";
print Datei $Head[$i],";;";
print Datei $eMail[$i],";;\n";
}
$i++;
}
close (Datei);
}
###
###
### 欢迎来到 DarkHexerDesignSripting (DDS)!
###
### 这是我的第一个翻译的Perl程序，而且是最新版本，
### 在这里可以提供免费下载及使用。
### 如果由于此脚本对您产生任何损害，本人盖不负责。
### 在本人服务器上，该程序测试和工作都很不错，
### 不过对一些其他服务器可能会不能正常工作。
###
### 如何安装和使用...
###
### 你必须下载4个文件:
### ".htaccess" 复制到你的根目录下，如果有必要的话请改变文件所设置的路径。
### 注意对cgi脚本参数应设置为"?redir=1".
### "redir.txt" 复制到cgi-bin目录下. chmod 改为 766
### "redir.cgi" chmod 改为 755
### "ad.html" (可以重命名) 复制到任何html目录中。
###
### 改变文件中的 $ADURL 为您的实际 url.
### that should be it..
###
### 请使用"redir.cgi" 来进行WebForward
###
### http://www.darkhexer.de/dds
#!/usr/bin/perl -wT
###
###
### 欢迎来到 DarkHexerDesignSripting (DDS)!
###
### 这是我的第一个翻译的Perl程序，而且是最新版本，
### 在这里可以提供免费下载及使用。
### 如果由于此脚本对您产生任何损害，本人盖不负责。
### 在本人服务器上，该程序测试和工作都很不错，
### 不过对一些其他服务器可能会不能正常工作。
###
### 如何安装和使用...
###
### 你必须下载4个文件:
### ".htaccess" 复制到你的根目录下，如果有必要的话请改变文件所设置的路径。
### 注意对cgi脚本参数应设置为"?redir=1".
### "redir.txt" 复制到cgi-bin目录下. chmod 改为 766
### "redir.cgi" chmod 改为 755
### "ad.html" (可以重命名) 复制到任何html目录中。
###
### 改变文件中的 $ADURL 为您的实际 url.
### that should be it..
###
### 请使用"redir.cgi" 来进行WebForward
###
### http://www.darkhexer.de/dds
$ADURL ="http://www.darkhexer.de/exe/ad.html";
use CGI qw(:standard);
my @eintrag;
print "content-type:text/html\n\n";
if (param("add"))
{
###
### 添加新用户.
### 这儿可能有些小bug...
###
datenlesen ();
my $falsch=0;
my $li = param("li");
my $pw = param("pw");
my $url = param("url");
my $mail = param("mail");
my $head = param("head");
$li =~ s/[^a-z0-9]*//g;
$pw =~ s/[^a-zA-Z0-9]*//g;
$url =~ s/[^a-zA-Z0-9\/\.\:]*//g;
$mail =~ s/[^a-zA-Z0-9\.\@\-]*//g;
$head =~ s/[^a-zA-Z0-9\.\-\ ]*//g;
###
### find out whether everything is in the right order!
###
if ($li ne param("li")){
$falsch=1;
print"Wrong login-name! Use a-z and 0-9 only!
";
}
if ($pw ne param("pw")){
$falsch=1;
print"Wrong password! User a-z, A-Z and 0-9 only!
";
}
if ($url ne param("url")){
$falsch=1;
print"Wrong adress! Use a-z, A-Z, 0-9 and / only!
";
}
if ($mail ne param("mail")){
$falsch=1;
print"Wrong email-adress! Use a-z, A-Z, 0-9, \".\" and \"@\" only!
";
}
if ($head ne param("head")){
$falsch=1;
print"Wrong headline! Use a-z, A-Z, 0-9 and \".\" only!
";
}
$i=0;
while ($Name[$i]){
#print $Name[$i];
if ($li eq $Name[$i]){
$falsch=1;
print"This login already exists!
";
last;
}
$i++;
}
if (param("li") && param("pw") && param("url") && param("mail") && ($falsch ne 1))
{
###
### 看上去可以了... 新用户加入!
###
datenschreiben ();
open (Datei, ">>redir.txt");
print Datei param("li"),";;";
print Datei param("url"),";;";
print Datei param("pw"),";;";
print Datei param("head"),";;";
print Datei param("mail"),";;\n";
close (Datei);
print "Account created.
You can now ";
print"login\n";
print" to your account.";
exit;
}
###
### 提示用户给出需要的数据(如果错误的话就改变)
###
print "You can create a new account:
";
print "Please fill out all fields!";
print "";
exit;
}
if (param("li") && param("pw"))
###
### This part is used to give the Users the possibility to
### log into their accounts to change data or delete account
###
{
datenlesen ();
$ReqLi = param("li");
$ReqPw = param("pw");
$i=0;
while ($Name[$i])
{
if (($Name[$i] eq $ReqLi)&&($Password[$i] eq $ReqPw))
{
$LiOK=1;
$Nummer = $i;
last;
}
$i++;
}
if ($LiOK)
###
### Login is OK, so start edit window
###
{
my $falsch=0;
my $pw="";
if (param("np")){
$pw = param("np");
}
else {
$pw = $Password[$Nummer];
}
my $url = param("url");
my $mail = param("mail");
my $head = param("head");
$pw =~ s/[^a-zA-Z0-9]*//g;
$url =~ s/[^a-zA-Z0-9\/\.\:]*//g;
$mail =~ s/[^a-zA-Z0-9\.\@\-]*//g;
$head =~ s/[^a-zA-Z0-9\.\-\ ]*//g;
if ($pw eq param("np")){
$ReqPw = param("np");
$Password[$Nummer] = param("np");
}
else{
$ReqPw = $Password[$Nummer];
}
if (param("url")){
$Adresse[$Nummer]=param("url");
if (substr($Adresse[$Nummer],length($Adresse[$Nummer])-1,1) eq "/"){
$Adresse[$Nummer]= substr ($Adresse[$Nummer],0,length($Adresse[$Nummer])-1)
}
}
if ($Adresse[$Nummer] eq "*delete*"){
datenschreiben ($Nummer);
print "Account gel鰏cht";
exit;
}
if (param("mail")){
$eMail[$Nummer]=param("mail");
}
if (param("head")){
$Head[$Nummer]=param ("head");
}
print"Login as ",$ReqLi,"
";
print"You can now change your account-data.
";
###
### 找出是否每项都正确!
###
if (($pw ne param("np")) && (param("np"))){
$falsch=1;
print"Wrong password! Use a-z, A-Z and 0-9 only!
";
}
if ($url ne param("url")){
$falsch=1;
print"Wrong URL! Use a-z, A-Z, 0-9 and / only!
";
}
if ($mail ne param("mail")){
$falsch=1;
print"Wrong email-adress! Use a-z, A-Z, 0-9, \".\" and \"@\" only!
";
}
if ($head ne param("head")){
$falsch=1;
print"Wrong headline! use a-z, A-Z, 0-9 and \".\" only!
";
}
if ($falsch ne 1){
datenschreiben ();
}
else {
print"
Data not saved!.
";
}
print"";
print"
Logout
\n";
print"To delete your account type in \"*delete*\" for your URL.
}
else
{
print "Login or password not ok!
\n";
print "Click back on your browser and try again";
}
exit;
}
else
{
if (!param("redir") && !param("add"))
{
print"Please type in your login and password.
";
print"";
print"
New account
\n";
print"Powered by DDS
}
}
if (param("redir"))
###
### This is the main part of the script - here lies the key
### of the actual web-forwarding
###
{
@Url = split(/\//,$ENV{'REDIRECT_URL'});
$UrlNum = 1;
###
### 如果每项工作都不错(登录, 新帐号, 删除等)
###
### 如果有问题的话，请联系我: email@darkhexer.de
###
### print $Url[0],";",$Url[1],";",$Url[2],";",$Url[3],";",$Url[4],";",$Url[5];
$Url[$UrlNum]=lc $Url[$UrlNum];
datenlesen ();
$i=0;
$erfolgreich=0;
while ($Adresse[$i]){
if ($Name[$i] eq $Url[$UrlNum]){
$NewUrl = $Adresse[$i];
$j = $UrlNum+1;
for(@Url)
{
if (defined $Url[$j]) {$NewUrl = $NewUrl."/".$Url[$j]};
$j++;
}
$erfolgreich = 1;
last;
}
$i++;
}
if ($erfolgreich eq 0){
print "File not found!";
print " ",@Url;
}
if ($erfolgreich eq 1){
print"\n";
print"\n";
print"\n";
print"";
}
}
sub datenlesen
### 读取用户数据，并转变为数组以便让我更容易工作
###
{
open (Datei, "redir.txt") || die "File not found";
while(
{
push(@eintrag,$_);
}
close(Datei);
$i=0;
for (@eintrag)
{
my @Data = split(/;;/,$eintrag[$i]);
$Name[$i]=$Data[0];
$Adresse[$i]=$Data[1];
$Password[$i]=$Data[2];
$Head[$i]=$Data[3];
$eMail[$i]=$Data[4];
$i++;
}
}
sub datenschreiben
###
### 将用户数据写入文件
###
{
open (Datei, ">redir.txt");
$i=0;
my $del = $_[0];
for (@Name)
{
if ( (!defined $del) || ($del ne $i) )
{
print Datei $Name[$i],";;";
print Datei $Adresse[$i],";;";
print Datei $Password[$i],";;";
print Datei $Head[$i],";;";
print Datei $eMail[$i],";;\n";
}
$i++;
}
close (Datei);
}
