[SOURCE] Generar captchas para aplicaciones

[Eleкtro]

Buenas

Os dejo este sencillo y pequeño algoritmo para generar captchas para nuestras aplicaciones.

Se puede extender para añadir "ruido" en la imagen, o alterar la posición y la rotación de las letras, pero eso no lo he implementado ya que me parece algo excesivo para "autentificar" una simple aplicación de escritorio.

       

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Dim captcha As KeyValuePair(Of Bitmap, String) = GenerateCaptcha(length:=5, size:=PictureBox1.Size)

PictureBox1.BackgroundImage = captcha.Key
Console.WriteLine(captcha.Value)

Código fuente:

Código (vbnet) [Seleccionar] Expandir


    Dim rand As New Random

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Generates a captcha image.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Dim captcha As KeyValuePair(Of Bitmap, String) = GenerateCaptcha(5, PictureBox1.ClientSize)
   ''' PictureBox1.BackgroundImage = captcha.Key
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="length">
   ''' The character length.
   ''' </param>
   '''
   ''' <param name="size">
   ''' The image size.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' A <see cref="KeyValuePair(Of Bitmap, String)"/> that contains the captcha image and the resulting string.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Shared Function GenerateCaptcha(ByVal length As Integer,
                                          ByVal size As Size) As KeyValuePair(Of Bitmap, String)

       Return GenerateCaptcha(length, size.Width, size.Height)

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Generates a captcha image.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Dim captcha As KeyValuePair(Of Bitmap, String) = GenerateCaptcha(5, PictureBox1.Width, PictureBox1.Height)
   ''' PictureBox1.BackgroundImage = captcha.Key
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="length">
   ''' The character length.
   ''' </param>
   '''
   ''' <param name="width">
   ''' The image width.
   ''' </param>
   '''
   ''' <param name="height">
   ''' The image height.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' A <see cref="KeyValuePair(Of Bitmap, String)"/> that contains the captcha image and the resulting string.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Shared Function GenerateCaptcha(ByVal length As Integer,
                                          ByVal width As Integer,
                                          ByVal height As Integer) As KeyValuePair(Of Bitmap, String)

       Dim captcha As New Bitmap(width, height)
       Dim fontHeight As Integer = (height \ 2)
       Dim vLineSpacing As Integer = 2
       Dim hLineSpacing As Integer = 2
       Dim str As String = String.Join("", (From c As Char In "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
                                    Order By rand.Next Select c).Take(length))

       Using g As Graphics = Graphics.FromImage(captcha)

           g.InterpolationMode = InterpolationMode.High
           g.SmoothingMode = SmoothingMode.HighQuality
           g.TextRenderingHint = TextRenderingHint.AntiAliasGridFit
           g.CompositingQuality = CompositingQuality.HighQuality

           Using gradientBrush As New LinearGradientBrush(New Point(0, (height \ 2)),
                                                          New Point(width, (height \ 2)),
                                                          Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)),
                                                          Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)))

               ' Draw gradient background.
               g.FillRectangle(gradientBrush, New Rectangle(0, 0, width, height))

           End Using ' gradientBrush

           Using linesPen As New Pen(Brushes.Black, 1)

               ' Draw vertical lines.
               For i As Integer = 1 To width
                   Dim ptop As New Point(i * vLineSpacing, 0)
                   Dim pBottom As New Point(i * vLineSpacing, height)
                   g.DrawLine(linesPen, ptop, pBottom)
               Next i

               ' Draw horizontal lines.
               For i As Integer = 1 To height
                   Dim ptop As New Point(0, i * hLineSpacing)
                   Dim pBottom As New Point(width, i * hLineSpacing)
                   g.DrawLine(linesPen, ptop, pBottom)
               Next i

           End Using ' linesPen

           Using font As New Font("Arial", fontHeight)

               Using path As New GraphicsPath

                   For i As Integer = 0 To (str.Length - 1)

                       Dim charX As Integer =
                           (((i * (width - (g.MeasureString(str(i), font, width).ToSize.Width \ length)))) \ length)

                       Dim charY As Integer = (height \ 2)

                       path.AddString(str(i), font.FontFamily, FontStyle.Bold, fontHeight,
                                      New Point(charX, charY), New StringFormat With {.LineAlignment = StringAlignment.Center})

                   Next i

                   ' Draw characters.
                   g.DrawPath(Pens.Black, path)
                   g.FillPath(Brushes.Gainsboro, path)

               End Using

           End Using ' font

       End Using ' g

       Return New KeyValuePair(Of Bitmap, String)(captcha, str)

   End Function

Saludos

[kub0x]

Simple y sencillo, se ve estupéndamente EleKtro, como curiosidad, ¿has probado a pasarle OCR?

Saludos!

[Eleкtro]

Simple y sencillo, se ve estupéndamente EleKtro, como curiosidad, ¿has probado a pasarle OCR?

Segurísimo que cualquier motor OCR leería perfectamente las letras, ni falta que hace probarlo creo yo, ya que no implementé medidas de seguridad por así decirlo, vaya.

El propósito del código que compartí era mostrar las letras lo más legible posible para el usuario, sin sobrecargar la imagen, ya que considero que una aplicación no necesita más.

