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 ifend 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 *
Discussão (7)
Carregando comentários...