Форум программистов [Powered by Invision Power Board]

Код

use CGI qw/:standard/;

print header(-type=>"*/*",-charset=>"utf-8");

print "Content-Length: 61262\n\n";
open (IMG,"/photo/runningb.jpg");
binmode IMG;
binmode STDOUT;
print <IMG>;
close (IMG);

Скрытый текст

��JFIF��H�H��4Photoshop 3.0�8BIM��H��H��8BIM��8BIM'�� 8BIM��H�/ff��lff��/ff��2��Z��5��-��8BIM��p��8BIM��Adobe�d�� "��?�� 3�!1AQa"q�2��B#$R�b34r��C%�S��cs5��&D�TdE£t6�U�e��u��F'��Vfv��7GWgw��5�!1AQaq"2��B#�R��3$b�r��CScs4�%��&5��D�T�dEU6te��u��F��Vfv��'7GWgw�� ?��͡��{8w�W�+��?�P��es�9n��F��-<:��g�s@��'ܲΡ� 괨��^ d9��}�DGv�SCosA�4�! �[��c�>�� aAݑgϲL<{u��<��>~i�K8�N�W�6��i�6��66�'�Z�>�V+��k�T�w6N�E̲=W��$��Cu��*�$��&U��G��k��2˪�� 1��SW�u��]_�9ϥ�7��p��߬X��G��*�s��3�6�;�=Y��o��J�L,�X{�a��{Uly'�X��

Код

 
#!/usr/local/bin/perl

#use strict;
#use CGI qw(:standard);
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
#use CGI 'param','header';
use DBD::mysql;
use Math::Round qw(nearest);
use Image::Magick;

#use strict;
use warnings;
use CGI::Cookie;
use Storable;
use vars '$dbh', '%user_vars';
use CGI qw(param);
use POSIX;
use Digest::MD5 qw(md5_hex);
use Encode qw(encode_utf8);
use CGI qw/:standard/;

print header(-type=>"*/*",-charset=>"utf-8");
#print header(-type=>"Content-Type: image/jpeg",-charset=>"utf-8");

$query = CGI->new();
$action=$query->param("action");

use GD::SecurityImage;

   # Create a normal image
   my $image = GD::SecurityImage->new(width   => 80,
                                      height  => 30,
                                      lines   => 10,
                                      gd_font => 'giant');
      $image->random($your_random_str);
      $image->create(normal => 'rect');
   my($image_data, $mime_type, $random_number) = $image->out;
   

binmode STDOUT;
#   print header -type => "image/$mime_type";
   print $image_data;

Код

use CGI qw(header);
   use GD::SecurityImage 1.64; # we need the "blank" style
   
   my $font  = "StayPuft.ttf";
   my $rnd   = "10.257"; # counter data
   
   my $image = GD::SecurityImage->new(
      width  =>   140,
      height =>    75,
      ptsize =>    30,
      rndmax =>     1, # keeping this low helps to display short strings
      frame  =>     0, # disable borders
      font   => $font,
   );
   
   $image->random( $rnd );
   # use the blank style, so that nothing will be drawn
   # to distort the image.
   $image->create( ttf => 'blank', '#CC8A00' );
   $image->info_text(
      text   => 'You are visitor number',
      ptsize => 10,
      strip  =>  0,
      color  => '#0094CC',
   );
   $image->info_text(
      text   => '( c ) 2 0 0 7   m y s i t e',
      ptsize => 10,
      strip  =>  0,
      color  => '#d7d7d7',
      y      => 'down',
   );
   
   my($data, $mime, $random) = $image->out;
   
   binmode STDOUT;
   print header -type => "image/$mime";
   print $data;

Код


#!perl

use CGI;
use CGI::Carp 'fatalsToBrowser';

my $q = CGI->new;

open(my $fh, 'pic.jpg') || die $!;
my $pic = do { local $/ = undef; <$fh>};
close $fh;

print $q->header(-type => 'image/jpeg');
binmode STDOUT;
print $pic

Код




my $q = CGI->new;

