Tipp 0205 Captcha generieren
Autor/Einsender:
Datum:
  Michael Werner
12.09.2010
Entwicklungsumgebung:   VB.Net 2008
Framework:   2.0
Ein sogenanntes CAPTCHA wird immer dann eingesetzt, wenn man im Internet unterscheiden möchte, ob ein Mensch oder eine Maschine (ein Bot) eine Eingabe macht. Das Anwendungsgebiet reicht vom Gästebuch bis hin zum Internetbanking. Man unterscheidet im Wesentlichen zwei Techniken. Die am weitesten verbreitete Methode ist die mit bildbasierten Chaptchas, bei denen Buchstaben und/oder Ziffern auf einem gestalteten Hintergrund verzerrt dargestellt werden.
Ein Mensch kann diese Buchstaben/Ziffern-Folge lesen, durch computergestütztes Programme ist dies eher schwierig. Allerdings ist ein solches Captcha nur bedingt sicher, das es inzwischen Programme gibt,  die mehr oder weniger gut die Zeichenfolge auslesen können. Darüber hinaus gibt es eine andere Technik, die über einen Nummerncode funktioniert. In diesem Tipp wird das bildbasierte Captcha generiert. Der dazu gebildete Zufallsstring ist in unserem Fall ein sogenannter mnemonischer String, d.h. zwischen zufälligen Konsonanten werden zu besseren Lesbarkeit Vokalen gesetzt. Dadurch wird die Lesbarkeit verbessert. Der Tipp ist nicht in eine Webapplikation, sondern zu Demonstrationszwecken in eine Windows-Anwendung eingebaut.
 
Private Function GenerateImage(ByVal text As String, _
    ByVal width As Integer, ByVal height As Integer, _
    ByVal fontFamily As String) As Bitmap
  Dim random As New Random()

  ' Ein 32-bit Bitmap
  Dim bitmap As New Bitmap(width, height, _
      PixelFormat.Format32bppArgb)
  ' Ein Graphics-Object zum Zeichnen
  Dim g As Graphics = Graphics.FromImage(bitmap)
  ' Glättung (Antialiasing)
  g.SmoothingMode = SmoothingMode.AntiAlias
  ' Ein Rechteck
  Dim rect As New Rectangle(0, 0, width, height)

  ' Den Hintergrund gestalten
  Dim hatchBrush As New HatchBrush(HatchStyle.DiagonalCross, _
      Color.LightGray, Color.Honeydew)
  g.FillRectangle(hatchBrush, rect)

  ' Schrift formatieren
  Dim size As SizeF
  Dim fontSize As Single = rect.Height + 1
  Dim font As Font

  Dim format As New StringFormat()
  format.Alignment = StringAlignment.Center
  format.LineAlignment = StringAlignment.Center

  ' Schriftgröße anpassen
  Do
    fontSize -= 2
    font = New Font(fontFamily, fontSize, FontStyle.Bold)
    size = g.MeasureString(text, font, New SizeF(width, height), _
           format)
  Loop While size.Width > rect.Width

  ' Ein GraphicsPath mit Zufallspunkten
  Dim path As New GraphicsPath()
  path.AddString(text, font.FontFamily, CInt(font.Style), _
       font.Size, rect, format)
  Dim v As Single = 4.0F
  Dim points As PointF() = {New PointF(random.[Next](rect.Width) _
      / v, random.[Next](rect.Height) / v), New PointF(rect.Width _
      - random.[Next](rect.Width) / v, random.[Next](rect.Height) _
      / v), New PointF(random.[Next](rect.Width) / v, rect.Height _
      - random.[Next](rect.Height) / v), New PointF(rect.Width - _
      random.[Next](rect.Width) / v, rect.Height - _
      random.[Next](rect.Height) / v)}
  Dim matrix As New Matrix()
  matrix.Translate(0.0F, 0.0F)
  path.Warp(points, rect, matrix, WarpMode.Perspective, 0.0F)

  ' Text zeichnen
  hatchBrush = New HatchBrush(HatchStyle.DashedUpwardDiagonal, _
               Color.DarkGray, Color.Black)
  g.FillPath(hatchBrush, path)

  ' Zufällig verzerren
  Dim m As Integer = Math.Max(rect.Width, rect.Height)
  For i As Integer = 0 To _
      CInt((rect.Width * rect.Height / 30.0F)) - 1
    Dim x As Integer = random.[Next](rect.Width)
    Dim y As Integer = random.[Next](rect.Height)
    Dim w As Integer = random.[Next](CInt(m / 50))
    Dim h As Integer = random.[Next](CInt(m / 50))
    g.FillEllipse(hatchBrush, x, y, w, h)
  Next

  ' Objekte wieder entladen
  font.Dispose()
  hatchBrush.Dispose()
  g.Dispose()

  Return bitmap
End Function

 ' Mnemonisch heißt: zwischen Konsonanten werden Vokale gesetzt.
 ' Dadurch wird der ZufallsString lesbarer.
Public Function randomMnemonic(ByVal intNumChars As Integer) 11111_
       As String
  Dim PW As String = String.Empty
  Dim Rnd As Random = New Random

  If (intNumChars Mod 2) <> 0 Then
    intNumChars += 1
  End If

  'Grossbuchstaben
  Dim Konsonaten As Char() = {"B"c, "C"c, "D"c, "F"c, "G"c, "H"c, _
      "J"c, "K"c, "L"c, "M"c, "N"c, "P"c, "Q"c, "R"c, "S"c, "T"c, _
      "V"c, "W"c, "X"c, "Y"c, "Z"c}
  Dim Vokale As Char() = {"A"c, "E"c, "I"c, "O"c, "U"c}

  Dim i As Integer
  For i = 0 To (CInt(intNumChars / 2 - 1))
    PW += Konsonaten(Rnd.Next(21))
    PW += Vokale(Rnd.Next(5))
  Next
  Return PW
End Function
 
Weitere Links zum Thema
Ampel zeichnen
Geometrische Figuren zeichnen
Kuchendiagramm erstellen

Windows-Version
98/SE
ME
NT
2000
XP
Vista
Win 7


Download  (15 kB) Downloads bisher: [ 244 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Tipps | Projekte | Tutorials | Bücherecke | VB-/VBA-Tipps | API-Referenz | Komponenten | VB.Net-Forum | VB/VBA-Forum | DirectX-Forum | Foren-Archiv | DirectX | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 18. Dezember 2011