Captcha Çizmek[VB.NET]

rapcy1

0
İyinet Üyesi
Katılım
23 Şubat 2011
Mesajlar
302
Reaction score
6
Captchanın kullanıldığı yerler;

bot engellemeyi amaçlar.
Art arda mesaj ve ya konu açmak isteyen kullanıcıyı kontrol amacıyla kullanılmaktadır.

Program Captcha yenile butonuna basıldığı zaman sürekli değiştirir.
kontrol butonuna basıldığı zaman doğru girildiyse msgbox doğru girilmiştir yazar.
isteyen bundan esinlenerek form1 kısmına bunu koyabilir.
doğru girilirse form2 ye yönlendirir.

dsv3.jpg


Kod:
Imports System.Drawing.Drawing2D
Imports System.Math 'visualbasicdersleri.com
Public Class Form1
#Region "CAPTCHA CİZ"
    Public Function CaptchaCiz(ByVal Metin As String, ByVal Genislik As Integer, ByVal Yukseklik As Integer, ByVal FontAilesi As String, ByVal ArkaStil As HatchStyle, ByVal YaziStil As HatchStyle, ByVal Onrenk As Color, ByVal ArkaRenk As Color) As Bitmap
        Dim bm As New Bitmap(Genislik, Yukseklik)
        Dim gr As Graphics = Graphics.FromImage(bm)
        gr.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        Dim rectf As New RectangleF(0, 0, Genislik, Yukseklik)
        Dim br As Brush 'visualbasicdersleri.com
        br = New HatchBrush(ArkaStil, Color.LightGray, Color.White)
        gr.FillRectangle(br, rectf)
        Dim text_size As SizeF
        Dim the_font As Font
        Dim font_size As Single = Yukseklik + 1
        Do
            font_size -= 1
            the_font = New Font(FontAilesi, font_size, FontStyle.Bold, GraphicsUnit.Pixel)
            text_size = gr.MeasureString(Metin, the_font)
        Loop While (text_size.Width > Genislik) OrElse (text_size.Height > Yukseklik)
        Dim string_format As New StringFormat
        string_format.Alignment = StringAlignment.Center
        string_format.LineAlignment = StringAlignment.Center
        Dim graphics_path As New GraphicsPath
        graphics_path.AddString(Metin, the_font.FontFamily, CInt(Font.Style), the_font.Size, rectf, string_format)
        Dim rnd As New Random
        Dim pts() As PointF = { _'visualbasicdersleri.com
            New PointF(CSng(rnd.Next(Genislik) / 4), CSng(rnd.Next(Yukseklik) / 4)), _
            New PointF(Genislik - CSng(rnd.Next(Genislik) / 4), CSng(rnd.Next(Yukseklik) / 4)), _
            New PointF(CSng(rnd.Next(Genislik) / 4), Yukseklik - CSng(rnd.Next(Yukseklik) / 4)), _
            New PointF(Genislik - CSng(rnd.Next(Genislik) / 4), Yukseklik - CSng(rnd.Next(Yukseklik) / 4)) _
        }
        Dim mat As New Matrix
        graphics_path.Warp(pts, rectf, mat, WarpMode.Perspective, 0)
        br = New HatchBrush(HatchStyle.LargeConfetti, Color.Black, Color.DarkGray)
        gr.FillPath(br, graphics_path)
        Dim max_dimension As Integer = Max(Genislik, Yukseklik)
        For i As Integer = 0 To CInt(Genislik * Yukseklik / 30)
            Dim X As Integer = rnd.Next(Genislik)
            Dim Y As Integer = rnd.Next(Yukseklik)
            Dim W As Integer = CInt(rnd.Next(max_dimension) / 50)
            Dim H As Integer = CInt(rnd.Next(max_dimension) / 50)
            gr.FillEllipse(br, X, Y, W, H)
        Next i
        For i As Integer = 1 To 5
            Dim x1 As Integer = rnd.Next(Genislik)
            Dim y1 As Integer = rnd.Next(Yukseklik)
            Dim x2 As Integer = rnd.Next(Genislik)
            Dim y2 As Integer = rnd.Next(Yukseklik)
            gr.DrawLine(Pens.DarkGray, x1, y1, x2, y2)
        Next i
        For i As Integer = 1 To 5
            Dim x1 As Integer = rnd.Next(Genislik)
            Dim y1 As Integer = rnd.Next(Yukseklik)
            Dim x2 As Integer = rnd.Next(Genislik)
            Dim y2 As Integer = rnd.Next(Yukseklik)
            gr.DrawLine(Pens.LightGray, x1, y1, x2, y2)
        Next i
        graphics_path.Dispose()
        br.Dispose() 'visualbasicdersleri.com
        the_font.Dispose()
        gr.Dispose()

        Return bm
    End Function
#End Region
    Dim chars = "ABCDEFGHIJKLMNOPQRSTyvwxyzabcdefghijklmnopqrstyvwxyz123456789"
    Function RastgeleMetin(ByVal Uzunluk As Integer)
        Dim r, i
        Dim x As String 'visualbasicdersleri.com

        For i = 0 To Uzunluk
            Randomize()
            r = Int((Rnd() * 61) + 1)

            x = x & Mid(chars, r, 1)
        Next i
        Return x
    End Function
    Dim ActCaptcha As String ' Captchayı programda tutacak değişken belirleniyor.
    Private Sub Form1_Load() Handles MyBase.Load
        Ciz()
    End Sub
    Sub Ciz()
        ActCaptcha = RastgeleMetin(5)
        Dim Captcha As Bitmap = CaptchaCiz(ActCaptcha, PictureBox1.ClientSize.Width, PictureBox1.ClientSize.Height, Me.Font.FontFamily.Name, HatchStyle.SmallConfetti, HatchStyle.Cross, Color.LightGray, Color.White)
        PictureBox1.Image = Captcha 'visualbasicdersleri.com
    End Sub

    Private Sub Button1_Click() Handles Button1.Click
        Ciz()
    End Sub
    Private Sub Button2_Click() Handles Button2.Click
        If TextBox1.Text = ActCaptcha Then
            MsgBox("Doğru girdiniz.", MsgBoxStyle.Information, "Doğru")
        Else
            MsgBox("Yanlış girdiniz.", MsgBoxStyle.Critical, "Yanlış")
            Ciz()
        End If
    End Sub
End Class


kaynak kodornekleri.org​
 

Türkiye’nin ilk webmaster forum sitesi iyinet.com'da forum üyeleri tarafından yapılan tüm paylaşımlardan; Türk Ceza Kanunu’nun 20. Maddesinin, 5651 Sayılı Kanununun 4. maddesinin 2. fıkrasına göre, paylaşım yapan üyeler sorumludur.

Backlink ve Tanıtım Yazısı için iletişime geçmek için Skype Adresimiz: .cid.1580508955483fe5

Elektronik Sigara Cicisex Porno
Üst