use GD::SecurityImage;
   # Create a normal image
   my $image = GD::SecurityImage->new(width   => 80,
                                      height  => 30,
                                      lines   => 10,
                                      gd_font => 'giant');
      $image->random($your_random_str);
      $image->create(normal => 'rect');
   my($image_data, $mime_type, $random_number) = $image->out;
   
binmode STDOUT;
   print $q->header -type => "*/*";
   print $image_data;

Код


header -type => "*/*";

Код


...
print $q->header(-type => $mime_type);
...

Код


   my ($image_data, $mime_type, $random_number) = $image->out;
   binmode STDOUT;
   print $q->header(-type => "image/$mime_type");
   print $image_data;

Код


#!/usr/local/bin/perl

#use strict;
#use CGI qw(:standard);
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
#use CGI 'param','header';
use DBD::mysql;
use Math::Round qw(nearest);
use Image::Magick;

#use strict;
use warnings;
use CGI::Cookie;
use Storable;
use vars '$dbh', '%user_vars';
use CGI qw(param);
use POSIX;
use Digest::MD5 qw(md5_hex);
use Encode qw(encode_utf8);
use CGI qw/:standard/;




print header(-type=>"*/*",-charset=>"utf-8");


#require "dev.pl";











$query = CGI->new();
$action=$query->param("action");
$reg=$query->param("reg");


$sitedir="/usr/local/www/q21/sites/";
$subdir="thumbnails/000$num.jpg";
$fullfilename="$sitedir$subdir";



















sub filelock {
flock(DB,2);
}
sub fileunlock {
flock(DB,8);
}

sub get_time {
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
 $mon++;
 $year+=1900;
 if ($mday<10) { $mday="0$mday"; }
 if ($mon<10) { $mon="0$mon"; }
 if ($min<10) { $min="0$min"; }
 $date="$mday $mon $year";
 $time="$hour:$min:$sec";
 $cur_all_day=$mday+$mon*30+$year*365;
}








if ($action=~/faq$/i){
#head_page();

mydate();

#end_page();
}


elsif ($action=~/new$/i){
#heeader();

subheader();

#left_list_dj2();
#left_dj_detalis1();
#rith_table_stati2();
#footer();
}






elsif ($action=~/support$/i){
#logout();
#heeader();
subheader();
#left_list_dj2();
#left_dj_detalis1();
#rith_table_stati2();
#footer();
}

elsif ($reg){
reg();
}




else  {
#heeader();
#subheader();
left_list_dj2();
#left_dj_detalis1();
#rith_table_stati2();
#footer();
}






my @rnd_txt = ('0','1','2','3','4','5','6','7','8','9',
                 'a','b','c','d','e','f','g','h','i','j',
                 'k','l','m','n','o','p','r','s','t','u',
                 'v','w','x','y','z');
    srand;

# Генерим ключ 
    for (0..5) {
        my $s = rand(@rnd_txt);
        $passr .= $rnd_txt[$s]
    }
