Aquí les dejo una versión alternativa para mostrar maneras de extender el código, con fuentes de letra aleatorias, posición de letras aleatoria, curvas y ruido,
aunque no me gusta como ha quedado el resultado, se podría hacer mucho mejor pero no soy ningún gurú del GDI+ y no invertiré más tiempo en ello, ya que como dije, no quería sobrecargar la imagen.

     

     

Código (vbnet) [Seleccionar] Expandir

   Private Shared rand As New Random

   Public Shared Function GenerateCaptcha(ByVal length As Integer,
                                          ByVal width As Integer,
                                          ByVal height As Integer) As KeyValuePair(Of Bitmap, String)

       Dim vLinesGdi As New Dictionary(Of Point, Point)
       Dim hLinesGdi As New Dictionary(Of Point, Point)
       Dim charsGdi As New Dictionary(Of Char, Point)
       Dim captcha As New Bitmap(width, height)
       Dim fontHeight As Integer = (height \ 2)
       Dim vLineSpacing As Integer = 2
       Dim hLineSpacing As Integer = 2
       Dim str As String =
           String.Join("", (From c As Char In "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
                            Order By rand.Next Select c).Take(length))

       ' Set vertical lines.
       For i As Integer = 1 To width
           vLinesGdi.Add(New Point(i * vLineSpacing, 0), New Point(i * vLineSpacing, height))
       Next i

       ' Set horizontal lines.
       For i As Integer = 1 To height
           hLinesGdi.Add(New Point(0, i * hLineSpacing), New Point(width, i * hLineSpacing))
       Next i

       ' Set char positions.
       Using g As Graphics = Graphics.FromImage(captcha)

           For i As Integer = 0 To (length - 1)

               Using font As New Font(GetRandomFont, fontHeight)

                   Dim charPosX As Integer =
                       (((i * (width - (g.MeasureString(str(i), font, width).ToSize.Width \ length)))) \ length)

                   Dim charPosY As Integer = rand.Next((fontHeight \ 2), height - (fontHeight \ 2))

                   charsGdi.Add(str(i), New Point(charPosX, charPosY))

               End Using ' font

           Next

       End Using ' g

       Using g As Graphics = Graphics.FromImage(captcha)

           g.InterpolationMode = InterpolationMode.HighQualityBicubic
           g.SmoothingMode = SmoothingMode.HighQuality
           g.TextRenderingHint = TextRenderingHint.AntiAliasGridFit
           g.CompositingQuality = CompositingQuality.GammaCorrected
           g.PixelOffsetMode = PixelOffsetMode.HighQuality

           ' Draw background.
           Using bgBrush As New LinearGradientBrush(New Point(0, (height \ 2)),
                                                    New Point(width, (height \ 2)),
                                                    Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)),
                                                    Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)))

               g.FillRectangle(bgBrush, New Rectangle(0, 0, width, height))
           End Using ' bgBrush

           ' Draw rectangles.
           Using linePen As New Pen(Brushes.Gray, 1)

               ' Draw vertical rect-lines.
               For Each linePair As KeyValuePair(Of Point, Point) In vLinesGdi
                   g.DrawLine(linePen, linePair.Key, linePair.Value)
               Next linePair

               ' Draw horizontal rect-lines.
               For Each linePair As KeyValuePair(Of Point, Point) In hLinesGdi
                   g.DrawLine(linePen, linePair.Key, linePair.Value)
               Next linePair

           End Using ' linePen

           ' Draw characters.
           For Each charPoint As KeyValuePair(Of Char, Point) In charsGdi

               Using font As New Font(GetRandomFont, fontHeight)

                   Using path As New GraphicsPath

                       path.FillMode = FillMode.Alternate
                       path.AddString(charPoint.Key, font.FontFamily, FontStyle.Bold, fontHeight,
                                      New Point(charPoint.Value.X, charPoint.Value.Y),
                                      New StringFormat With {
                                          .Alignment = StringAlignment.Near,
                                          .LineAlignment = StringAlignment.Center,
                                          .FormatFlags = StringFormatFlags.NoFontFallback Or StringFormatFlags.NoWrap
                                      })

                       g.DrawPath(Pens.Black, path)
                       g.FillPath(Brushes.Gainsboro, path)

                   End Using ' path

               End Using ' font

           Next charPoint

           ' Draw curve.
           Using curvePen As New Pen(Brushes.Black, 1.5F)
               g.DrawCurve(curvePen, charsGdi.Values.ToArray, 0, (length - 1), 10.0F)
           End Using ' curvePen

           '' Add noise.
           '' Nota: Usar "Bitmap.Lockbits()" para quien quiera una implementación más rápida y eficiente.
           'For x As Integer = 0 To (width - 1) Step 6
           '    For y As Integer = 0 To (height - 1) Step 6
           '        Dim num As Integer = rand.Next(0, 256)
           '        captcha.SetPixel(x, y, Color.FromArgb(255, num, num, num))
           '    Next
           'Next

       End Using ' g

       Return New KeyValuePair(Of Bitmap, String)(captcha, str)

   End Function

   Public Shared Function GetRandomFont() As FontFamily

       Using fontCol As New InstalledFontCollection
           Return (From family As FontFamily In fontCol.Families
                   Order By rand.Next Select family).First
       End Using

   End Function

Notas:
No lo he probado con un OCR.
El código es solo un ejemplo, una base donde agarrarse.
Conviene usar una colección de fuentes óptima y personalizada, para evitar fuentes de texto incompletas y/o simbólicas como la fuente Widenings de Microsoft.

Saludos!