VPF::напечатать картинку - Форум программистов

gcc

Дата 21.5.2008, 19:11 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

Код

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;

http://search.cpan.org/dist/GD-SecurityIma...ecurityImage.pm

все остально работает - получаеться, еще куки не работают и редирект, наверно что-то с cgi модулем? н оя не понял что он хочет еще?
подскажите как вывести это изображение?

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

KSURi

Дата 22.5.2008, 01:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 887
Регистрация: 8.6.2006
Где: Russia

Репутация: 2
Всего: 27

Код


#!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

Вот это по идее должно работать

--------------------

Died at Life.pl line 21

gcc

Дата 22.5.2008, 11:55 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

спасибо!

я еще сделал:

1) открыл картинку в срипте cgi
2) вставил всрипт cgi скрипт как картинку

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 22.5.2008, 15:38 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

не работает!

Код




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 => "*/*";

это означает любой тип, короче не хочет работаеть!

подскажимте полностью пожалуйста!

ИЛИ

если поставить вот так:
<img src="my_image_script.cgi" />

то как сделать проверку вводимого числа? как передать число? или тчо нужно сделать?

Это сообщение отредактировал(а) gcc - 22.5.2008, 15:57

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

nitr

Дата 23.5.2008, 00:11 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

gcc, проверьте так:

Код


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

Добавлено через 21 секунду
Не зря ведь вы его получаете ;)

Добавлено через 2 минуты и 14 секунд
Просто обычно это PNG, а не JPG/JPEG

--------------------

I love ArchLinux

nitr

Дата 25.5.2008, 00:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

gcc, закрывайте тему, раз помогло ;)

--------------------

I love ArchLinux

gcc

Дата 25.5.2008, 00:41 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

сори, я не пробовал еще, я замучался с этой картинкой, что не хочу печатать, поже попробую сделать, но по-моиму пробовал так как вы написали... smile

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

nitr

Дата 25.5.2008, 04:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

Если верить документации:

Код


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

Но у меня с примером выше работает.

--------------------

I love ArchLinux

KSURi

Дата 25.5.2008, 21:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 887
Регистрация: 8.6.2006
Где: Russia

Репутация: 2
Всего: 27

У меня на апаче 2.х отрабатывало и без binmode вообще.
PS: я не понимаю, зачем надо делать binmode на оба потока, вернее, что так делать и не надо вроде; делать надо на тот поток, который по умолчанию не принимает/отображает или некорректно обрабатывает непечатные символы.

--------------------

Died at Life.pl line 21

gcc

Дата 14.6.2008, 05:33 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

не работает, все что пишу - не хочет работать

вод пример, код картинки в середине, кто-то скажет гже ошибка пожалуйста?

Код


#!/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);

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

Это сообщение отредактировал(а) gcc - 14.6.2008, 05:41

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

Itsys

Дата 14.6.2008, 11:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1338
Регистрация: 21.1.2008
Где: г. Москва

Репутация: нет
Всего: 34

Я не стал сильно копаться в твоем скрипте, но проблема в том, что ты пытаешься вставить содержимое картинки прямо в HTML, он тебе ее и показывает. Так что скрипт работает верно. Для того чтобы вставить в HTML именно картинку, а не ее машинное представление, необходимо указывать так:

Код


<img src="gen_pic.pl">

gen_pic.pl (например, как написал KSURi - здесь):

Код


#!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

tolkien

Дата 14.6.2008, 12:46 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: нет
Всего: 4