sub left_list_dj2 {


print << "[INFO5]";

<html>




<title>Добавить сайт</title>

<body>

<p align="center"><strong><font size="5">Global Hosting</font></strong></p>


<hr>


<p align="center"><strong><font size="2"color=red>ВНИМАНИЕ! Заполните пожалуйста все поля</font></strong></p>
<p align="center"><strong><font size="2"color=red>Главная тсраница еще не готова!</font></strong></p>


<form action="/cgi-bin/add" method="POST">
  <div align="center"><center><table border="0" cellspacing="0">
    <tr>
      <td align="right">Login:</td>
      <td colspan="2"><input type="hiden" name="login" size="15"> [a-b][0-9]от 2 до 15 символов      </td>
    </tr>

    <tr>
      <td align="right">Passwd:</td>
      <td colspan="2"><input type="password" name="passwd" size="15"> можите ввести сгенерируемый пароль: <b>$passr<b>  от 6 до 15 символов <font color=red>(пожалуйста, придумайте надежный пароль)</font></td>
    </tr>

    <tr>
      <td align="right">Passwd:</td>
      <td colspan="2"><input type="password" name="passwd2" size="15"> повторите</font></td>
    </tr>


    <tr>
      <td align="right">Country:</td>
      <td colspan="2"><input type="hiden" name="country" size="15"></td>
    </tr>

    <tr>
      <td align="right">City:</td>
      <td colspan="2"><input type="hiden" name="city" size="15"></td>
    </tr>
    <tr>
      <td align="right">E-mail:</td>
      <td colspan="2"><input type="hiden" name="email" size="15"></td>
    </tr>
    <tr>
      <td align="right">Title:</td>
      <td colspan="2"><input type="hiden" name="title" size="15"> Название вашего сайта (для базы данных, идентификации)</td>
    </tr>
      <td></td>
      <td align="center"><input type="submit" name="reg" value="Добавить"></td>
      <td align="center"><input type="reset" value="Очистить"></td>
    </tr>
  </table>

[INFO5]
  



  

   use GD::SecurityImage 1.64; # we need the "blank" style
   
   my $font  = "StayPuft.ttf";
   my $rnd   = "10.257"; # counter data
   
   my $image = GD::SecurityImage->new(
      width  =>   140,
      height =>    75,
      ptsize =>    30,
      rndmax =>     1, # keeping this low helps to display short strings
      frame  =>     0, # disable borders
      font   => $font,
   );
   
   $image->random( $rnd );
   # use the blank style, so that nothing will be drawn
   # to distort the image.
   $image->create( ttf => 'blank', '#CC8A00' );
   $image->info_text(
      text   => 'You are visitor number',
      ptsize => 10,
      strip  =>  0,
      color  => '#0094CC',
   );
   $image->info_text(
      text   => '( c ) 2 0 0 7   m y s i t e',
      ptsize => 10,
      strip  =>  0,
      color  => '#d7d7d7',
      y      => 'down',
   );
   
   my($data, $mime, $random) = $image->out;
   
   binmode STDOUT;

print $q->header(-type => $mime_type);

   print header -type => "$mime";
   print $data;  
  

  
  
  
  
  
print << "[INFO5]";
  
</center></div>
</form>

<hr>

<p align="center"><a href="http://o">Инструкция, рекомендации обсуждения!Обьязательно посетите/a> </p>

</body>
</html>

[INFO5]






exit;
}


