Este script permite que você mostre as figuras do seu site de forma mais segura.
Sugiro a implementação do código para que outros sites não utilizem imagens.

• Download img.pl
• Enviar nova versão

Esconder código-fonte

#!perl

#  Autor: Carcarah do Sertão
#
#  Email: thenazgul@terra.com.br
#  Web: http://www.wanadobe.biz/~carcarah
#  Por favor, NÃO REMOVAM O NOME DO AUTOR

#### COMO USAR ESTE SCRIPT ####
# Dentro do código html, insira na tag <img src="imagem.pl?img=nome_imagem">

# Requer livraria CGI
use CGI;

# Coloque aqui o diretório das imagens do servidor web. Se você não sabe qual sua pasta $HOME, sinto muito.
use constant DD => "/home/fulano/www/imagens";

# Tamanho do Buffer. Você pode aumentar esse valor. De acordo com sua largura de banda.
# Aconselho não mudar. Você pode sentar sua máquina ou tornar a conexão lenta
use constant BUF => 4_096;

# Biblioteca para função ReadParse
do "cgi-lib.pl" or die "Erro lendo cgi-lib: $!";

# Função que lê dados do form. Você pode substituir por alguma mais familiar.
&ReadParse(*dados);

# Lê campo no img no form HTML
$i = $dados{'img'};

# Inicio

&imagem($i);
exit();

# fim

# Funcao
sub imagem {
  my $h = new CGI();  
  my $arquivo = shift;
  
  my $aux = $arquivo;
  
  my $buffer = 0;
  
  my ($nome, $tipo) = split(/\.(\w+)$/,$aux);

  $tipo = "jpeg" if($tipo eq "jpg");
  
  print $h->header(-type => "image/$tipo", -expires=>"-1d"); 

  # muda o modo de saída de dados.
  
  binmode STDOUT;
  
  local *IMG;

  open IMG, DD."/$arquivo" or die "Erro abrindo $arquivo: $!";

  # Lê e imprime o conteúdo do arquivo. 
  # O primeiro parâmetro da função read() é o ponteiro para o arquivo.
  # O segundo parâmetro da função é a variável para armazenar os dados.
  # O terceiro parâmetro é o valor em bytes que será transferido
  print $buffer while( read(IMG,$buffer,BUF) );

  # Fecha ponteiro.
  close IMG;
  
  # Limpa
  undef $buffer;
}

Introdução a Persistência de Estrutura de Dados em Perl

Calculadora de notas versão Perl

Algoritmo de Fatoração de Fermat (FFA) em Perl

Verificação de IP em blacklists

Tratando Exceções com o Perl

Nenhum comentário foi encontrado.