Я так понял. Вы генерите на лету html страничку и картинку. При этом код картинке вставляете в html документ. Отправляете заголовок Content-Type: */*; charset=utf-8. Откуда браузер знает как отобразить данный документ? Ему что надо самому догадки строить?

Короче отправляйте заголовок text/html. Картинку. Сохраните в файл. И ссылку на нее вставте в документ, в тег <img>.

nitr

Дата 14.6.2008, 16:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

Цитата(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");

tolkien, такой способ работает 101% smile

С PNG я работал, вроде с другими тоже работает, лично я не мучился.

gcc, лучше в отдельный скрипт вынести код генерации картинки, как подсказал Itsys, вам же легче разбираться.
gcc, и ещё посмотрите на ошибки в логах сервера, т.к. простые скрипты работают, как уже выше говорил.

Добавлено через 30 секунд
gcc, у вас $mime определён?

--------------------

I love ArchLinux

gcc

Дата 16.6.2008, 03:14 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

nitr, определено:

Код

png

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

Код


<img src="gen_pic.pl">

но нужно делать запрос в базу еще, чтобы узнать число которое на картинке (именно так и сделал).

тут написано, что можно в cgi вставить?

Код


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

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

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

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

если можно вставить сразу через cgi скрипт, то покажите 100% работающий если не сложно...

Это сообщение отредактировал(а) gcc - 16.6.2008, 03:20

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

tolkien

Дата 16.6.2008, 13:07 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: нет
Всего: 4

Смотри на заголовок в примере "print "Content-type: image/jpeg\n\n";"
Отправляется только картинка.
Ты где нибудь вобще встречал html документ с внедренными бинарными данными? Если да. То дай ссылку на такой экземпляр. Я тоже на него посмотрю.

GoDleSS

Дата 16.6.2008, 14:57 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 105
Регистрация: 11.2.2007
Где: Пироговский

Репутация: нет
Всего: 2

Цитата

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

Кстати допускаю такой вариант, только не в ХТМЛ напрямую, а попробовать генерить с яваскриптом, в переменную типа Image скармливать бинарные данные.
Не пробовал, но покопать в этом направлении можно.

--------------------

It's a nice day to die my friend!

tolkien

Дата 16.6.2008, 15:05 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: нет
Всего: 4

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

GoDleSS

Дата 16.6.2008, 15:29 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 105
Регистрация: 11.2.2007
Где: Пироговский

Репутация: нет
Всего: 2

Цитата

1. Раскопки можно вести и в тупиковом направлении, для интереса smile

2. А вот с этим моментом вынужден согласиться, либо сильно изголяться, либо будет нарушение изображения.

--------------------

It's a nice day to die my friend!

yurik_l

Дата 16.6.2008, 16:21 (ссылка)

(нет голосов)

Загрузка ...

тарантиноман

Профиль
Группа: Участник
Сообщений: 49
Регистрация: 17.9.2006

Репутация: нет
Всего: 3

Цитата

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

А что у Image есть такие свойства или методы?

gcc

Дата 16.6.2008, 16:49 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

подсказали так:

Цитата

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

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

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

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

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

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

Это сообщение отредактировал(а) gcc - 16.6.2008, 16:50

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

ginnie

Дата 16.6.2008, 17:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 4
Всего: 49

Уважаемый gcc, последний способ наиболее эффективен и хорошо масштабируется на архитектуре с несколькими серверами. Надо в форму передавать зашифрованный параметр, содержащий хэш и дату устаревания картинки. Для повышения стойкости можно ключ шифрования выбирать случайно из набора.

--------------------

Написать код, понятный компьютеру, может каждый, но только хорошие программисты пишут код, понятный людям. (Мартин Фаулер. Рефакторинг)

gcc

Дата 16.6.2008, 17:08 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

Уважаемый ginnie, что такое "устаревания картинки"? я найти не могу

Это сообщение отредактировал(а) gcc - 16.6.2008, 17:08

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

ginnie

Дата 16.6.2008, 18:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 4
Всего: 49

gcc, обычно для капчи ограничивают время, в течении которого она принимается сервером, чтобы усложнить вариант использования системы распознавания изображений.
Т.е. схема такая:

генерируем картинку с символами (лучше это делать заранее, т.к. это довольно ресурсоемкая задача)
формируем хэш на основе символов картинки (это дополнительный шаг, для увеличения стойкости к взлому)
формируем дату устаревания картинки (текущая дата + интервал времени, например 3 минуты), удобно использовать результат функции time(), при условии, что на всех серверах время синхронизировано и используется единое начало отсчета (epoch)
формируем строку, состоящую из хэша и даты устаревания
выбираем случайный ключ шифрования из набора ключей
шифруем строку удобным симметричным криптоалгоритмом с выбранным ключом
добавляем к зашифрованной строке идентификатор использованного ключа

Это сообщение отредактировал(а) ginnie - 16.6.2008, 18:16

--------------------

nitr

Дата 16.6.2008, 20:55 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

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

)

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

т.е. предлагается заранее хранить это всё на сервере? Мне интересно, как это "заранее". Просто в своем опыте такое не встречал smile

--------------------

I love ArchLinux

ginnie

Дата 16.6.2008, 23:34 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 4
Всего: 49

Уважаемый nitr, представьте, что у Вас сервер должен показывать 100 капчей в секунду. Одна картинка генерируется 0.4 сек (для примера). Как это сделать?
Генерируем 10000 картинок (за 1 час) и показываем их пользователям случайным образом. Картинки не удаляем, а дополняем новыми (для получения необходимого объема) и заменяем через некоторое время. Код, изображенный на картинке включен в имя файла.

Это сообщение отредактировал(а) ginnie - 16.6.2008, 23:36

--------------------

nitr

Дата 16.6.2008, 23:35 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

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

)

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

ваш подход мне ясен. Спасибо. Имхо, со временем заменить стоит ;)

--------------------

I love ArchLinux

tolkien

Дата 18.6.2008, 16:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: нет
Всего: 4

Я бы не использовал БД. Зачем она нужна там где без нее легко обойтись?
Можно поступить так
1.генерим случайную послед букв и цифр для картинки $captch_str
2.генерим саму картинку $captch_image содержащее $captch_str
3. генерим случайное имя файла для капчи $name_captch фиксированной длины.
4. создаем 2 файла
   1й файл. картинка $captch_image с именем $name_capth.jpg
   2ой файл с $captch_str c именем $name_captch.txt
5. добавляем  $name_captch в файл $captch.txt

В процессе работы случайным образом выбираем $namt_captch из файла $captch.txt. Кол.во записей опред. размер файла и делится на длину записи $name_captch. И дальше остается только случайным образом сгенерить число.

Помоему это будет работать гораздо быстрее чем варианты с БД.

dmitryk1

Дата 20.6.2008, 06:59 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 118
Регистрация: 10.6.2008
Где: Новосибирск

Репутация: нет
Всего: 2

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

)

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

поищи tiddleWiki.
В браузерах типа файерфокса он позволяет сохранять в себя бинарные файлы. А поскольку он сам страничка, получается что это именно то, что надо. Кстати, ещё пример - электронное письмо с вложением.

Только они не бинарными вставляются, а перекодируются во что-то.

Ramirez

Дата 13.8.2008, 20:15 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 305
Регистрация: 18.1.2005
Где: Moscow, ExUSSR

Репутация: 1
Всего: 5

Иногда очень хочется отдать данные вместе со страницей. Картинки например. Чтобы не генерить доп. обращений к серверу...

а ведь давноесть способ (и не только с картинками):
<IMG SRC="data:image/gif;base64,[...]">

[...] - вместо этого идет картинка закодированная в base64. Но как всегда в IE это не работает (незнаю как в 7 версии) =\

вот пример как это работает:
http://www.greywyvern.com/code/php/binary2base64

кстати, про IE7:
http://dean.edwards.name/weblog/2005/06/base64-ie/

Вауу, это даже в IE6 (6.0.2900) работает!
http://dean.edwards.name/my/base64-ie.html

Это сообщение отредактировал(а) Ramirez - 13.8.2008, 20:19

gcc

Дата 30.1.2009, 11:59 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

попросили сделать эту эрунду

сейчас хоть убей, но картинка просто пустая smile

может кто-то показать рабочую, или в чем проблема?

Код



#!/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;

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 30.1.2009, 12:16 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

включаю ее так http://domain.ru/captcha.pl

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

shamber

Дата 30.1.2009, 15:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: нет
Всего: 18

стормозил

Это сообщение отредактировал(а) shamber - 30.1.2009, 15:07

gcc

Дата 30.1.2009, 16:05 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

я еще вспомнил это в книге "Рецепты для Программирования на perl" по-моиму 3 издание это было

кстате, я вот не понял, зачем генерить случайно число и криптографировать его?

если бот будет перебирать цыфры которые на картинке и вводить все в подрят, то в чем смылс от еще одного случайно числа или от криптографирования его?

(если от перебора цифр и букв, то проще просто банить тех кто много раз вводит не правильно ...)

Это сообщение отредактировал(а) gcc - 30.1.2009, 18:38

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

Usmanec

Дата 26.2.2009, 22:39 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 24.2.2009

Репутация: нет
Всего: нет

Могу предложить рабочий пример.
Скрипт гостевой находиться на одном серваке каптча на другом и все работает!
Форма с каптчей (Можно теститить сколько влезет сайт давно умер...)
Каптча Каждый раз циферки каптчи разные (Всмысле прорисовываются по разному, делал, что они еще плясали то в лево наклонятся то в право и тд, но не понравилось). (Зайдите по ссылке и пообоновляйте страницу...)
user posted image

Скрипт каптчи

Код


#!/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 (циферки на картинке).

Это сообщение отредактировал(а) Usmanec - 26.2.2009, 23:12

gcc

Дата 2.10.2009, 14:19 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

вот нашел модель http://search.cpan.org/~kazeburo/Catalyst-...ugin/Captcha.pm но дело не в этом...

подскажите, по каким причинам картинка может не выводиться в mod_perl?

в собственном сервере catalyst'a выводиться... в CGI по-моиму выдавалась нормально

может загловок криво выдается, но пока не нашел как посмотреть или поменять....

Это сообщение отредактировал(а) gcc - 2.10.2009, 14:22

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 2.10.2009, 14:54 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

в /myapp_server.pl -r выводиться

а в mod_perl2 не хочет

Код


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();

}

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 2.10.2009, 15:18 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

догадываюсь что проблема в print $c->create_captcha(); то что mod_perl ее не видит через print ?

нашел метод body, но пусто тоже самое, как это отправить в mod_perl2?

Код


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

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 3.10.2009, 10:37 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17

сделал, я наверное не допонял

в шаблон поставить:

Код


<TMPL_VAR NAME="captcha">

Код


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

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: разработка для Web \| Следующая тема »