sub reg {


$login=$query->param("login");
$passs=$query->param("passwd");
$passs2=$query->param("passwd2");
$country=$query->param("country");
$city=$query->param("city");
$email=$query->param("email");
$title=$query->param("title");






## �?�?�?�? �?�?�?�? HTTP_X_FORWARDED_FOR �?���?�?�?�?�?�?�? 
if ( $ENV{ HTTP_X_FORWARDED_FOR } ) { 

   ## �? ���?�?�?�?�?�?�?�?�? $ip �?�?���?�?�?�?�?�?�?�?�? IP-�?�?�?�?�? 
   ## �?�?�?�?�?�?�?, ���?�?�?�?�?�?�?�?�?�?���? �?�?�?�?�? ���?�?�?�?�? 
   $ip = $ENV{ HTTP_X_FORWARDED_FOR}; 
} else { 

   ## �? ���?�?�?�?�?�?�?�? �?�?�?�?�?�? �?�?���?�?�?�? �? $ip 
   ## �?�?�?�?�?�?�?�?�? IP-�?�?�?�?�? �?�?�?�?�?�?�? 
   $ip = $ENV{ REMOTE_ADDR }; 
} 






$n=0;

#логин

$login =~ s/^\\s+//;
$login =~ s/\\s+$//;


#$login =~ s/\t\n\r\f\v/;
        

print << "[INFO5]";
<html>
<title>Добавить сайт</title>

<body>

<p align="center"><strong><font size="5"></font></strong></p>


<hr>
[INFO5]


if ((!length($login)) || (30 < length($login)) || ( 1 > length($login)) || (!$login =~ /^[A-Za-z0-9]+$/)) {

print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong> Вы не ввели длогин logi0, логин должен быть от 2 до 30 символов</strong></div><br>

[INFO]
$n++;
}


$passs =~ s/^\\s+//;
$passs =~ s/\\s+$//;
$passs =~ s/\t\n\r\f\v//;


if ($passs !~ $passs2) {
print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong>Пароли не совпали</strong></div><br>

[INFO]
$n++;
}



if ((!length($passs)) || (30 < length($passs)) || ( 7 > length($passs)) || (!$passs =~ /^[A-Za-z0-9]+$/)) {

print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong> Пароли не правильные, должно быть 7 символов

[INFO]
$n++;
}


if ($passs !~ $passs2) {
print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong>Пароли не совпали</strong></div><br>

[INFO]
$n++;
}




$country =~ s/^\\s+//;
$country =~ s/\\s+$//;
$country =~ s/\\s+/ /g;

#$country =~ s/[^ a-z0-9\\/\\`\\~\\!\\@\\#\\$\\%\\^\\&\\*\\(\\)\\-\\_\\=\\+\\\\\\|\\[\\{\\]\\}\\;\\:\\''\\"\\,\\<\\.\\>\\?\\t\\n]//gi;



if ((!length($country)) || (1000 < length($country)) || ( 2 > length($country)) || ($country=~ /^[A-Za-z]w+$/) ) {

print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong> Город</strong></div><br>
 
[INFO]
$n++;
}


$city =~ s/^\\s+//;
$city =~ s/\\s+$//;
$city =~ s/\\s+/ /g;


#$city =~ s/[^ a-z0-9\\/\\`\\~\\!\\@\\#\\$\\%\\^\\&\\*\\(\\)\\-\\_\\=\\+\\\\\\|\\[\\{\\]\\}\\;\\:\\''\\"\\,\\<\\.\\>\\?\\t\\n]//gi;

  
#($country=~ /^[A-Za-z]\w+$/)

if ((!length($city)) || (1000 < length($city)) || ( 3 > length($city)) || ($country=~ /^[A-Za-z]w+$/) ) {

print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong> Страна </strong></div><br>
 
[INFO]
$n++;
}





$email =~ s/&/&amp;/go;
$email =~ s/</&lt;/go;
$email =~ s/</&gt;/go;
$email =~ s/'/&apos;/go;
$email =~ s/"/&quot;/go;

if ((!length($email)) || (1000 < length($email)) || ( 3 > length($email)) || (!$email =~ /^[a-zA-Z_\\.-][a-zA-Z0-9_\\.-\\d]*\\@[a-zA-Z\\.-\\d]+\\.[a-zA-Z]{2,4}$/) ) {

print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong> мыло </strong></div><br>
 
[INFO]
$n++;
}



$title =~ s/&/&amp;/go;
$title =~ s/</&lt;/go;
$title =~ s/</&gt;/go;
$title =~ s/'/&apos;/go;
$title =~ s/"/&quot;/go;
  

if ((!length($title)) || (1000 < length($title)) || ( 3 > length($title))) {

print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong> Вы не ввели длогин ФИО, имя должен быть с не менее чем 2 символа и не более 50 символов</strong></div><br>
 
[INFO]
$n++;
}















my $dbh = DBI->connect("DBI:mysql:database=hosting_db;host=localhost", { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;

my $sth = $dbh->prepare('SELECT id
                             FROM users 
                             WHERE name = ?
                             LIMIT 1');
    $sth->execute($login); 
        my $ln = $sth->fetchrow_hashref();
    $sth->finish(); 
$dbh->disconnect();
# �?�?�?�? �?�?�?�?�?�? �?�?�?�? �? �?�?�? �?�? ���?�?�?�?�?�?�?
    if ($ln && $ln > 0) {


print << "[INFO]";

<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong>Логи нуже присутсвует</strong></div><br>

[INFO]
}











my $dbh = DBI->connect("DBI:mysql:database=hosting_db;host=localhost",, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;

my $sth = $dbh->prepare('SELECT id
                             FROM users 
                             WHERE email = ?
                             LIMIT 1');
    $sth->execute($email); 
        my $le = $sth->fetchrow_hashref();

    $sth->finish(); 
$dbh->disconnect();
# �?�?�?�? �?�?�?�?�?�? �?�?�?�? �? �?�?�? �?�? ���?�?�?�?�?�?�?
    if ($le && $le > 0) {


print << "[INFO]";



<div style="margin-left:18px; margin-top:15px;" class="yellow"><strong>данный адресс $email уже существует</strong></div><br>


[INFO]
}



print "$title";
print "$email";
print "$city";
print "$country";
print "$passs";
print "$passs2";
print "$login";



if ($n > "0") {

print << "[INFO5]";

<p align="center"><strong><font size="2"color=red>ВНИМАНИЕ! Заполните пожалуйста все поля</font></strong></p>
<p align="center"><strong><font size="2"color=red>Главная тсраница еще не готова!</font></strong></p>


<form action="/cgi-bin/add" method="POST">
  <div align="center"><center><table border="0" cellspacing="0">
    <tr>
      <td align="right">Login:</td>
      <td colspan="2"><input type="hiden" name="login" size="15"> [a-b][0-9]от 2 до 15 символов      </td>
    </tr>

    <tr>
      <td align="right">Passwd:</td>
      <td colspan="2"><input type="password" name="passwd" size="15"> можите ввести сгенерируемый пароль: <b>$passr<b>! от 6 до 15 символов <font color=red>(пожалуйста, придумайте надежный пароль)</font></td>
    </tr>

    <tr>
      <td align="right">Passwd:</td>
      <td colspan="2"><input type="password" name="passwd" size="15"> повторите</font></td>
    </tr>


    <tr>
      <td align="right">Country:</td>
      <td colspan="2"><input type="hiden" name="country" size="15"></td>
    </tr>

    <tr>
      <td align="right">City:</td>
      <td colspan="2"><input type="hiden" name="city" size="15"></td>
    </tr>
    <tr>
      <td align="right">E-mail:</td>
      <td colspan="2"><input type="hiden" name="email" size="15"></td>
    </tr>
    <tr>
      <td align="right">Title:</td>
      <td colspan="2"><input type="hiden" name="title" size="15"> Название вашего сайта (для базы данных, идентификации)</td>
    </tr>
      <td></td>
      <td align="center"><input type="submit" name="reg" value="Добавить"></td>
      <td align="center"><input type="reset" value="Очистить"></td>
    </tr>
  </table>
  </center></div>
</form>

<hr>

<p align="center"><a href="http://open-dj.2info.dp.ua">Инструкция, рекомендации обсуждения!Обьязательно посетите/a> </p>

</body>
</html>
[INFO5]
exit;
}




($sec,$min,$hour,$mday) = localtime(time);
$ttt=time;
#print "$ttt";






my @rnd_txt = ('0','1','2','3','4','5','6','7','8','9');
    srand;

# Генерим ключ 
    for (0..5) {
        my $s = rand(@rnd_txt);
        $session .= $rnd_txt[$s]
    }

print "pp";
$qhost="host_$session";





print $qhost;






my $ip0="1";
my $email0="1";
my $datetime=$ttt;
my $passsh = md5_hex($passs);
my $datecurrent_in="1";
my $datereg="1";
my $info=$title;

print "$passsh";
 $dbh = DBI->connect("DBI:mysql:database=hosting_db;host=localhost",, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;

$result = $dbh->prepare("INSERT INTO users ( name, pass, ip, country,city, email, info, ip0, email0, registr, datetime, datetimecur, q) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)") || die "aw";

 $result->execute($login, $passsh, $ip, $country, $city, $email, $info, $ip0, $email0, $datereg, $datetime,  $datecurrent_in, $qhost);

 $dbh->disconnect();










print << "[INFO5]";
<p align="center"><strong><font size="2"color=red>ВНИМАНИЕ! Заполните пожалуйста все поля</font></strong></p>
<p align="center"><strong><font size="2"color=red>Главная тсраница еще не готова!</font></strong></p>
<p align="center"><strong><font size="2"color=red>акаунт создан!</font></strong></p>
<hr>
<p align="center"><a href=>Инструкция, рекомендации обсуждения!Обьязательно посетите/a> </p>
</body>
</html>
[INFO5]
exit;
}

Код


print header(-type =>image/$mime);

Код


<img src="gen_pic.pl">

Код


#!perl

use CGI;
use CGI::Carp 'fatalsToBrowser';

my $q = CGI->new;

open(my $fh, 'pic.jpg') || die $!;
my $pic = do { local $/ = undef; <$fh>};
close $fh;

print $q->header(-type => 'image/jpeg');
binmode STDOUT;
print $pic

Цитата(gcc @ 14.6.2008, 05:33

)

если поставить

Выделить всёкод Perl
1:

print header(-type =>image/$mime);

пишет:
Illegal division by zero at add line 286.

Код

print header(-type => "image/$mime");

Код


<img src="gen_pic.pl">

Код


 Выходим в онлайн

Ну вот, кое-что делать мы уже научились. Теперь давайте свернем поближе к вебу. Можем ли мы на лету вывести изображение через CGI? Запросто. Добавьте эти строки в программу вместо ранее используемого вывода в файл.

    # Выключение буферизации, необходимое для нормального вывода изображения.
    select(STDOUT);
    $  = 1;
    undef $/;

    print "Content-type: image/jpeg\n\n";
    print $im->jpeg(100);

Цитата

где-нибудь вообще встречал html документ с внедренными бинарными данными?

Цитата

Плохое направление для раскопок. Javascript просто может быть отключен. Это раз. А во вторых. Данные отправятся не как бинарные, а как текстовые. Знаешь в чем разница? В том что в таком виде картинка будет битой.

Цитата

в переменную типа Image скармливать бинарные данные

Цитата

Вестимо, сохранить его надо. В файле.
При первом запросе:
1) Генерите случайное число. СЧ.
2) Генерите картинку со СЧ, пишете в файл с рандомным именем во временной директории.
3) Генерите случайное уникальное значение СУЗ.
4) Открываете файл/БД, пишете: СУЗ, СЧ.
5) Отдаете хтмлину со вставленной картинкой-ссылкой в ту директорию, за тем файлом.
6) В ту же хтмлину пишете форму со скрытым полем, со значением СУЗ.

