/projects/WebControls/Captcha/CaptchaImage.vb

  1Imports System
  2Imports System.Drawing
  3Imports System.Drawing.Drawing2D
  4Imports System.Drawing.Imaging
  5
  6''' <summary>
  7''' CAPTCHA image generation class
  8''' </summary>
  9''' <remarks>
 10''' Adapted from the excellent code at 
 11''' http://www.codeproject.com/aspnet/CaptchaImage.asp
 12'''
 13''' Jeff Atwood
 14''' http://www.codinghorror.com/
 15''' </remarks>
 16Public Class CaptchaImage
 17
 18    Private _height As Integer
 19    Private _width As Integer
 20    Private _rand As Random
 21    Private _generatedAt As DateTime
 22    Private _randomText As String
 23    Private _randomTextLength As Integer
 24    Private _randomTextChars As String
 25    Private _fontFamilyName As String
 26    Private _fontWarp As FontWarpFactor
 27    Private _backgroundNoise As BackgroundNoiseLevel
 28    Private _lineNoise As LineNoiseLevel
 29    Private _guid As String
 30    Private _fontWhitelist As String
 31
 32#Region "  Public Enums"
 33
 34    ''' <summary>
 35    ''' Amount of random font warping to apply to rendered text
 36    ''' </summary>
 37    Public Enum FontWarpFactor
 38        None
 39        Low
 40        Medium
 41        High
 42        Extreme
 43    End Enum
 44
 45    ''' <summary>
 46    ''' Amount of background noise to add to rendered image
 47    ''' </summary>
 48    Public Enum BackgroundNoiseLevel
 49        None
 50        Low
 51        Medium
 52        High
 53        Extreme
 54    End Enum
 55
 56    ''' <summary>
 57    ''' Amount of curved line noise to add to rendered image
 58    ''' </summary>
 59    Public Enum LineNoiseLevel
 60        None
 61        Low
 62        Medium
 63        High
 64        Extreme
 65    End Enum
 66
 67#End Region
 68
 69#Region "  Public Properties"
 70
 71    ''' <summary>
 72    ''' Returns a GUID that uniquely identifies this Captcha
 73    ''' </summary>
 74    Public ReadOnly Property UniqueId() As String
 75        Get
 76            Return _guid
 77        End Get
 78    End Property
 79
 80    ''' <summary>
 81    ''' Returns the date and time this image was last rendered
 82    ''' </summary>
 83    Public ReadOnly Property RenderedAt() As DateTime
 84        Get
 85            Return _generatedAt
 86        End Get
 87    End Property
 88
 89    ''' <summary>
 90    ''' Font family to use when drawing the Captcha text. If no font is provided, a random font will be chosen from the font whitelist for each character.
 91    ''' </summary>
 92    Public Property Font() As String
 93        Get
 94            Return _fontFamilyName
 95        End Get
 96        Set(ByVal Value As String)
 97            Try
 98                Dim font1 As Font = New Font(Value, 12.0!)
 99                _fontFamilyName = Value
