DeambulandoImágenes, música, vídeos y mucho más!

Para ti joven programador rebelde!

¿¿Harto del Spam en los formularios??

Harto de los robots que insertan publicidad en todos los formularios de las webs que se registran etc…

La solución es captcha!

¿Qué es? (vía wikipedia) Prueba de Turing pública y automática para diferenciar a máquinas y humanos

Vamos esto:

De esta forma un robot no puede leer lo que pone en la imagen.

Implementarlo en ASP es muy fácil, para ello me baso en el proyecto de motobit

Descarguemos el Office web components , e instalalo.

Da permisos de escritura a la carpeta c:/temp

Crea los ficheros necesarios por ejemplo:

Formulario:
<img src=”/include/captcha/generate-captcha.asp” />Código de verificación:
<input name=”imagecheck” type=”text” />

Verificación formulario:

if ucase(session(“checktext”))=ucase( request.Form(“imagecheck”)) then

call acciones
else
rw “Escribe en el formulario” &”: ” & session(“checktext”)
end if

generate-captcha.asp (genera la imagen) esta modificado del original

<%
Option Explicit
%>
<!–#INCLUDE FILE=”_captcha.asp”–>
<%
Dim checktext

checktext=RandomText(3)
session(“checktext”)=checktext

response.ContentType = “image/gif”
response.binarywrite textToGIF(checktext)
%>

_captcha.asp (de aquí he cambiado algunas cosas también)

<%

‘* Create a human testing image from text (using temp folder)
Function textToGIF(inText)
Dim FS: Set FS = CreateObject(“Scripting.FileSystemObject”)

‘get a temporary file name
Dim FileName: FileName = GetTempFileName(FS)

‘Create the GIF file with a text.
CreateGifFromText inText, FileName

‘Get the file as a binary data from disk
textToGIF = ReadBinaryFile(FileName)

‘Delete the temporary file
FS.DeleteFile FileName
End Function

‘* Create a human testing image from text as a file
Sub CreateGifFromText(inText, FileName)
on error resume next
‘Create an OWC object
Dim Chs
Set Chs = getOWC
if isempty(Chs) then
response.contenttype=”image/gif”
response.binarywrite ReadBinaryFile(server.mappath(“owc-not-installed.gif”))
response.end
end if

‘Get chart constants
Dim chConstants: Set chConstants = chs.Constants

‘Get a chart object
Dim Chart: Set Chart = chs.Charts.Add

‘Enable title for the chart.
Chart.HasTitle = True

randomize

‘Set the text and properties.
Chart.Title.Caption = inText

’set random fonts.
Dim Fonts, FontSizeAdd
FontSizeAdd = int(rnd * 10)
Fonts = array(“Times New Roman”,”Arial”,”Book Antiqua”,”Comic Sans MS”,”Haettenschweiler”,”Lucida Console”,”Monotype Corsiva”,”Impact”)
Chart.Title.Font.Name = Fonts(rnd * ubound(Fonts))
Chart.Title.Font.Size = FontSizeAdd + 13
Chart.Title.Font.Color = rnd * &H1000000
if rnd>0.5 then Chart.Title.Font.italic = true
if rnd>0.5 then Chart.Title.Font.bold = true

‘Set some chart background
‘(Interior of the ChartSpace and Title)
do
on error resume next
chs.Interior.SetPresetGradient int(1 + rnd * 7), _
int(1 + rnd * 4), int(1 + rnd * 24)
Chart.Title.Interior.SetPresetG

radient int(1 + rnd * 7), _
int(1 + rnd * 4), int(1 + rnd * 24)
loop while err<>0
on error goto 0

‘Save the image as a file
chs.ExportPicture FileName, , 10 + 20*len(intext) + 4 * FontSizeAdd , 45 + 1.5 * FontSizeAdd
End Sub

Function getOWC
On error resume next
Dim chs
Set Chs = CreateObject(“OWC10.ChartSpace”) ‘ As New ChartSpace
if isempty(Chs) then Set Chs = CreateObject(“OWC11.ChartSpace”)
‘if isempty(Chs) then Set Chs = CreateObject(” OWC.Chart”)
Set getOWC = Chs
End Function

‘************************* Binary and temp manipulation utilities

Function ReadBinaryFile(FileName)
Const adTypeBinary = 1

‘Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject(” ADODB.Stream”)

‘Specify stream type – we want To get binary data.
BinaryStream.Type = adTypeBinary

‘Open the stream
BinaryStream.Open

‘Load the file data from disk To stream object
BinaryStream.LoadFromFile FileName

‘Open the stream And get binary data from the object
ReadBinaryFile = BinaryStream.Read
End Function

Function GetTempFileName(Byref FS)
randomize
‘ GetTempFileName = FS.GetSpecialFolder(2) & “\” & rnd & “.gif”
GetTempFileName = “C:\temp\” & rnd & “.gif”‘modified chema carpeta con permisos
End Function

Function RandomText(Length)
Dim I, Out
Randomize
For I = 1 to Length
Out = Out & Chr(65 + rnd * 24) ‘modified chema solo letras
Next
RandomText = Out
End Function

%>

Y bueno nada mas, probad lo, es muy interesante, si tenéis dudad, os puedo ayudar ;)

Así me ha quedado a mí: http://www.barcelona-home.com/contact.asp

• Antivirus Gratis
• Tutorial rápido para hacer una ilustración con Software Libre (2)
• Cadenas de SPAM en Facebook
• Navega anonimamente con TOR
• Barra al estilo mac