Юзер скачивает страницу, браузер стягивает по указанной сслыке картинку, юзер вводит в форму число которое видит, жмет кнопку, уходит форма с введенным числом и ид=СУЗ.

- вынимаете из формы СУЗ, открываете БД/файл, ищете СУЗ. если находите - извлекаете СЧ, сравниваете с присланным юзером, картинку удаляете. Если не совпадает, значит лажа или ошибка юзера, все с начала. Если не находите СУЗ, значит просто лажа. Все с начала.
Всё.

При каждом запросе, или как-то еще, хоть через крон, запускаем скрипт, который чистит дир от старых файлов картинок и таблицу БД/файл от старых пар СУЗ-СЧ. Отсюда проистекает, что файлы мы можем удалять старые по аттрибутам, а вот в записи в файле-таблице надо добавить таймстэмп, чтобы старые отличать от новых...

ЗЫ, есть проще вариант, по идее. Сгенерить число, сложить с неким значением, посчитать с результата хэш, и записать в скрытое поле прямо его. С полученным ответным числом сложить то же некое значение, посчитать хэш и сравнить с полученным из скрытого поля хэшем. Думаю, понятно, что самые очевидные "некие значения" и функции для расчета хэша брать не следует. smile

Для защиты от спамеров вполне метод, если я чего-нибудь не упустил из виду. ;)