100                font1.Dispose()
101            Catch ex As Exception
102                _fontFamilyName = Drawing.FontFamily.GenericSerif.Name
103            End Try
104        End Set
105    End Property
106
107    ''' <summary>
108    ''' Amount of random warping to apply to the Captcha text.
109    ''' </summary>
110    Public Property FontWarp() As FontWarpFactor
111        Get
112            Return _fontWarp
113        End Get
114        Set(ByVal Value As FontWarpFactor)
115            _fontWarp = Value
116        End Set
117    End Property
118
119    ''' <summary>
120    ''' Amount of background noise to apply to the Captcha image.
121    ''' </summary>
122    Public Property BackgroundNoise() As BackgroundNoiseLevel
123        Get
124            Return _backgroundNoise
125        End Get
126        Set(ByVal Value As BackgroundNoiseLevel)
127            _backgroundNoise = Value
128        End Set
129    End Property
130
131    Public Property LineNoise() As LineNoiseLevel
132        Get
133            Return _lineNoise
134        End Get
135        Set(ByVal value As LineNoiseLevel)
136            _lineNoise = value
137        End Set
138    End Property
139
140    ''' <summary>
141    ''' A string of valid characters to use in the Captcha text. 
142    ''' A random character will be selected from this string for each character.
143    ''' </summary>
144    Public Property TextChars() As String
145        Get
146            Return _randomTextChars
147        End Get
148        Set(ByVal Value As String)
149            _randomTextChars = Value
150            _randomText = GenerateRandomText()
151        End Set
152    End Property
153
154    ''' <summary>
155    ''' Number of characters to use in the Captcha text. 
156    ''' </summary>
157    Public Property TextLength() As Integer
158        Get
159            Return _randomTextLength
160        End Get
161        Set(ByVal Value As Integer)
162            _randomTextLength = Value
163            _randomText = GenerateRandomText()
164        End Set
165    End Property
166
167    ''' <summary>
168    ''' Returns the randomly generated Captcha text.
169    ''' </summary>
170    Public ReadOnly Property [Text]() As String
171        Get
172            Return _randomText
173        End Get
174    End Property
175
176    ''' <summary>
177    ''' Width of Captcha image to generate, in pixels 
178    ''' </summary>
179    Public Property Width() As Integer
180        Get
181            Return _width
182        End Get
183        Set(ByVal Value As Integer)
184            If (Value <= 60) Then
185                Throw New ArgumentOutOfRangeException("width", Value, "width must be greater than 60.")
186            End If
187            _width = Value
188        End Set
189    End Property
190
191    ''' <summary>
192    ''' Height of Captcha image to generate, in pixels 
193    ''' </summary>
194    Public Property Height() As Integer
195        Get
196            Return _height
197        End Get
198        Set(ByVal Value As Integer)
199            If Value <= 30 Then
200                Throw New ArgumentOutOfRangeException("height", Value, "height must be greater than 30.")
201            End If
202            _height = Value
203        End Set
204    End Property
205
206    ''' <summary>
207    ''' A semicolon-delimited list of valid fonts to use when no font is provided.
208    ''' </summary>
209    Public Property FontWhitelist() As String
210        Get
211            Return _fontWhitelist
212        End Get
213        Set(ByVal value As String)
214            _fontWhitelist = value
215        End Set
216    End Property
217
218#End Region
219
220    Public Sub New()
221        _rand = New Random
222        _fontWarp = FontWarpFactor.Low
223        _backgroundNoise = BackgroundNoiseLevel.Low
224        _lineNoise = LineNoiseLevel.None
225        _width = 180
226        _height = 50
227        _randomTextLength = 5
228        _randomTextChars = "ACDEFGHJKLNPQRTUVXYZ2346789"
229        _fontFamilyName = ""
230        ' -- a list of known good fonts in on both Windows XP and Windows Server 2003
231        _fontWhitelist = _
232            "arial;arial black;comic sans ms;courier new;estrangelo edessa;franklin gothic medium;" & _
233            "georgia;lucida console;lucida sans unicode;mangal;microsoft sans serif;palatino linotype;" & _
234            "sylfaen;tahoma;times new roman;trebuchet ms;verdana"
235        _randomText = GenerateRandomText()
236        _generatedAt = DateTime.Now
237        _guid = Guid.NewGuid.ToString()
238    End Sub
239
240    ''' <summary>
241    ''' Forces a new Captcha image to be generated using current property value settings.
242    ''' </summary>
243    Public Function RenderImage() As Bitmap
244        Return GenerateImagePrivate()
245    End Function
246
247    ''' <summary>
248    ''' Returns a random font family from the font whitelist
249    ''' </summary>
250    Private Function RandomFontFamily() As String
251        Static ff() As String
252        '-- small optimization so we don't have to split for each char
253        If ff Is Nothing Then
254            ff = _fontWhitelist.Split(";"c)
255        End If
256        Return ff(_rand.Next(0, ff.Length))
257    End Function
258
259    ''' <summary>
260    ''' generate random text for the CAPTCHA
261    ''' </summary>
262    Private Function GenerateRandomText() As String
263        Dim sb As New System.Text.StringBuilder(_randomTextLength)
264        Dim maxLength As Integer = _randomTextChars.Length
265        For n As Integer = 0 To _randomTextLength - 1
266            sb.Append(_randomTextChars.Substring(_rand.Next(maxLength), 1))
267        Next
268        Return sb.ToString
269    End Function
270
271    ''' <summary>
272    ''' Returns a random point within the specified x and y ranges
273    ''' </summary>
274    Private Function RandomPoint(ByVal xmin As Integer, ByVal xmax As Integer, ByRef ymin As Integer, ByRef ymax As Integer) As PointF
275        Return New PointF(_rand.Next(xmin, xmax), _rand.Next(ymin, ymax))
276    End Function
277
278    ''' <summary>
279    ''' Returns a random point within the specified rectangle
280    ''' </summary>
281    Private Function RandomPoint(ByVal rect As Rectangle) As PointF
282        Return RandomPoint(rect.Left, rect.Width, rect.Top, rect.Bottom)
283    End Function
284
285    ''' <summary>
286    ''' Returns a GraphicsPath containing the specified string and font
287    ''' </summary>
288    Private Function TextPath(ByVal s As String, ByVal f As Font, ByVal r As Rectangle) As GraphicsPath
289        Dim sf As StringFormat = New StringFormat
290        sf.Alignment = StringAlignment.Near
291        sf.LineAlignment = StringAlignment.Near
292        Dim gp As GraphicsPath = New GraphicsPath
293        gp.AddString(s, f.FontFamily, CType(f.Style, Integer), f.Size, r, sf)
294        Return gp
295    End Function
296
297    ''' <summary>
298    ''' Returns the CAPTCHA font in an appropriate size 
299    ''' </summary>
300    Private Function GetFont() As Font
301        Dim fsize As Single
302        Dim fname As String = _fontFamilyName
303        If fname = "" Then
304            fname = RandomFontFamily()
305        End If
306        Select Case Me.FontWarp
307            Case FontWarpFactor.None
308                fsize = Convert.ToInt32(_height * 0.7)
309            Case FontWarpFactor.Low
310                fsize = Convert.ToInt32(_height * 0.8)
311            Case FontWarpFactor.Medium
312                fsize = Convert.ToInt32(_height * 0.85)
313            Case FontWarpFactor.High
314                fsize = Convert.ToInt32(_height * 0.9)
315            Case FontWarpFactor.Extreme
316                fsize = Convert.ToInt32(_height * 0.95)
317        End Select
318        Return New Font(fname, fsize, FontStyle.Bold)
319    End Function
320
321    ''' <summary>
322    ''' Renders the CAPTCHA image
323    ''' </summary>
324    Private Function GenerateImagePrivate() As Bitmap
325        Dim fnt As Font = Nothing
326        Dim rect As Rectangle
327        Dim br As Brush
328        Dim bmp As Bitmap = New Bitmap(_width, _height, PixelFormat.Format32bppArgb)
329        Dim gr As Graphics = Graphics.FromImage(bmp)
330        gr.SmoothingMode = SmoothingMode.AntiAlias
331
332        '-- fill an empty white rectangle
333        rect = New Rectangle(0, 0, _width, _height)
334        br = New SolidBrush(Color.White)
335        gr.FillRectangle(br, rect)
336
337        Dim charOffset As Integer = 0
338        Dim charWidth As Double = _width / _randomTextLength
339        Dim rectChar As Rectangle
340
341        For Each c As Char In _randomText
342            '-- establish font and draw area
343            fnt = GetFont()
344            rectChar = New Rectangle(Convert.ToInt32(charOffset * charWidth), 0, Convert.ToInt32(charWidth), _height)
345
346            '-- warp the character
347            Dim gp As GraphicsPath = TextPath(c, fnt, rectChar)
348            WarpText(gp, rectChar)
349
350            '-- draw the character
351            br = New SolidBrush(Color.Black)
352            gr.FillPath(br, gp)
353
354            charOffset += 1
355        Next
356
357        AddNoise(gr, rect)
358        AddLine(gr, rect)
359
360        '-- clean up unmanaged resources
361        fnt.Dispose()
362        br.Dispose()
363        gr.Dispose()
364
365        Return bmp
366    End Function
367
368    ''' <summary>
369    ''' Warp the provided text GraphicsPath by a variable amount
370    ''' </summary>
371    Private Sub WarpText(ByVal textPath As GraphicsPath, ByVal rect As Rectangle)
372        Dim WarpDivisor As Single
373        Dim RangeModifier As Single
374
375        Select Case _fontWarp
376            Case FontWarpFactor.None
377                Return
378            Case FontWarpFactor.Low
379                WarpDivisor = 6
380                RangeModifier = 1
381            Case FontWarpFactor.Medium
382                WarpDivisor = 5
383                RangeModifier = 1.3
384            Case FontWarpFactor.High
385                WarpDivisor = 4.5
386                RangeModifier = 1.4
387            Case FontWarpFactor.Extreme
388                WarpDivisor = 4
389                RangeModifier = 1.5
390        End Select
391
392        Dim rectF As RectangleF
393        rectF = New RectangleF(Convert.ToSingle(rect.Left), 0, Convert.ToSingle(rect.Width), rect.Height)
394
395        Dim hrange As Integer = Convert.ToInt32(rect.Height / WarpDivisor)
396        Dim wrange As Integer = Convert.ToInt32(rect.Width / WarpDivisor)
397        Dim left As Integer = rect.Left - Convert.ToInt32(wrange * RangeModifier)
398        Dim top As Integer = rect.Top - Convert.ToInt32(hrange * RangeModifier)
399        Dim width As Integer = rect.Left + rect.Width + Convert.ToInt32(wrange * RangeModifier)
400        Dim height As Integer = rect.Top + rect.Height + Convert.ToInt32(hrange * RangeModifier)
401
402        If left < 0 Then left = 0
403        If top < 0 Then top = 0
404        If width > Me.Width Then width = Me.Width
405        If height > Me.Height Then height = Me.Height
406
407        Dim leftTop As PointF = RandomPoint(left, left + wrange, top, top + hrange)
408        Dim rightTop As PointF = RandomPoint(width - wrange, width, top, top + hrange)
409        Dim leftBottom As PointF = RandomPoint(left, left + wrange, height - hrange, height)
410        Dim rightBottom As PointF = RandomPoint(width - wrange, width, height - hrange, height)
411
412        Dim points As PointF() = New PointF() {leftTop, rightTop, leftBottom, rightBottom}
413        Dim m As New Matrix
414        m.Translate(0, 0)
415        textPath.Warp(points, rectF, m, WarpMode.Perspective, 0)
416    End Sub
417
418
419    ''' <summary>
420    ''' Add a variable level of graphic noise to the image
421    ''' </summary>
422    Private Sub AddNoise(ByVal graphics1 As Graphics, ByVal rect As Rectangle)
423        Dim density As Integer
424        Dim size As Integer
425
426        Select Case _backgroundNoise
427            Case BackgroundNoiseLevel.None
428                Return
429            Case BackgroundNoiseLevel.Low
430                density = 30
431                size = 40
432            Case BackgroundNoiseLevel.Medium
433                density = 18
434                size = 40
435            Case BackgroundNoiseLevel.High
436                density = 16
437                size = 39
438            Case BackgroundNoiseLevel.Extreme
439                density = 12
440                size = 38
441        End Select
442
443        Dim br As New SolidBrush(Color.Black)
444        Dim max As Integer = Convert.ToInt32(Math.Max(rect.Width, rect.Height) / size)
445
446        For i As Integer = 0 To Convert.ToInt32((rect.Width * rect.Height) / density)
447            graphics1.FillEllipse(br, _rand.Next(rect.Width), _rand.Next(rect.Height), _
448                _rand.Next(max), _rand.Next(max))
449        Next
450        br.Dispose()
451    End Sub
452
453    ''' <summary>
454    ''' Add variable level of curved lines to the image
455    ''' </summary>
456    Private Sub AddLine(ByVal graphics1 As Graphics, ByVal rect As Rectangle)
457
458        Dim length As Integer
459        Dim width As Single
460        Dim linecount As Integer
461
462        Select Case _lineNoise
463            Case LineNoiseLevel.None
464                Return
465            Case LineNoiseLevel.Low
466                length = 4
467                width = Convert.ToSingle(_height / 31.25) ' 1.6
468                linecount = 1
469            Case LineNoiseLevel.Medium
470                length = 5
471                width = Convert.ToSingle(_height / 27.7777) ' 1.8
472                linecount = 1
473            Case LineNoiseLevel.High
474                length = 3
475                width = Convert.ToSingle(_height / 25) ' 2.0
476                linecount = 2
477            Case LineNoiseLevel.Extreme
478                length = 3
479                width = Convert.ToSingle(_height / 22.7272) ' 2.2
480                linecount = 3
481        End Select
482
483        Dim pf(length) As PointF
484        Dim p As New Pen(Color.Black, width)
485
486        For l As Integer = 1 To linecount
487            For i As Integer = 0 To length
488                pf(i) = RandomPoint(rect)
489            Next
490            graphics1.DrawCurve(p, pf, 1.75)
491        Next
492
493        p.Dispose()
494    End Sub
495
496End Class