简单的图形验证码识别代码

2008年03月14日

简单的图形验证码识别代码

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, y, Color.Yellow)
                Else
                    img.SetPixel(x, y, 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, 0, 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, 0, imgNewWidth, imgNewHeight)
                Dim B As Bitmap
                B = imgNew.Clone(Rc, 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", "").Replace("1", "")
            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