Цитата(ginnie @ 16.6.2008, 18:15

)

генерируем картинку с символами (лучше это делать заранее, т.к. это довольно ресурсоемкая задача)

Цитата(ginnie @ 16.6.2008, 23:34

)

или заменяем через некоторое время

Цитата(tolkien @ 16.6.2008, 13:07

)

Ты где нибудь вобще встречал html документ с внедренными бинарными данными? Если да. То дай ссылку на такой экземпляр. Я тоже на него посмотрю.

Код



#!/usr/bin/perl

use CGI::Carp qw(fatalsToBrowser);    # used only for tests
use CGI;


use FindBin qw/$Bin/;
use lib "$Bin/lib";

my $q = new CGI;

   use GD::SecurityImage 1.64; # we need the "blank" style
   
   my $font  = "StayPuft.ttf";
   my $rnd   = "10.257"; # counter data
   
   my $image = GD::SecurityImage->new(
      width  =>   140,
      height =>    75,
      ptsize =>    30,
      rndmax =>     1, # keeping this low helps to display short strings
      frame  =>     0, # disable borders
      font   => $font,
   );
   
   $image->random( $rnd );
   # use the blank style, so that nothing will be drawn
   # to distort the image.
   $image->create( ttf => 'blank', '#CC8A00' );
   $image->info_text(
      text   => 'You are visitor number',
      ptsize => 10,
      strip  =>  1,
      color  => '#0094CC',
   );
   $image->info_text(
      text   => '( c ) 2 0 0 7   m y s i t e',
      ptsize => 10,
      strip  =>  0,
      color  => '#d7d7d7',
      y      => 'down',
   );
   my($data, $mime, $random) = $image->out;
   binmode STDOUT;
