Imagem de segurança v1.0 (CAPTCHA)

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 *