Sign in:
Username:
Password:  
»Forgot your password?

Home | Forum | How to Protect Your Web Form | How to Protect Your Email | Sign Up

Insure yourself from spam! The Anti Spam Insurance Company - ProtectWebForm!

Forum - Trouble installing with PERL

PostMessage
dnice110
2007-05-05 10:53:19
Hi,

After copying and pasting the correct HTML and PERL code into their
respective files, I get this error message which appears as you simply
load the form page. (before ever entering any code at all):

"The image code you have provided does not match the actual one. Hit
the 'back' button of your browser and input the correct code please."


Please help.
D
Galamax
2007-05-22 09:03:56
yeah got exactly the same problem! I think its because my perl file
writes the gbook.html (wich the visitors vieuws) everytime u load the
page again. So if the captcha-check code is before the part of the
script writing the gbook.html, it checks field befor its even filled
in, i dont know where to past the code :( can anybody please help me?
Galamax
2007-05-22 09:05:08
this is the perl script im using:
[code]
#!/usr/bin/perl

$| = 1;
#$db=1;
ps();
$cfgfile='higuest.cfg';

$rdata=($ENV{'PATH_TRANSLATED'})?'PATH_TRANSLATED':'SCRIPT_FILENAME';
read(STDIN, $xbuffer, $ENV{'CONTENT_LENGTH'});mih($xbuffer,'INPUT');
$details=$ENV{'QUERY_STRING'};mih($details,'PROCESS');
sub
mih{my($take,$tag)=@_;local($pair,$name,$contents,@pairs);@pairs=split(/&/,$take);
foreach $pair (@pairs) {($name, $contents) = split(/=/,
$pair);$contents =~ tr/+/ /;
$contents =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$contents=~s!\|!|!gs;
$$tag{$name}=($$tag{$name}) ? $$tag{$name}.','.$contents : $contents;
} }

$isMac=($ENV{HTTP_USER_AGENT}=~/mac/i)?1:0;
$isIE=($ENV{HTTP_USER_AGENT}=~/msie/i)?1:0;
$isNT=($ENV{OS}=~/windows/i)?1:0; $isNT=($^O =~/Win/i)?1:$isNT;
$ds=($ENV{'SERVER_SOFTWARE'}=~/microsoft/i)?"\\":"\/";

@INIT=(SERVER_ADDR,HTTP_HOST,SCRIPT_NAME,SERVER_NAME,DOCUMENT_ROOT,$rdata);
foreach $init(@INIT){$$init=$ENV{$init};}
$SCRIPT_NAME=~m!([A-Za-z0-9]+\.pl)!;
$this_prog=$1;$$rdata=~m!(.*?)$this_prog!; $my_base_loc=$1;
$my_base_loc=~s!\/+!\/!g;db(my_base_loc,$my_base_loc);

$| = 0;

#############################################################################################
@processes=('edit','xadd_item','xwitem','add_item','witem','re','de','pbox','pbox2','logon','log2','mailer');
$test_it=0;$gnum=0;
while ($test_it < 1) { $val = $processes[$gnum];
if ($PROCESS{$val}) {$test_it=1;} if ($gnum > $#processes)
{$test_it=1;}
$gnum++;} if ($PROCESS{$val}) {defs();&$val;}
else {
defs();primary();
}
##############################################################################################
sub defs { my($t,$te,$rnum,$def,$lx,@vl,@tx);

$pagebgcolour='';
$textcolour='333333';
$link='363B8D';
$vlink='363B8D';
$alink='B73B4D';
$hlink='B73B4D';
$font='Arial,Helvetica,sans-serif';

$stsize=11;
$tsize=12;
$mtsize=16;
$ltsize=22;
$xltsize=35;

$footer=0;
$indent=24;
#$indexpage=1;

$resperpage=10;
$displaywidth=340;
@vl=use_this_file('',"$my_base_loc$cfgfile");
foreach $lx(@vl){chomp $lx;if($lx && $lx
!=~/^#/){$lx=~m!([A-z0-9\-\_]+)\|(.+)!;$mn=$1;$mm=$2;$$mn=$mm;db($mn,$$mn);}}

$siteloc=('http://'.$HTTP_HOST.$subloc); db(siteloc,$siteloc);
$cgiloc=('http://'.$HTTP_HOST.$cgisub); db(cgiloc,$cgiloc);
$my_http=('http://'.$HTTP_HOST.$SCRIPT_NAME); db(my_http,$my_http);
$tloc=($my_base_loc . 'templates'.$ds); db(tloc,$tloc);
$dloc=($my_base_loc.'data'.$ds);db(dloc,$dloc);
$hlink=$alink; $vlink=$link;
}
#############################################################################################
#############################################################################################

sub primary {
$xpipe='&nbsp;&nbsp;|&nbsp;&nbsp;';
my $psdata="$dloc/"; $#store=-1;
$open=opendir(DIR,$psdata); @dirlist=readdir(DIR);
closedir(DIR);
foreach $l(@dirlist){if($l=~/[0-9]+/){
edata($l); $ed=localtime($fstats[9]);
#$tx="$fstats[9]\|$l\|$ed";
$tx="$l\|$l\|$ed";
unshift @store,$tx;
$st_ha{$l}=qq~$header\|$price\|$message\|$name\|$email~;
} # end if
} # end foreach
tbits(); @store=sort @store; @store=reverse @store;

$cont=qq~$ts2<td height="20" bgcolor="#$link"
style="color:\#$pagebgcolour" class="stxt"><b></b>
<a class="roll1" href="$my_http?xadd_item=y"><b><i></i></b></a>
</td></tr>~;


$PROCESS{'st'}||=1;$st=$PROCESS{'st'}; $st--; $en=$st+$resperpage;
$en=($en>($#store+1))?$#store+1:$en;
$xnum=$st;

while($xnum<$en){
#foreach $el(@store){
$el=$store[$xnum];
chomp $el;@tt=split(/\|/,$el);
@gt=split(/\|/,$st_ha{$tt[1]});
$rt=hblock($gt[0]);
$cont.=qq~$tr<td>$rt</td></tr>$blank~;
if($gt[2]){$gt[2]=~s!\n!\<br\>!gs;$cont.=qq~$tr<td>$gt[2]</td></tr>$blank~;
}
if($gt[3]){$cont.=qq~$tr<td bgcolor="#EDEDED"
style="color:\#$alink;font-weight:bold">
<b style="color:\#$link;">Added by : </b>$gt[3]</td></tr>~; }
$gt[4]=~s![\n\r\s]!!gs;
if($gt[4]){$cont.=qq~$tr<td bgcolor="#EDEDED"
style="color:#$link"><b>Email : </b><a
href="mailto:$gt[4]">$gt[4]</a></td></tr>~; }
($now,$dum,$dum)=showDate($tt[0]);
$cont.=qq~
$tr<td bgcolor="#EDEDED" style="color:#$link" class="stxt"><b>Date
added :</b>&nbsp;&nbsp;&nbsp;$now</td></tr>
$tr




</tr>
~;
$xnum++;} # end while($xnum<$en)



$mlink=qq~<b>More Messages:</b>~;
$shlink=qq~<br><br><b>Showing Messages:</b>~;
$xst=1;
while($xst<($#store+2)){$xen=$xst+$resperpage-1;if($xen
>($#store+1)){$xen=$#store+1;}
$lst=(!($xst==$PROCESS{'st'}))?qq~<a
href="$my_http?vdir=y&st=$xst">~:
qq~<span style="color:\#$alink">~;
$len=(!($xst==$PROCESS{'st'}))?'</a>':'</span>';
$lin=($xst != $xen)?qq~$xst \- $xen~:qq~$xst~;
if(!($xst==$PROCESS{'st'})){$mlink.=qq~$xpipe$lst$lin$len~;}
else{$shlink.=qq~$xpipe$lst$lin$len~;}
$xst+=$resperpage;}

$mlink=(($#store+1)>$resperpage)?"<br>$mlink":'';

$footer=1; footer();
my $tpage=($tloc.'gbook.html'); db('tpage',$tpage);
$body=get_page($tpage);
$body=~s!\<body(.*?)\>!\<body\1\>\n\<a name=\"xtop\"\>\<\/a\>!is;

@head=xhead($title,$pagebgcolour,$link,$vlink,$alink,$hlink,$textcolour,$font,$tsize);
$body=~s!\<\/head\>!$head[1]$head[2]\<\/head\>!i;

$cont.=qq~$tr<td></td>$te~;
$cont.=qq~$shlink$mlink<br><br>$footer~;
$body=~s!content_here!$cont!;
print $body;
}


#############################################################################################
sub showDate (;$$) { my($etime,$name)=@_; $etime||=time;
$name||='DateAdded'; my($xn,$pdate,$pxdate,$dfield,@months,@tt);
$dfield=qq~<input type ="hidden" name="$name" value="$etime">~;
@months=('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
@tt=localtime($etime); $tt[5]+=1900;
for($xn=1;$xn<4;$xn++){
$tt[$xn]=(length($tt[$xn])==1)?"0$tt[$xn]":$tt[$xn];}
$pdate=qq~$tt[3]\-$months[$tt[4]]\-$tt[5] $tt[2]\:$tt[1]~;
$pxdate=qq~$tt[3]\-$months[$tt[4]]\-$tt[5]~;
return($pdate,$pxdate,$etime);}
#############################################################################################
#############################################################################################
sub leg_ck (;$) {my($p)=@_;
$leg=($INPUT{leg})?$INPUT{leg}:$PROCESS{leg};
if(!$leg||$leg ne crypt($ENV{REMOTE_ADDR},$kx)){pbox($p);}}
#############################################################################################
sub re { leg_ck(re);add_item('Edit Item',$PROCESS{re});}
sub de { leg_ck(de);my $file="$dloc/$PROCESS{de}";unlink
$file;edit();}
#############################################################################################
sub edit { leg_ck(edit); $ltag=($leg)?"&leg=$leg":'';
my $tpage=($tloc.'gbook.html'); db('tpage',$tpage);
$body=get_page($tpage);

@head=xhead($title,$pagebgcolour,$link,$vlink,$alink,$hlink,$textcolour,$font,$tsize);
$body=~s!\<\/head\>!$head[1]$head[2]\<\/head\>!i;

my $psdata="$dloc/"; $#store=-1;
$open=opendir(DIR,$psdata); @dirlist=readdir(DIR);
closedir(DIR);
foreach $l(@dirlist){if($l=~/[0-9]+/){
edata($l); ($dum,$ed,$dum)=showDate($l);
$tx= "$l\|$l\|$header\|$ed";
unshift @store,$tx;
} # end if
} # end foreach
tbits(); @store=sort @store; @store=reverse @store;
$cont=qq~<b>Guest Book Entries</b><br><br>$ts
<td width="170"><b>Heading</b></td><td width="110"><b>Item
added</b></td><td width="30"><b>Edit</b></td><td
width="30"><b>Delete</b></td></tr>
~;

foreach $ln(@store){chomp $ln;
@tt=split(/\|/,$ln);
my $dx=$tt[2];
$dx=~s![\'\!\*\'\"\?\/\\\|\`\\+\-\_\{\[\]\}\@\#\~\:\;\>\<]*!!g;
$cont.=qq~$tr<td>$tt[2]</td><td class="stxt">$tt[3]</td>
<td class="stxt"><a href="$my_http?re=$tt[1]$ltag">Edit</a></td>
<td class="stxt"><a href="$my_http?de=$tt[1]$ltag" onClick="return
delMe\(\'$dx\',\'$my_http?de=$tt[1]$ltag\'\)">Delete</a></td></tr>
~;}

$cont.="$tr<td></td>$te";
$cont.=qq~<br><br><a href="$my_http?add_item=y$ltag">Add New Guest
Book Entry</a>
\| <a href="#"
onClick="ST_note(\'$my_http\',800,500,'Yes','Yes',10,10,'pWin');">Preview
Guest Book</a>
<br><br><hr height="1" noshade><br><br>~;
my $dscript=qq~
<script language="javascript">
function delMe(nRef,nURL){
if(confirm("Are you sure you want to delete\\n" +nRef+"?")){
window.location.href=nURL;
return true;}else{return false;}
}\n</script>
~;
$body=~s!content_here!$cont!s;
$body=~s!\<\/head\>!$dscript\<\/head\>!is;
print $body;
}
#############################################################################################
sub witem { leg_ck(witem);
@fields=('header','price','message','name','email');

my $now=time;
my $test=0;
if(!$INPUT{art_id}){$nfile=nfile($now);}
foreach $el(@fields){if($INPUT{$el}){$test=1;$$el=$INPUT{$el};}}
my $fref=($INPUT{art_id})?$INPUT{art_id}:$nfile;
if($test){wdata($fref);}
edit();
}
#############################################################################################
sub xwitem { #leg_ck(witem);
@fields=('header','price','message','name','email');
my $now=time;
my $test=0;
if(!$INPUT{art_id}){$nfile=nfile($now);}
foreach $el(@fields){if($INPUT{$el}){$test=1;$$el=$INPUT{$el};}}
my $fref=($INPUT{art_id})?$INPUT{art_id}:$nfile;
if($test){wdata($fref);}
primary();
}
#############################################################################################
sub nfile {
my ($n)=@_; my $fnum=0;
while($fnum<0){my $file="$dloc/$n";if(!(-e
$file)){$fnum=1;}else{$n++;}}
return($n);
}
#############################################################################################
sub xadd_item (;$$){ my($op,$fref)=@_;
eform_cont($op,$fref,"xwitem=y",0);}
#############################################################################################
sub add_item (;$$){ leg_ck(add_item); $ltag=($leg)?"&leg=$leg":'';
my($op,$fref)=@_;
eform_cont($op,$fref,"witem=y$ltag",1); }
#############################################################################################
sub eform_cont { my($op,$fref,$action,$mode)=@_;
my($op,$fref)=@_; if($fref){edata($fref);}
$op=($op)?$op:'Add Item';
tbits();

my ($now,$dum,$dum)=showDate($fref);
my $fx=hblock('Item Heading');
my $ot='Optional message text here';my $ol=lc($ot);
my $bpoint=brow('Bullet point text here');$bpoint="$ts$bpoint$te";

my $hstrip=textb('header',$displaywidth,45); my
$pstrip=textb('price',150,14);
my $fr=hblock("Heading<br>$hstrip");
my $inb=textarea('message',$displaywidth,45,8); my
$oub=textb('email',$displaywidth,45);
my $bul=textb('name',$displaywidth,45);
my $dnow=time();
if(!$fref){$fref=nfile($dnow); $nfref=1;}

my $cont=qq~<form name="form1" action="$my_http?$action"
method="POST">
<input type="hidden" name="leg" value="$leg">
<input type="hidden" name="art_id" value="$fref">
$ts~;
$ot='Optional tailer text here';my $ol=lc($ot);
$cont.=qq~
<td>Type the message you would like to add to our guestbook in
the fields below, and then click "Update Item"<br><br>$fr</td></tr>
$tr<td>Your message:<br>$inb</td></tr>
$tr<td>Your Name:<br>$bul</td></tr>
$tr<td>Your Email address:<br>$oub</td></tr>
$blank$tr<td style="color:#$link" class="stxt">Item
added:&nbsp;&nbsp;&nbsp;$now</td></tr>
$tr<td align="right"><input type="submit" name="submit" value="Update
Item"
style="font-weight:bold;color:#$pagebgcolour;background-color:#$link;font-family:Arial;font-size:12px;margin-top:4px"></td></tr>
$tr<td height="20"><hr height="1" noshade>~;

if($mode){
$cont.=qq~
<br><br><a href="$my_http?edit=y$ltag">Guest Book Items Index</a>~;
if(!$nfref){$cont.=qq~ \| <a href="$my_http?$action">Add New Guest
Book Entry</a>~;}
$cont.=qq~
\| <a href="#"
onClick="ST_note(\'$my_http\',800,500,'Yes','Yes',10,10,'pWin');">Preview
Guest Book</a>
<br><br><hr height="1" noshade><br><br></td>
~;
}
$cont.="$te</form>";
@fields=('header','price','message','name','email');
foreach $el(@fields){$fmake=($el.'_here');$cont=~s!$fmake!$$el!gs;}

my $tpage=($tloc.'gbook.html'); db('tpage',$tpage);
$body=get_page($tpage);

@head=xhead($title,$pagebgcolour,$link,$vlink,$alink,$hlink,$textcolour,$font,$tsize);
$body=~s!\<\/head\>!$head[1]$head[2]\<\/head\>!i;

$body=~s!content_here!$cont!s;
print $body;

}
#############################################################################################
sub hblock ($;$){ my($hd,$pr)=@_;my $hblock=qq~
<table width="$displaywidth" border="0" cellspacing="0"
cellpadding="0">\n<tr align="left">
<td class="mtxt"><font color="#$link"><b>$hd</b></font></td>
</tr></table>~;
return ($hblock);}
#############################################################################################
sub brow { my($bp)=@_; my $brow=qq~
<td width="40">&nbsp;</td>\n<td width="15">&#149;</td>
<td width="454" height="14" valign="bottom" >$bp</td>~;
return($brow); }
#############################################################################################
sub textarea { my($nm,$wd,$cl,$rw)=@_;
my $ta=qq~
<textarea wrap="virtual" name="$nm" cols="$cl" rows="$rw"
style="margin-top:4px;margin-bottom:4px;font-family:Arial;font-size:12px;width:$wd">$nm\_here<\/textarea>
~;
return($ta); }
#############################################################################################
sub textb { my($nm,$wd,$cl)=@_;
my $ta=qq~
<input type="text" name="$nm" value="$nm\_here" size="$cl"
style="margin-top:4px;margin-bottom:4px;font-family:Arial;font-size:12px;width:$wd">
~;
return($ta); }
#############################################################################################
sub tbits {
$ts=qq~\n<table width="$displaywidth" border="0" cellspacing="0"
cellpadding="0">\n<tr class="h12" align="left" valign="top">\n~;
$ts2=qq~\n<table width="$displaywidth" border="0" cellspacing="0"
cellpadding="3">\n<tr class="h12" align="left" valign="top">\n~;
$tr=qq~<tr class="h12" align="left" valign="top">\n~;
$te=qq~</tr></table>~;
$hbl=qq~style="font-size:14pt;font-weight:bold;color:#000090;"~;
$hbk=qq~style="font-size:14pt;font-weight:bold;color:#000000;"~;
$hrd=qq~style="font-size:14pt;font-weight:bold;color:#363B8D0;"~;
$blank=qq~$tr<td height="6"></td></tr>~;
$blank2=qq~$tr<td bgcolor="\#EDEDED" height="6"></td></tr>~;
}
#############################################################################################
sub use_this_file ($$;$$){
local($method,$file,$do_this,$print_this) = @_;
$#this_list=-1;open (INFILE, "$method$file"); @fstats=stat(INFILE);
if ($do_this) {&$do_this;}$do_this="";
if ($print_this) {print INFILE $print_this;$print_this="";}
else {@this_list= <INFILE>; }close (INFILE); return(@this_list);
}
#############################################################################################
sub file_text ($){my($aname) = @_;my($ftext,$lx);foreach
$lx(@$aname){chomp $lx;$ftext.="$lx\n";}
return ($ftext);}
#########################
sub get_page { my($opener)=@_;my($body,$value,@page); open
(INFILE,"$opener");
@page = <INFILE>;close (INFILE); foreach $value(@page) {$body
.=$value;}
$body=~s!my_http!$my_http!igs;
$body=~s!loglink\_here!$my_http?edit=y!g;$body=pclean($body);
$body=~s!html_loc!$siteloc!gis;
$body=~s!cgi_loc!!gis;
$body=~s!title\_here!Hibytes Comment book!g;
return($body); }
#############################################################################################
sub pclean {my($out)=@_;
$out=~s!([\"\'])(\.\.\/)+!$1$siteloc!gi; $out=~s!src([ ]*\=[
]*[\"\']http)!sgc\1!gis;
$out=~s!href([ ]*\=[ ]*[\"\']http)!gref\1!gis;$out=~s!href([ ]*\=[
]*[\"\']java)!gref\1!gis;
$out=~s!href([ ]*\=[ ]*[\"\']\#)!gref\1!gis; $out=~s!background([
]*\=[ ]*[\"\']http)!gackground\1!gis;
$out=~s!src([ ]*\=[ ]*[\"\'])!src\1$siteloc\/!gis; $out=~s!href([
]*\=[ ]*[\"\'])!href\1$siteloc\/!gis;
$out=~s!background([ ]*\=[
]*[\"\'])!background\1$siteloc\/!gis;$out=~s!href=\"$siteloc\/http!href=\"http!gis;
$out=~s!$siteloc\/\#!\#!gis;$out=~s!$siteloc\/javascript!javascript!gis;
$out=~s!href=\"$siteloc\/mailto!href=\"mailto!gis;$out=~s!sgc[
]*\=!src\=!gis;
$out=~s!gref[ ]*\=!href\=!gis;$out=~s!gackground[
]*\=!background\=!gis;$out=~s!$siteloc$siteloc!$siteloc!gis;
$out=~s!([A-z0-9\:]+)/+([A-z0-9]+)!$1/$2!gi;$out=~s!http:/!http://!gis;return
($out); }
#############################################################################################
sub ascii_to_html {
my($word)=@_; my $ret="";
my $len=length($word);
$vnum=0;
while($vnum<$len) {$x=substr($word,$vnum,1);
if(!($x=~/[A-z0-9\r\n\s\#\&\;\?\-\_\:\<\>\/\.]/)){$x=ord($x);$x="\&\#$x\;";
}
$ret.=$x; $vnum++;}
return($ret);
}
#############################################################################################
sub html_to_ascii {
my($word)=@_; my $ret="";
while($word=~/\&\#([0-9]+)\;/){
$x=$1;$x=chr($x);
$word=~s!\&\#([0-9]+)\;!$x!; }
$word=~s!\'!\&\#39;!g;
$word=~s!\"!\&\#34;!g;$word=~s![\<]!\&\#60\;!g;$word=~s![\>]!\&\#62\;!g;
return($word);
}
#############################################################################################
sub edata {
my ($fref)=@_; my $file="$dloc$fref"; my $dets="";
if (-s $file) {@this_list=use_this_file('',$file);
foreach $line(@this_list) {$line=~s!\n$!!g;
$line=~s!\r$!!g;$dets.="$line\n";}
($header,$price,$message,$name,$email)=split(/\|/,$dets);} # end if
(-e $file)
my @re=('header','price','name','email'); foreach
$lx(@re){$$lx=html_to_ascii($$lx);}
if($leg && $reset){@re=('message'); foreach
$lx(@re){$$lx=uhl($$lx);}}
chomp $email;}
##################################################
sub wdata { chomp $email;
my ($fref)=@_; my $file="$dloc$fref";
my @re=('header','price','name','email'); foreach
$lx(@re){$$lx=ascii_to_html($$lx);}#$#re=-1;
@re=('message'); foreach $lx(@re){$$lx=hl($$lx);}
$pt=($header.'|'.$price.'|'.$message.'|'.$name.'|'.$email);
@this_list=use_this_file('>',$file,'',$pt); $#this_list=-1;chmod
0777,$file;
}
############################################################################################
#############################################################################################
sub xascii_to_html {
my($word)=@_; my $ret="";
my $len=length($word);
$vnum=0;
while($vnum<$len) {$x=substr($word,$vnum,1);
if(!($x=~/[A-z0-9\r\n\s\#\&\;]/)){$x=ord($x);$x="\&\#$x\;"; }
$ret.=$x; $vnum++;}
return($ret);
}
#############################################################################################
sub xhtml_to_ascii {
my($word)=@_; my $ret="";
while($word=~/\&\#([0-9]+)\;/){
$x=$1;$x=chr($x);
$word=~s!\&\#([0-9]+)\;!$x!; }

$word=~s!\'!\&\#39;!g;
$word=~s!\"!\&\#34;!g;$word=~s![\<]!\&\#60\;!g;$word=~s![\>]!\&\#62\;!g;
return($word);
}
#############################################################################################
sub xedata {
my ($fref)=@_; my $file="$dloc/$fref"; my $dets="";
if (-e $file) {@this_list=use_this_file('',$file);
foreach $line(@this_list) {$line=~s!\n$!!g;
$line=~s!\r$!!g;$dets.="$line\n";}
($header,$price,$message,$name,$email)=split(/\|/,$dets);} # end if
(-e $file)

my @re=('header','price','message','name','email');
foreach $lx(@re){$$lx=html_to_ascii($$lx);}
}
##################################################
sub xwdata {
my ($fref)=@_; my $file="$dloc/$fref";
my @re=('header','price','message','name','email');
foreach $lx(@re){$$lx=ascii_to_html($$lx);}
$pt=($header.'|'.$price.'|'.$message.'|'.$name.'|'.$email);
@this_list=use_this_file('>',$file,'',$pt); $#this_list=-1;chmod
0777,$file;
}
#######################################################
sub xhead ($$$$$$$$$)
{my($title,$bg,$link,$vis,$act,$hov,$txt,$font,$fsize)=@_;
my($weight,$xn,$gtitle,$r,$rt,$sbit,$htop,$js,$bbit,$hend,@rn,@rtags);
@rn=($stsize,$tsize,$mtsize,$ltsize,$xltsize);
@rtags=('stxt','txt','mtxt','ltxt','xltxt');
$gtitle=($leg)?qq~HiAlbum Editor - $title~:$title;
$fsize.='px';$htop=qq~<html>\n<head>\n<title>$title</title>
<meta http-equiv="Content-Type" content="text/html;
charset=iso-8859-1">~;
$hend='</head>';$sbit=qq~ \n<style type="text/css">\n<!--\n~;
for($xn=0;$xn<5;$xn++){ $weight=($xn>2)?'Bold':'Normal';
$rt=($rn[$xn].'px');$sbit.=qq~\.$rtags[$xn]\{font\-size\:$rt;font-family:$font;font-weight:$weight;}\n~;
}

$sbit.=qq~\nbody, td, p, span, ol, ul, dt, div { font-size:$fsize;
font-family:$font; font-weight:normal;}
body {background-color: #$bg;}
input,select,textarea {
font-size:$fsize;font-family:$font;color:#$link;background-color:
#$bg;border: 1 solid #$alink;}
a:link { color:#$link; text-decoration: underline}\na:active {
color:#$act; text-decoration: underline}
a:visited { color:#$vis; text-decoration: underline}\na:hover {
color:#$hov; text-decoration: underline}
a.roll1:link { color:#$pagebgcolour; text-decoration:
none}\na.roll1:active { color:#$pagebgcolour; text-decoration:
underline}
a.roll1:visited { color:#$pagebgcolour; text-decoration:
none}\na.roll1:hover { color:#$pagebgcolour; text-decoration:
underline}

\-\-\>\n\<\/style\>\n~;
$js=js_bits();
my $abit=($PROCESS{'album'})?qq~\' \\nThis action cannot be undone,
and\\nwill delete all images in this \\nalbum from the
server.\'~:q~''~;
$js.=qq~\nfunction printMe() { \nif(is.ie && is.mac) {
alert("Sorry, your browser does not support this function. \\nPlease
select Print from your file menu.")
} else { \nwindow.print(); \n } \n return true;\n}\n\nfunction
delMe(nRef,nURL){
var abit=$abit;
if(confirm("Are you sure you want to delete\\n" +nRef+"?" +abit)){
\/\/window.location.href=nURL;
\/\/return true;
return false;
}else{return false;}\n}\n</script>~;
$bbit=qq~
<body bgcolor="\#$bg" text="#$txt" link="#$link" vlink="#$vis"
alink="#$act" leftmargin="5" topmargin="5" marginwidth="0"
marginheight="0">\n
~;
return ($htop,$sbit,$js,$hend,$bbit);

}
############################################################################################
sub db {
local($desc,$descval)=@_;
ps();
if($db) { print qq~<font color="#ff0000">$desc</font> $descval<br>~;
}
}
############################################################################################
sub ps {
if(!$ps) { print "Content-type: text/html\n\n"; $ps=1; }
}
#############################################################################################
#############################################################################################
sub logon {my($p)=$INPUT{p};if((!$p) && $PROCESS{p}){$p=$PROCESS{p};
}
$p=($p)?$p:'edit';
if(!$INPUT{password}){$ecode="Please enter a
password";pbox($p);exit;}
else{if(!$px){$px=crypt($INPUT{password},$kx);@tt=use_this_file('>>',"$my_base_loc$cfgfile",'',"px\|$px\n");}
else{if(crypt($INPUT{password},$kx) ne $px){$ecode="Password
incorrect";pbox($p);exit;} }
$leg=$INPUT{leg}=crypt($ENV{REMOTE_ADDR},$kx);$t_msg="Status: Password
correct";&$p;} }
#############################################################################################
sub log2 {my($p)=$INPUT{p}; if((!$p) && $PROCESS{p}){$p=$PROCESS{p};
}
$p=($p)?$p:'edit';
if(!$INPUT{password}){$ecode="Please enter your old
password";pbox2($p);exit;}
elsif(crypt($INPUT{password},$kx) ne $px){$ecode="Old Password
incorrect";pbox2($p);exit;}
elsif(!$INPUT{password2}){$ecode="Please enter a new
password";pbox2($p);exit;}
elsif(!$INPUT{password3}){$ecode="Please enter your new password in
both boxes";pbox2($p);exit;}
elsif($INPUT{password3} ne $INPUT{password2}){$ecode="Your new
password must be the same in both boxes";pbox2($p);exit;}
else{$px=crypt($INPUT{password2},$kx);
my @vl=use_this_file('',"$my_base_loc$cfgfile");
foreach $lx(@vl){chomp $lx;if($lx && $lx
!=~/^#/){$lx=~m!([A-z0-9\.]+)\|(.+)!;$mn=$1;$mm=$2;
$cf_ha{$mn}=$mm;db($mn,$$mn);}}$cf_ha{px}=$px;my $rut="";foreach
$k(sort keys %cf_ha){$rut.=qq~$k\|$cf_ha{$k}\n~;}
use_this_file('>',"$my_base_loc$cfgfile",'',$rut);
$leg=$INPUT{leg}=crypt($ENV{REMOTE_ADDR},$kx);$t_msg="Status: Password
changed";&$p;} }
#############################################################################################
sub pbox(;$) {my($p)=@_;if((!$p) && $PROCESS{p}){$p=$PROCESS{p};
}if((!$p) && $INPUT{p}){$p=$INPUT{p}; } $p=($p)?$p:'edit';
my($ts,$tr)=tbits2('',3);my($ts,$tr2)=tbits2('',3,'','right');
my $td1=td(300,40);my $td2=td(300,25,'dddddd');my
$td3=td(300,18,'','','11px');
my $ipn1=ipn(password,password);my $ipb=ipb();
$ecode=($ecode)?qq~$tr$td3<span
style="color:#ff0000;"><b>Error!</b><br>$ecode</td></tr>~:'';
print qq~<html>\n<head>\n<title>Admin Logon</title>\n</head><body
bgcolor="#ffffff">
<form name="ft" method="post"
action="$my_http?logon=1$vtag$etag$ltag">\n<input type="hidden"
name="p" value="$p">\n
<div align="left">\n$ts$tr$td1
<a href="$my_http?pbox2=y&p=$p">Change password</a><br><br>
</td></tr>\n$tr$td2<b>Admin Logon</b></td></tr>\n
$tr$td3 Use your access password to enter this section. If you change
this password you must keep a careful
note of it. For security reasons only the encrypted version of a
password is stored, and this cannot be
decrypted.</td></tr>$ecode$tr$td2<b>Password</b></td></tr>
$td3$ipn1</td></tr>
$tr2$td2$ipb</td></tr>
</table></form></div></body></html>~;
exit;
}
#############################################################################################
sub pbox2(;$) {my($p)=@_; if((!$p) && $PROCESS{p}){$p=$PROCESS{p};
}if((!$p) && $INPUT{p}){$p=$INPUT{p}; }$p=($p)?$p:'pbox';
my $vtag="";if($tm){$vtag.=qq~&tm=$tm~;}if($si){$vtag.=qq~&si=$si~;}
if($PROCESS{domode}){$vtag.="&domode=$PROCESS{domode}";}
if($PROCESS{try}){$vtag.="&try=$PROCESS{try}";}
my $etag=($emode)?'&emode=y':'';
my $ltag=($pageID)?"&pa=$pageID":'';$ltag.=($subID)?"&su=$subID":'';
my($ts,$tr)=tbits2('',3);my($ts,$tr2)=tbits2('',3,'','right');
my $td1=td(300,40);my $td2=td(300,25,'dddddd');my
$td3=td(300,18,'','','11px');
my $ipn1=ipn(password,password);my $ipb=ipb();
my $ipn2=ipn(password,password2);
my $ipn3=ipn(password,password3);
$ecode=($ecode)?qq~$tr$td3<span
style="color:#ff0000;"><b>Error!</b><br>$ecode</td></tr>~:'';
print qq~<html>\n<head>\n<title>Autosites Admin
Logon</title>\n</head><body bgcolor="#ffffff">
<form name="ft" method="post"
action="$my_http?log2=1$vtag$etag$ltag">\n<input type="hidden"
name="p" value="$p">\n
<div align="left">\n$ts$tr$td1 </td></tr>\n$tr$td2<b>Autosites Change
Password</b></td></tr>\n
$tr$td3 Enter your existing password, followed by your new password.
</td></tr>$ecode
$tr$td2<b>Old Password</b></td></tr>$td3$ipn1</td></tr>
$tr$td2<b>New Password</b></td></tr>$td3$ipn2</td></tr>
$tr$td2<b>Re-enter New Password</b></td></tr>$td3$ipn3</td></tr>
$tr2$td2$ipb</td></tr>
</table></form></div></body></html>~;
exit;
}
#############################################################################################
sub ipn ($$$;$$$$$){
my($tt,$nn,$vl,$sz,$fn,$fs,$wd,$rows)=@_;

db(ipn,"$tt n $nn $vl n $sz");
$fn=($fn)?$fn:'Arial,Helvetica,sans-serif';
$fs=($fs)?$fs:'12px';$wd=($wd)?$wd:140;
$sz=($sz)?$sz:int($wd/10);$rows=($rows)?$rows:5;
if($tt eq 'text' || $tt eq 'password'){
my $ipn=qq~<input type="$tt" name="$nn" value="$vl" size="$sz"
style="font-family:$fn;font-size:$fs;width:$wd">~;return $ipn;}
if($tt eq 'area'){
my $ipn=qq~<textarea name="$nn" cols="$sz" wrap="VIRTUAL"
rows="$rows"
style="font-family:$fn;font-size:$fs;width:$wd">$vl</textarea>~;return
$ipn;}

}
#############################################################################################
sub footer { my $fsize=($tsize.'px'); my
$xfsize=$tsize-1;$xfsize.='px';
$hr=qq~<hr size="1" width="$displaywidth" color="\#$link" noshade
align="left">~;
$hralt=qq~<hr size="1" width="100%" color="\#$alink" noshade
align="left">~;
if($footer){$footer=qq~<div
style="line-height:$fsize;font-family:$font;font-size:$xfsize;color:#$alink">
<span style="font-size:$fsize;font-weight:bold;color:\#$link"><a
href="\#" onClick="printMe();"></a></span>
<b></b><a target="_blank" href="http://www.hibyte.co.uk">
</a></div>$hr~;}}
#############################################################################################
sub ipb ($$$;$$$$){
my($tt,$nn,$vl,$fn,$fs)=@_;
$tt=($tt)?$tt:'Submit';$nn=($nn)?$nn:'Submit';$vl=($vl)?$vl:'Submit';
$fn=($fn)?$fn:'';
$fs=($fs)?$fs:'12px';
my $ipn=qq~<input type="$tt" name="$nn" value="$vl"
style="font-family:$fn;font-size:$fs;">~;
return $ipn;
}
#########################################################################################
sub td (;$$$$$$){
my($wd,$hd,$bg,$fn,$fs,$cs)=@_;
$cs=($cs)?"colspan=$cs":'';
$fn=($fn)?$fn:'Arial,Helvetica,sans-serif';$bg=($bg)?"bgcolor=\'\#$bg\'":'';
$fs=($fs)?$fs:'12px';$wd=($wd)?$wd:140;$hd=($hd)?$hd:15;
my $td=qq~<td $cs style="font-family:$fn;font-size:$fs;" width="$wd"
height="$hd" $bg>\n~;
}
#############################################################################################
sub tbits2(;$$$$$) {
my($b,$cp,$cs,$a,$v)=@_;
$b=($b)?$b:0;$cp=($cp)?$cp:0;$cs=($cs)?$cs:0;$a=($a)?$a:'left';$v=($v)?$v:'middle';
my $ts=qq~<table border="$b" cellpadding="$cp" cellspacing="$cs">\n~;
my $tr=qq~<tr align="$a" valign="$v">\n~;
return ($ts,$tr);
}
#############################################################################################
#############################################################################################
sub js_bits {
my $bits=qq~
<script language="javascript">\n
function Is() {
agent = navigator.userAgent.toLowerCase();
plat = navigator.platform.toLowerCase();
this.mac = (plat.indexOf('mac') != -1);
this.win = (plat.indexOf('win') != -1);
this.major = parseInt(navigator.appVersion);
this.minor = parseFloat(navigator.appVersion);
this.ns = ((agent.indexOf('mozilla') != -1) &&
((agent.indexOf('spoofer') == -1) &&
(agent.indexOf('compatible') == -1)));
this.ns4 = (this.ns && (this.major == 4));
this.ns6 = (this.ns && (this.major >= 5));
this.ie = (agent.indexOf("msie") != -1);
this.ie3 = (this.ie && (this.major < 4));
this.ie4 = (this.ie && (this.major == 4) &&
(agent.indexOf("msie 5.0") == -1));
this.ie5 = (this.ie && (this.major == 4) &&
(agent.indexOf("msie 5.0") != -1));
this.ie55 = (this.ie && (this.major == 4) &&
(agent.indexOf("msie 5.5") != -1));
this.ie6 = (this.ie && (agent.indexOf("msie 6.0")!=-1) );
}

var is = new Is();

var StoreWindow = null;
var proc= '<span
style="font-family:sans-serif;font-size:16pt;color:#3638bd">Processing'
+ ' - please wait</span>';
function ST_note(theURL,uWidth,uHeight,sbar,res,locH,locV,StoreWindow)
{
var attr='scrollbars='+sbar+',resizable='+res+',width=' + uWidth +
',height=' +uHeight
if(!window.StoreWindow || window.StoreWindow.closed) {
if(is.mac && is.ie) {
StoreWindow = window.open(theURL,StoreWindow,attr);
StoreWindow.focus();
} else {
StoreWindow = window.open('',StoreWindow,attr);
StoreWindow.moveTo(locH,locV)
StoreWindow.document.close();
StoreWindow.document.write(proc);
StoreWindow.focus()
StoreWindow.location.href = (theURL)
} // end else
} else {
StoreWindow.location.href = (theURL)
StoreWindow.focus()
}
return StoreWindow;
}

function goHere(thisEL,loc) {
var addx=thisEL.value;
var newloc=loc +'&ab='+addx;
self.location.href=newloc;

}

function keyW(myForm){
if(!myForm.keywords.value){
alert('Please enter keyword(s)');return false;}
return true; }
~;
return($bits);}
#############################################################################################
sub hl { my($string)=@_;
$string=~s!\<a[ ]+href[ ]*\=[ ]*([\'\"]?)([hstpfHSTPF]+)\:\/\/!\<a
href\=$1$2xxspigxx!ig;
$string=~s|([hstpfHSTPF]+)\:\/\/([a-zA-Z0-9\.\-\/\?\&\=]+)|<a
href="$1://$2">$1://$2</a>|gi;
$string=~s|([\n\r ]+)www\.([a-zA-Z0-9\.\-\/\?\&\=]+)|$1<a
href="http://www\.$2">www\.$2</a>|gi;
$string=~s|([\n\r ]+)([a-zA-Z0-9\.\-]+)\@([a-zA-Z0-9\.\-]+)|$1<a
href="mailto\:$2\@$3">$2\@$3</a>|gi;
$string=~s|^www\.([a-zA-Z0-9\.\-\/\?\&\=]+)|<a
href="http://www\.$1">www\.$1</a>|gi;
$string=~s|^([a-zA-Z0-9\.\-]+)\@([a-zA-Z0-9\.\-]+)|<a
href="mailto\:$1\@$2">$1\@$2</a>|gi;
$string=~s!xxspigxx!\:\/\/!ig;
$string=~s!\>(.*?)\<\/a\>[ ]*\<\<(.*?)\>\>!\>$2\<\/a\> !ig;
$string=~s!\>(.*?)\<\/a\>[ ]*\<target\:(.*?)\>!
target=\"$2\"\>$1\<\/a\> !ig;
return($string); }
#############################################################################################
sub uhl { my($string)=@_; my($l,$n);
$string=~s!\<a[ ]+(.*?)target[ ]*\=[
]*[\'\"]{1}([\S]+)[\'\"]{1}\>(.*?)\<\/a\>!\<a
$1\>$3\<\/a\>\<target\:$2\>!gi;
$string=~s!href[ ]*\=[ ]*([\'\"]{1})mailto\:!href\=\1!gi;
while($string=~/\<a[ ]+href[ ]*\=[ ]*[\'\"]{1}([\S]+)[\'\"]{1}[
]*\>(.*?)\<\/a\>/i){
$l=$1;$n=$2;if($l eq $n){
$string=~s!\<a[ ]+href[ ]*\=[ ]*[\'\"]{1}([\S]+)[\'\"]{1}[
]*\>(.*?)\<\/a\>!$1!i;}
else{$string=~s!\<a[ ]+href[ ]*\=[ ]*[\'\"]{1}([\S]+)[\'\"]{1}[
]*\>(.*?)\<\/a\>!$1\<\<$2\>\>!i;}
} # end while
return($string); }
#############################################################################################[/code]
Galamax
2007-05-24 07:05:31
ok!






Post Reply:

You must be logged in to reply.
Post message
Name: 
Email: 
Url: 




Registered users: 20236

Forms protected: 48457

Further Reading & Anti Spam Resources:

Directory
Search our site for:
 
Web www.protectwebform.com

Get Thunderbird!

    ©Copyright 2006 ProtectWebForm.com. All rights reserved. Read our Privacy Policy

Page copy protected against web site content infringement by Copyscape