print $q->header(-type => $mime);
   print $data;

Код


#!/usr/bin/perl

use GD 1.20;
#use constant
use constant font0 => "./fonts/britanic.ttf";
use constant font1 => "./fonts/engr.ttf";
use constant font2 => "./fonts/luconk.ttf";
use constant font3 => "./fonts/arlrdbd.ttf";
$zag=150;
$rsize=7;
# Пароль для шифрования каптчи (На разных платформах шифруеться по разному)
$captcha_pass = "Пароль для доступа к каптчи";
#######################################################
$im = new GD::Image(100,35);
warn $GD::VERSION;

sub digencode{
    my(@dig)=reverse(split(//,shift));
    my(%d);
    my($dig)=0;
    for($i=0;$i<=$#DIG;$i++){$d{$DIG[$i]}=$i}
    for($i=0;$i<=$#DIG;$i++){$dig+=$d{$dig[$i]}*$DIG_B**$i}
    return $dig;
    }

$rnd=int(rand(1000000000));
for(split(//,$captcha_pass)){$CAPTCHA_PASS+=unpack('C',$_)}
srand($CAPTCHA_PASS);
@ISS=split(//,'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz');
while($#ISS>=0){if(int(rand(2))){push(@DIG,splice(@ISS,int(rand($#ISS+1)),1))
}else{unshift(@DIG,splice(@ISS,int(rand($#ISS+1)),1))
}}
$DIG_B=$#DIG+1;
$nf=digencode($ENV{QUERY_STRING});
srand($nf);
$flood_dig='0000'.int(rand(100000));
($flood_dig)=($flood_dig=~/(\d{5})$/);
srand($rnd);

(@rndc) =
    (
     $im->colorAllocate(234,237,240),
     #$im->colorAllocate(204,204,204),
     #$im->colorAllocate(153,153,153),
     #$im->colorAllocate(102,102,102),
     #$im->colorAllocate(51,51,51),
     $im->colorAllocate(0,0,0)
     );
@color=($rndc[0],$rndc[0],$rndc[0],$rndc[0],$rndc[0]);
$im->interlaced(1);                # cool venetian blinds effect
$rnd=int(rand(100000));
$rnd='0' x (5-length($rnd)).$rnd;
@rnd=split(//,$flood_dig);
# Рисуем линии
for(1..$zag){$im->line(int(rand(100)),int(rand(35)),int(rand(100)),int(rand(35)),$rndc[1])}
# Рисуем цифры
$trnd=int(rand(4));
$im->stringTTF($color[0],font0,(20+int(rand($rsize))),0,10,27,$rnd[0]) if $trnd==0;
$im->stringTTF($color[0],font1,(20+int(rand($rsize))),0,10,27,$rnd[0]) if $trnd==1;
$im->stringTTF($color[0],font2,(20+int(rand($rsize))),0,10,27,$rnd[0]) if $trnd==2;
$im->stringTTF($color[0],font3,(20+int(rand($rsize))),0,10,27,$rnd[0]) if $trnd==3;
$trnd=int(rand(4));
$im->stringTTF($color[1],font0,(20+int(rand($rsize))),0,25,27,$rnd[1]) if $trnd==0;
$im->stringTTF($color[1],font1,(20+int(rand($rsize))),0,25,27,$rnd[1]) if $trnd==1;
$im->stringTTF($color[1],font2,(20+int(rand($rsize))),0,25,27,$rnd[1]) if $trnd==2;
$im->stringTTF($color[1],font3,(20+int(rand($rsize))),0,25,27,$rnd[1]) if $trnd==3;
$trnd=int(rand(4));
$im->stringTTF($color[2],font0,(20+int(rand($rsize))),0,40,27,$rnd[2]) if $trnd==0;
$im->stringTTF($color[2],font1,(20+int(rand($rsize))),0,40,27,$rnd[2]) if $trnd==1;
$im->stringTTF($color[2],font2,(20+int(rand($rsize))),0,40,27,$rnd[2]) if $trnd==2;
$im->stringTTF($color[2],font3,(20+int(rand($rsize))),0,40,27,$rnd[2]) if $trnd==3;
$trnd=int(rand(4));
$im->stringTTF($color[3],font0,(20+int(rand($rsize))),0,55,27,$rnd[3]) if $trnd==0;
$im->stringTTF($color[3],font1,(20+int(rand($rsize))),0,55,27,$rnd[3]) if $trnd==1;
$im->stringTTF($color[3],font2,(20+int(rand($rsize))),0,55,27,$rnd[3]) if $trnd==2;
$im->stringTTF($color[3],font3,(20+int(rand($rsize))),0,55,27,$rnd[3]) if $trnd==3;
$trnd=int(rand(4));
$im->stringTTF($color[4],font0,(20+int(rand($rsize))),0,70,27,$rnd[4]) if $trnd==0;
$im->stringTTF($color[4],font1,(20+int(rand($rsize))),0,70,27,$rnd[4]) if $trnd==1;
$im->stringTTF($color[4],font2,(20+int(rand($rsize))),0,70,27,$rnd[4]) if $trnd==2;
$im->stringTTF($color[4],font3,(20+int(rand($rsize))),0,70,27,$rnd[4]) if $trnd==3;

# Выводим заголовки с отключением кеширования
print "Content-type: image/png\n" ;
print "Pragma: no-cache\n";
print "Expires: now\n\n";
# Переводим STDOUT в двоичный режим
binmode(STDOUT);
# Выводим картинку через STDOUT
print $im->png;

Код


#!/usr/bin/perl
# Пароль для шифрования каптчи (На разных платформах шифруеться по разному)
$captcha_pass = "Пароль для доступа к каптчи";
$captcha_url='http://localhost/captha.cgi';

$rnd=int(rand(1000000000));
for(split(//,$captcha_pass)){$CAPTCHA_PASS+=unpack('C',$_)}
srand($CAPTCHA_PASS);
@ISS=split(//,'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz');
while($#ISS>=0){if(int(rand(2))){push(@DIG,splice(@ISS,int(rand($#ISS+1)),1))
}else{unshift(@DIG,splice(@ISS,int(rand($#ISS+1)),1))
}}
$DIG_B=$#DIG+1;
srand($rnd);

sub digdecode{
    my($dig)=shift;
    my($ndig,$nd)=('',0);
    for($i=1;$dig>0;$i++){
         $nd=$dig-(int($dig/$DIG_B**$i)*($DIG_B**$i));
         $dig-=$nd;
         $ndig=$DIG[($nd/$DIG_B**($i-1))].$ndig;
         }
    return $ndig;
    }

# Начиная с 4294967295 функция srand() под ОС Win* начинает генерировать одни и те же последовательности.
# Переменная $captha_rnd будет содержать цифры для srand (после чего формируется циферки каптчи) хотите сохраняйте в БД, хотите распознавайте (как в каптче) используя <input type=hidden name=df value=$df>
$captha_rnd=int(rand(4294967295));
# Шифруем $captha_rnd
$df=&digdecode($captha_rnd);
print "<img src=\"$captcha_url?$df\" >";
###############
srand($captha_rnd);
$flood_dig='0000'.int(rand(100000));
($flood_dig)=($flood_dig=~/(\d{5})$/);
# Переменная $flood_dig (циферки на картинке).

Код


sub index : Path : Args(0) {
    my ( $self, $c ) = @_;

    $c->stash->{template} = 'add.tt';

   # $c->stash->{captcha} = $c->create_captcha();

            $c->response->content_type('image/jpeg');   
   
    print $c->create_captcha();

}

Код


  $c->response->body( $c->create_captcha() );

Код


<TMPL_VAR NAME="captcha">

Код


    $c->stash->{captcha} = $c->create_captcha();