用vb.net写的验证码识别代码

前端之家收集整理的这篇文章主要介绍了用vb.net写的验证码识别代码前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

一个很简单用vb.net写的验证码识别代码代码质量不是太高,而且去噪部分算法很不好,但识别现在网站上的图形验证码已经够用了。比起前段时间给一群人渣做的自动投票系统中用的一个带有相当强大的图形处理类的ocr来识别和去噪相比就差太远了,放代码只是提醒下要注意登陆入口的管理和管理员的密码安全性,只要我能有一定的几率正确识别图形验证码,就能通过向http包头中添加新的头信息,就能对管理员帐号进行暴力破解:

    Imports System   
    Imports System.Text   
    Imports System.Data   
    Imports System.Data.OleDb   
    Imports System.Drawing   
    Imports System.Drawing.Graphics   
      
    Public Class CrackImage   
      
    Private ConnStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=Learn.mdb"  
    Private resultNumber As String  
    Private rsultStudy As Boolean = False  
      
    '识别   
    Public Sub New(ByVal SrcImage As Bitmap)   
    GetImageNumber = GetIamgeResultNumber(GetNewIamge(SrcImage))   
    End Sub  
      
    '学习   
    Public Sub New(ByVal SrcImagePath As String,ByVal StudyNumber As String)   
    rsultStudy = StudyCode(SrcImagePath,StudyNumber)   
    End Sub  
      
      
    Public Property GetImageNumber() As String  
    Get  
    Return resultNumber   
    End Get  
    Set(ByVal Value As String)   
    resultNumber = Value   
    End Set  
    End Property  
      
      
    Public Property GetStudyImageResult() As Boolean  
    Get  
    Return rsultStudy   
    End Get  
    Set(ByVal Value As Boolean)   
    rsultStudy = Value   
    End Set  
    End Property  
      
    '处理新图片   
    Private Function GetNewIamge(ByVal srcBitBmpImage As Bitmap) As Bitmap   
    '建立临时表   
    Dim myDataTable As New DataTable   
    Dim myCol2 As New DataColumn   
    myCol2.DataType = System.Type.GetType("System.Int32")   
    myCol2.ColumnName = "RgbValue"  
    myDataTable.Columns.Add(myCol2)   
      
    Dim myCol3 As New DataColumn   
    myCol3.DataType = System.Type.GetType("System.Int32")   
    myCol3.ColumnName = "RgbCount"  
    myDataTable.Columns.Add(myCol3)   
      
    '载入图片   
    Dim img As Bitmap = srcBitBmpImage   
    Dim x,y As Integer  
      
    '去除杂点   
    '遍历所有点,存储每点的颜色代码,并对各种颜色进行统计 (这些代码可以不要,直接将图转化成黑白只剩下噪点和感染线条)   
    For x = 0 To img.Width - 1   
    For y = 0 To img.Height - 1   
    Dim Found As Boolean = False  
    If myDataTable.Rows.Count > 0 Then  
    For k As Integer = 0 To myDataTable.Rows.Count - 1   
    If myDataTable.Rows(k).Item("RgbValue") = img.GetPixel(x,y).ToArgb Then  
    myDataTable.Rows(k).Item("RgbCount") += 1   
    Found = True  
    Exit For  
    End If  
    Next  
    End If  
      
    If Found = False Then  
    Dim myRow As DataRow   
    myRow = myDataTable.NewRow()   
    myRow.Item("RgbValue") = img.GetPixel(x,y).ToArgb   
    myRow.Item("RgbCount") = 1   
    myDataTable.Rows.Add(myRow)   
    End If  
    Next  
    Next  
      
    '获取背景色码   
    '象素点出现最多的就视为背景色   
    Dim intMaxRgbValue As Integer = 0   
    If myDataTable.Rows.Count > 0 Then  
    myDataTable.DefaultView.Sort = "RgbCount DESC"  
    intMaxRgbValue = myDataTable.DefaultView.Item(0).Item("RgbValue")   
    End If  
      
    '勾画数字轮廓   
    For x = 0 To img.Width - 1   
    For y = 0 To img.Height - 1   
    Dim x1,y1 As Integer 'x1和y1记录的是相对当前象素的上一个象素的坐标   
    If x = 0 Then  
    x1 = x   
    Else  
    x1 = x - 1   
    End If  
      
    If y = 0 Then  
    y1 = y   
    Else  
    y1 = y - 1   
    End If  
      
    Dim x2,y2 As Integer 'x2和y2记录的是相对当前象素下一个象素的坐标   
    If x = img.Width - 1 Then  
    x2 = img.Width - 1   
    Else  
    x2 = x + 1   
    End If  
      
    If y = img.Height - 1 Then  
    y2 = img.Height - 1   
    Else  
    y2 = y + 1   
    End If  
      
    '都是普通的去噪手法,去噪成黑白色,这里是去噪成黑黄 色   
    If img.GetPixel(x2,y).ToArgb = intMaxRgbValue Or img.GetPixel(x1,y).ToArgb = intMaxRgbValue Then  
    img.SetPixel(x,y,Color.Black)   
    ElseIf img.GetPixel(x,y).ToArgb <> intMaxRgbValue Then  
    img.SetPixel(x,Color.Yellow)   
    Else  
    img.SetPixel(x,Color.Black)   
    End If  
    Next  
    Next  
      
    Return img   
    End Function  
      
    '获取处理后的数字   
    Private Function GetIamgeResultNumber(ByVal srcNewImg As Bitmap) As String  
    Dim RawData As New StringBuilder   
    '设置分割大小   
    Dim imgNewWidth As Integer = 16   
    Dim imgNewHeight As Integer = 13   
      
    Dim imgNew As New Bitmap(srcNewImg)   
    Dim x,y As Integer  
    Dim result As String = ""  
      
    Dim ImageSplitWidth As Integer = imgNew.Width - imgNewWidth   
      
    For m As Integer = 0 To ImageSplitWidth Step imgNewWidth   
    Dim Rc As New Rectangle(m,imgNewWidth,imgNewHeight)   
    Dim B As Bitmap   
    B = imgNew.Clone(Rc,imgNew.PixelFormat)   
    '对比分割的颜色,黑色取1,其他取0,就此生成特征码   
    For x = 0 To imgNewWidth - 1   
    For y = 0 To imgNewHeight - 1   
    If B.GetPixel(x,y).ToArgb <> Color.Black.ToArgb Then  
    RawData.Append("1")   
    Else  
    RawData.Append("0")   
    End If  
    Next  
    Next  
      
    result += GetIamgeRawToNumber(RawData.ToString)   
    RawData.Replace("0","").Replace("1","")   
    Next  
      
    Return result   
    End Function  
      
    '学习新图片   
    Private Function StudyCode(ByVal srcImage As String,ByVal objNumber As String) As Boolean  
    If objNumber = "" Or objNumber.Length < 4 Then Exit Function  
    Dim RawData As New StringBuilder   
    Dim imgNewWidth As Integer = 16   
    Dim imgNewHeight As Integer = 13   
    Dim p As Integer = 0   
    Dim x,y As Integer  
      
    Dim srcBitbmp As New Bitmap(srcImage)   
    Dim imgNew As Bitmap = GetNewIamge(srcBitbmp)   
      
    '分割图片并保存学习代码   
    Dim ImageSplitWidth As Integer = imgNew.Width - imgNewWidth   
    For m As Integer = 0 To ImageSplitWidth Step imgNewWidth   
    Dim CurNumber As String  
    CurNumber = objNumber.Substring(p,1)   
    If CurNumber <> "." Then  
    Dim Rc As New Rectangle(m,imgNew.PixelFormat)   
      
    For x = 0 To imgNewWidth - 1   
    For y = 0 To imgNewHeight - 1   
    If B.GetPixel(x,y).ToArgb <> Color.Black.ToArgb Then  
    RawData.Append("1")   
    Else  
    RawData.Append("0")   
    End If  
    Next  
    Next  
    SaveImageRaw(objNumber.Substring(p,1),RawData.ToString)   
    RawData.Replace("0","")   
    End If  
    p += 1   
    Next  
      
    Return True  
    End Function  
      
    '获取图片Raw数据   
    Private Function GetIamgeRawToNumber(ByVal strRaw As String) As String  
    Dim conn As New OleDbConnection(ConnStr)   
    Dim comm As New OleDbCommand   
    Dim reader As OleDbDataReader   
      
    Dim myDataTable As New DataTable   
    Dim myCol1 As New DataColumn   
    myCol1.DataType = System.Type.GetType("System.Int32")   
    myCol1.ColumnName = "MatchNumber"  
    myDataTable.Columns.Add(myCol1)   
      
    Dim myCol2 As New DataColumn   
    myCol2.DataType = System.Type.GetType("System.Int32")   
    myCol2.ColumnName = "MatchCount"  
    myDataTable.Columns.Add(myCol2)   
      
    comm.CommandText = "select LearnCharacter,Eigenvalue from tbLearn"  
    conn.Open()   
    comm.Connection = conn   
    reader = comm.ExecuteReader   
      
    If reader.HasRows Then  
    While reader.Read   
    Dim myRow As DataRow   
    myRow = myDataTable.NewRow()   
    myRow.Item("MatchNumber") = reader.Item(0)   
    myRow.Item("MatchCount") = CompareRaw(reader.Item(1),strRaw)   
    myDataTable.Rows.Add(myRow)   
    End While  
    End If  
    conn.Close()   
      
    Dim reuslt As String = ""  
    If myDataTable.Rows.Count > 0 Then  
    myDataTable.DefaultView.Sort = "MatchCount DESC"  
    reuslt = myDataTable.DefaultView.Item(0).Item("MatchNumber")   
    End If  
      
    Return reuslt   
      
    End Function  
      
    '比较图片Raw数据   
    Private Function CompareRaw(ByVal strDataBaseRaw As String,ByVal strObjRaw As String) As Integer  
    Dim intRawLen As Integer = strDataBaseRaw.Length   
    Dim MatchCount As Integer = 0   
    For i As Integer = 0 To intRawLen - 1   
    If strDataBaseRaw.Substring(i,1) = strObjRaw.Substring(i,1) Then  
    MatchCount += 1   
    End If  
    Next  
    Return MatchCount   
    End Function  
      
    '保存图片Raw数据   
    Private Sub SaveImageRaw(ByVal strNumber As String,ByVal strRaw As String)   
    Dim conn As New OleDbConnection(ConnStr)   
    Dim comm As New OleDbCommand   
    comm.CommandText = "insert into tbLearn(LearnCharacter,Eigenvalue) values ('" + strNumber + "','" + strRaw + "')"  
    conn.Open()   
    comm.Connection = conn   
    comm.ExecuteNonQuery()   
    conn.Close()   
    End Sub  
      
    End Class   
原文链接:https://www.f2er.com/vb/259472.html

猜你在找的VB相关文章