Imagem de segurança v1.0 (CAPTCHA)

[hargon 64]

Nunca vi um código que gerasse imagem de segurança utilizando ASP.

 

Por isso resolvi criar um e compartilhar com vocês. O script foi criado para gerar imagem no tamanho 180 x 80 pixel.

 

Para dificultar a leitura por alguns programas utilizei imagens para ser o fundo da imagem de segurança.

Download de fundos exemplos: http://rapidshare.com/files/36225772/imgseguranca.zip.html

 

Utilizei alguns códigos encontrados aqui mesmo no fórum para facilitar meu trabalho. rs

 

imagem.asp

<%
'####################################################
'#   Por: Carlos Alessandro Ribeiro(rOcKLoCo)
'#   Data: 17/10/2003
'####################################################

Function GeraString(tamString, tipo, tamParte)
	tamString = Int(tamString)	 'nº de caracteres em cada parte
	tipo = Int(tipo)	   'tipo da String: 1 alfanumérica, 2 = só letras, 3 = números
	tamParte = Int(tamParte)	 'nº de partes que será criada
	
	if IsNumeric(tamString)  = False OR tamString = 0 then
		tamString = 5
	end if

	if IsNumeric(tipo) = False OR tipo = 0 then
		tipo = 1
	end if

	if IsNumeric(tamParte) = False OR tamParte = 0 then
		tamParte = 3
	end if
	
	if tipo = 1 then
		MyArr = Array("1","2","3","4","5","6","7","8","9","0","a","b","c","d","e","f","g","h","i","j","k","l","m","n", "o","p","q","r","s","t","u","v","w","x","y","z","A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P", "Q","R","S","T","U","V","W","X","Y","Z")
	elseif tipo = 2 then
		MyArr = Array("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z", "A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z")
	else
		MyArr = Array("1","2","3","4","5","6","7","8","9","0")
	end if
	
	for d = 1 to tamParte
		for ij = 1 to tamString
		   Randomize
		   StringGerada = StringGerada & MyArr(Int(Rnd*UBound(MyArr)))
		next
		varRand = StringGerada
		
		if tamParte  = 1 then
		   StringFinal = StringFinal &  varRand
		else
		   	if d = tamParte then
				StringFinal = StringFinal & varRand
		   	else
				if d = 1 then
					StringFinal = StringFinal & varRand & " - " 
				else
					StringFinal = StringFinal & varRand & " - "
				end if
		   end if
		  end if
		  StringGerada = ""
	next
	
	GeraString = StringFinal
End Function


'#################################################
'#   Por: Marcelo Eduardo B. Kopczynski
'#   Data: 08/12/2006
'#################################################

Function fnArray(dsParametro)
	Dim objArray
	Redim objArray(len(dsParametro) - 1)

	For i = 0 To len(dsParametro) - 1
	   objArray(i) = mid(dsParametro,i + 1,1)
	Next

	fnArray = objArray
End Function



'#################################################
'#   Criado por: hargon
'#   Data: 07/03/2007
'#################################################


function fsorteio(intCounter,minimo)
	intID = minimo
	while intID <= minimo or intID > intCounter
		Randomize
		intID = Rnd * intCounter
		if ((intID+1) > 1) and ((intID+1) < 2) then
			intID = 1
		else
			intID = cint(intID)
		end if			
	wend
	fsorteio = intID
end function


' INICIANDO PROCESSO PARA GERAR O CÓDIGO
' --------------------------------------
' Gerando novo código
palavra = GeraString(5,1,1)

' Armazenando o código em uma session para verificação posterior
session("imgsegurancav1.0") = palavra

' Transformando o código em array
MyArray = fnArray(palavra)

' Cores das letras
corArray = split("&HFF0000,&H008000,&HFF0000,&H000000,&HFFFFFF,&HFFA800,&HFFF600,&H0000FF,&HFF00BA",",")


set img = Server.CreateObject("Persits.Jpeg")
img.Open Server.MapPath("fundo/"&fsorteio(9,1)&".jpg")
for i = 0 to ubound(myArray)
	' Aqui é escolhido o tamanho da fonte
	tamanho = fsorteio(60,30)
	' Aqui é escolhida a cor da fonte	
	cor = corArray(fsorteio(ubound(CorArray),0))

	' Aqui o caracter é posicionado de acordo com sua ordem
	if i = 0 then
		x = fsorteio(20,15) 
		y = fsorteio(20,15)
	elseif i = 1 then
		x = fsorteio(50,45) 
		y = fsorteio(30,25)				
	elseif i = 2 then
		x = fsorteio(85,80) 
		y = fsorteio(25,20)					
	elseif i = 3 then
		x = fsorteio(115,110) 
		y = fsorteio(20,15)			
	elseif i = 4 then
		x = fsorteio(140,135) 
		y = fsorteio(25,20)					
	end if

	img.Canvas.Font.Color = cor
	img.Canvas.Font.Family = "Arial"
	img.Canvas.Font.Bold = True
	img.Canvas.Font.Size = tamanho
	img.Canvas.Font.Quality = 5

	img.Canvas.Print x, y, MyArray(i)
Next

img.SendBinary
%>

index.asp

<%
if len(request.querystring("txtcdseguranca")) > 0 then
	if lcase(session("imgsegurancav1.0")) = lcase(request.querystring("txtcdseguranca")) then
		response.write "Ok!<br />"
	else
		response.write "O código não confere.<br />"
	end if
end if
session("imgsegurancav1.0") = empty
%>
<img src="imagem.asp" />

<form name="frmverificaseguranca" action="index.asp" method="get">
	<label for="lblmsg">Informe o código acima</label><br />
	<input name="txtcdseguranca" type="text" size="5" value="" />
	<input name="btnenviar" type="submit" value="Enviar" />	
</form>

O script acima utiliza o componente ASP JPEG para gerar as imagens.

 

No mais é isso ai moçada... qualquer problema no código, me avisem para corrigir, pois criei ele em março... na época funcionou perfeitamente, mas estou postando aqui sem testá-lo de novo.

 

Quando sobrar um tempo vou criar um parecido com o do registro.br. Aí posto para vocês.

 

 

*O código foi editado no dia 4 de setembro de 2007 para corrigir o problema de vários acessos simultâneos

[jrcardozo 4]

valeu pela contribuição

[clayton-mer 0]

não funionou, gostaria de saber se alguem já instalou e testou.aguardo

[hargon 64]

Qual erro deu?

[Elbrinner 0]

Estou tentando usar o seu sistema e não estou conseguindo. Eu coloquei ele aqui: http://emfriburgo.com/default.asp?pagina=3 a sessão é diferente da imagem.

 

Estive observando o seu código e você grava a imagem no servidor para depois mostrar, se o site tiver varios acessos simultaneos isso não vai ser transformar em um problema?

 

obrigado

[hargon 64]

Esse problema dos acessos simultâneos foi uma falha não pensar.

 

O código já foi corrigido.

[jrcardozo 4]

bela colaboração hargon, só uma pergunta, o link para download está atualizado?

[hargon 64]

O link para download são apenas imagens exemplo para serem utilizadas como fundo da imagem gerada.

 

Ele ainda está funcionando. http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif