Captcha Generator

[BlindSniper]

I was bored and I made a captcha generator, but I have no use for it so I'm posting it here. I don't know what the standards are for captcha's are but I think mine does a reasonable job.

Imports System.Drawing
Imports System.Drawing.Drawing2D
Public Class CAPTCHA
    Dim cap As String
    Public ReadOnly Property CaptchaString As String
        Get
            Return cap
        End Get
    End Property
 
    Function GenerateCaptcha(ByVal NumberOfCharacters As Integer) As Bitmap
        Dim R As New Random
        Dim VerticalLineSpaceing As Integer = R.Next(5, 10) ' The space between each horizontal line
        Dim HorisontalLineSpaceing As Integer = R.Next(5, 10) ' The space between each Vertical line
 
 
 
        Dim CWidth As Integer = (NumberOfCharacters * 120) 'Generating the width
        Dim CHeight As Integer = 180 ' the height
        Dim CAPTCHA As New Bitmap(CWidth, CHeight)
        Dim allowedCharacters() As Char = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM123456789".ToCharArray 'Guess
        Dim str(NumberOfCharacters - 1) As Char ' The String to turn into a captcha
        For i = 0 To NumberOfCharacters - 1
            str(i) = allowedCharacters(R.Next(0, 61)) ' Generating random characters
        Next
 
        Using g As Graphics = Graphics.FromImage(CAPTCHA)
            Dim gradient As New Drawing2D.LinearGradientBrush(New Point(0, CInt(CHeight / 2)), New Point(CWidth, CInt(CHeight / 2)), Drawing.Color.FromArgb(R.Next(&HFF7D7D7D, &HFFFFFFFF)), Drawing.Color.FromArgb(R.Next(&HFF7D7D7D, &HFFFFFFFF)))
            'ABOVE: the gradient brush for the background
            g.FillRectangle(gradient, New Rectangle(0, 0, CWidth, CHeight))
            Dim plist As New List(Of Point) ' the list of points the curve goes through
 
            For i = 0 To str.Length - 1
                Dim FHeight As Integer = R.Next(60, 100) 'Font height in EM
                Dim Font As New Font("Arial", FHeight)
                Dim Y As Integer = R.Next(0, (CHeight - FHeight) - 40) 'Generating the Y value of a char: will be between the top  and (bottom - 40) to prevent half characters
                Dim X As Integer = CInt((((i * CWidth) - 10) / NumberOfCharacters))  'Some formula that made sense At the time that I typed it to generate the X value
                Dim p As New Point(X, Y)
 
                g.DrawString(str(i).ToString, Font, Brushes.Black, p)
 
                plist.Add(New Point(X, R.Next(CInt((CHeight / 2) - 40), CInt((CHeight / 2) + 40)))) ' add the points to the array
            Next
 
            plist.Add(New Point(CWidth, CInt(CHeight / 2))) 'for some reason it doesn't go to the end so we manually add the last point
          
            Dim ppen As New Pen(Brushes.Black, R.Next(5, 10)) ' the pen used to draw the curve
 
            g.DrawCurve(ppen, plist.ToArray)
 
            Dim pen As New Pen(Brushes.SteelBlue, CSng(R.Next(1, 2))) 'the pen that will draw the horisontal and vertical lines.
 
            For i = 1 To CWidth
                Dim ptop As New Point(i * VerticalLineSpaceing, 0)
                Dim pBottom As New Point(i * VerticalLineSpaceing, CHeight)
                g.DrawLine(pen, ptop, pBottom)
            Next
 
            'ABOVE Drawing the vertical lines
            For i = 1 To CHeight
                Dim ptop As New Point(0, i * HorisontalLineSpaceing)
                Dim pBottom As New Point(CWidth, i * HorisontalLineSpaceing)
                g.DrawLine(pen, ptop, pBottom)
            Next
 
            'ABOVE: drawing the horizontal lines
 
            Dim numnoise As Integer = CInt(CWidth * CHeight / 25) 'calculating the  number of noise for the block. This will generate 1 Noise per 25X25 block of pixels if im correct
            For i = 1 To numnoise / 2
                Dim X As Integer = R.Next(0, CWidth)
                Dim Y As Integer = R.Next(0, CHeight)
                Dim int As Integer = R.Next(1, 2)
                g.FillEllipse(Brushes.Black, New Rectangle(X, Y, R.Next(2, 5), R.Next(2, 5))) 'Size of the white noise
            Next
            'Above: Drawing the Black noise particles
 
 
            For i = 1 To numnoise / 2
                Dim X As Integer = R.Next(0, CWidth)
                Dim Y As Integer = R.Next(0, CHeight)
                Dim int As Integer = R.Next(1, 2)
 
 
                g.FillEllipse(Brushes.White, New Rectangle(X, Y, R.Next(2, 5), R.Next(2, 5))) 'Size of the white noise
            Next
            'Above: Drawing the white noise particles
        End Using
 
 
        cap = str
        Return CAPTCHA
    End Function
    Function Check(ByVal captcha As String, Optional ByVal IgnoreCase As Boolean = False) As Boolean
        If IgnoreCase Then
            If captcha.ToLower = CaptchaString.ToLower Then
                Return True
 
            Else
                Return False
 
            End If
        Else
            If captcha = CaptchaString Then
                Return True
 
            Else
                Return False
 
            End If
        End If
 
    End Function
 
End Class

I've Tested this up to 1500 characters. For some reason It doesn't want more than that, although i'm not going to fix that for obvious reasons.

EDIT: oh and yes I do Know recaptcha is better, but it's a nice simple example of creating your own.

[akhileshbc]

That's cool

[minitech]

This quick DeCaptcha removes the grid, the background, and all the white flecks:

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Using openDialog As New OpenFileDialog()
            openDialog.Filter = "All Images|*.jpg;*.jpeg;*.gif;*.tif;*.tiff;*.bmp;*.png"
            If openDialog.ShowDialog() = Windows.Forms.DialogResult.OK Then _
                Me.BackgroundImage = Image.FromFile(openDialog.FileName)
        End Using
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim b As New Bitmap(Me.BackgroundImage)
        Dim bd As Imaging.BitmapData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppArgb)
        Dim arr(bd.Width * bd.Height - 1) As Integer
        Dim arr2(arr.Length - 1) As Integer
        Runtime.InteropServices.Marshal.Copy(bd.Scan0, arr, 0, arr.Length)
        Runtime.InteropServices.Marshal.Copy(bd.Scan0, arr2, 0, arr.Length)
        For i As Integer = 0 To arr.Length - 1
            If arr(i) <> &HFF000000 Then arr(i) = &HFFFFFFFF
        Next

        For x As Integer = 2 To bd.Width - 3
            For y As Integer = 2 To bd.Height - 3
                Dim n As Integer = 0
                For dX As Integer = -2 To 2
                    For dY As Integer = -2 To 2
                        If arr2((y + dY) * bd.Width + x + dX) = &HFF000000 Then n += 1
                    Next
                Next
                If n >= 8 Then arr(y * bd.Width + x) = &HFF000000
            Next
        Next
        Runtime.InteropServices.Marshal.Copy(arr, 0, bd.Scan0, arr.Length)
        b.UnlockBits(bd)
        Me.BackgroundImage = b
    End Sub
End Class

I didn't have time to remove the rest of the things (only 5 minutes ) but I'll give it another try later

[BlindSniper]

lol that is scary, since I've seen lots of captchas that were less distorted than this on the internet. Nice code btw. But I will now have to make it more secure.

[intraman]

Very good. A few suggestions to make it more secure:
- Have the grid as a set of randomly colored lines, perhaps with a gradient. Not just the blue color.
- Have some of the characters overlapping
- Have the individual cells in the grid different widths / heights
- Put another line in but make it diagonal
- Have the characters themselves random colors and fonts each time
- Have one character that is slightly off the image

Hope this helps, but a great start anyway mate!

Jord

[BlindSniper]

I will probably redo this whole project when it's school holidays, currently I'm buried under a mountain of work, although It would probably only take a day at the longest.

[Heiningba]

lol how to run this code? i copied and pasted it on a new form and changes class name to whatever it is, does not work
While calling functions it is not working

[akhileshbc]

lol how to run this code? i copied and pasted it on a new form and changes class name to whatever it is, does not work
While calling functions it is not working

Create a new project. Add a new PictureBox and a button into your form. And use this code:

Public Class Form1
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
 
        '~~~ Create the object
        Dim myCaptcha As New captcha
 
        '~~~ Generate the captcha image and assign this image to the picturebox
        PictureBox1.Image = myCaptcha.generatecaptcha(5)
 
    End Sub
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
        PictureBox1.SizeMode = PictureBoxSizeMode.AutoSize  '~~~ or, you can drag the picturebox to a bigger size(at design time) that could afford the image generated 
        Me.WindowState = FormWindowState.Maximized  '~~~ show the form as maximized
 
    End Sub
 
End Class

Then add a new class(Project menu --> Add new class).
And copy-paste the code from the first post of this thread.

Then run your project.

[BlindSniper]

I have holidays now, So I will be redoing this whole class over a few weeks.

[Heiningba]

mmm great thanks for the code and thanks for letting me know how to run it too. i was wondering where that captcha image would come....did not think about picture box T.T