VB.Net图形验证码识别的源代码

除了本文关于图片验证码的源代码，乐博网还有一篇关于图片验证码识别思路的文章

vb.net写的图片验证码识别代码，代码质量不是太高，而且去噪部分算法很不好，但识别现在网站上的图形验证码已经够用了
本文由AkYao从apps.hi.baidu.com/share/detail/2188410转载. 代码如下：

本文详细可以查看 http://www.smallbasic.cn/thread-74-1-1.html

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

复制代码


	\| 网站首页 \| VB.Net实例分析 \| .Net技术文摘 \| 下载中心 \| VB.Net书籍笔记 \| .Net源码 \| VBS脚本与组件调用 \| Windows2008技术文摘 \| 给我们留言 \|