Image Loader

Publicado por Carcarah do Sertão Agreste 07/07/2004

[ Hits: 4.930 ]

Download img.pl




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.

  



Esconder código-fonte

#!perl

#  Autor: Carcarah do Sertão
#
#  Email: [email protected]
#  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;
}

Scripts recomendados

Tratando Exceções com o Perl

Calculadora de notas versão Perl

Sem Queda 2.0

Verificação de IP em blacklists

Auto Ident XML


  

Comentários

Nenhum comentário foi encontrado.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts