还是黑防上的文章。基本思想就是首先二值化去背景（通过判断点的RGB颜色值来实现区分），然后利用字符分割，利用点和字模的匹配率来进行识别。
具体实现代码如下：
Option Explicit
Private Sub Form_Load()
'窗体载入时将所有PictureBox统一到验证码的大小
'Picture1中默认已装载一张验证码
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture3.AutoRedraw = True
Picture2.Height = Picture1.Height
Picture2.Width = Picture1.Width
Picture3.Height = Picture1.Height
Picture3.Width = Picture1.Width
End SubPrivate Sub CmdDown_Click()
'下载按钮暂时变为不可用
CmdDown.Enabled = False
'声明用于保存图片二进制数据的数组
Dim picBytes() As Byte
picBytes = Inet1.OpenURL("http://sms.263.net/web/image.jsp", icByteArray)
While Inet1.StillExecuting
DoEvents
Wend
'将图片数据写入Test.bmp文件
Open App.Path & "\test.bmp" For Binary As #1
Put #1, , picBytes
Close #1
'将Test.bmp载入到Picture1中
Picture1.Picture = LoadPicture(App.Path & "\Test.bmp")
'按钮恢复可用
CmdDown.Enabled = True
End SubPrivate Sub CmdNoise_Click()
Picture2.Cls
Dim X As Integer
Dim Y As Integer
Dim Ret
'这里扫描了整张图片，并将其转为黑白
For Y = 0 To Picture1.ScaleHeight - 1
For X = 0 To Picture1.ScaleWidth - 1
'将16进制颜色转为RGB色，保存在数组Ret中
Ret = ColorRGB(Picture1.Point(X, Y))
'RGB值中任意一个小于120，都将这个点设置为黑色
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then Picture2.PSet (X, Y), vbBlack
Next X
Next Y
End Sub
Private Sub CmdOneChar_Click()
Picture3.Cls
Dim X As Integer
Dim Y As Integer
Dim Ret
'此处只将第一个字符转为黑白
For Y = 3 To 15
For X = 7 To 15
Ret = ColorRGB(Picture1.Point(X, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then Picture3.PSet (X, Y), vbBlack
Next X
Next YEnd Sub
Private Sub CmdWriteData_Click()
Picture3.Cls
Dim X As Integer
Dim Y As Integer
Dim Ret
'将第一个字符转为黑白
For Y = 3 To 15
For X = 7 To 15
Ret = ColorRGB(Picture1.Point(X, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then Picture3.PSet (X, Y), vbBlack
Next X
Next Y'将字符数据写入文件中
Open App.Path & "\Data\" & TxtChar & ".ini" For Output As #1
Print #1, "[CharData]"
For Y = 3 To 15
For X = 7 To 15
'如果不是白色，就写入值为1
'此处坐标我们定义从（0,0)开始
If Picture3.Point(X, Y) <> vbWhite Then
Print #1, X - 7 & "-" & Y - 3 & "=1"
End If
Next X
Next Y
Close #1End Sub
Private Sub CmdResult_Click()
LblResult.Caption = "识别结果：" & GetOneChar(7, 15) & GetOneChar(20, 28) & GetOneChar(33, 41) & GetOneChar(45, 53)
End Sub'读取ini文件模块
'读取INI值
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal _
lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString _
As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
'自定义函数，读取Ini信息
Public Function GetValueFromIni(ByVal FileName As String, ByVal AppName As String, ByVal KeyName As String) As String
Dim Buff As String
Buff = Space(100) '分配100字节的缓存大小
GetPrivateProfileString AppName, KeyName, vbNullString, Buff, 100, FileName
GetValueFromIni = Left(Buff, InStr(Buff, Chr(0)) - 1)
End FunctionOption Explicit
Public Function GetOneChar(ByVal Left, ByVal Right) As Integer
Dim X As Integer
Dim Y As Integer
Dim Ret
Dim RightCount As Integer
Dim RateMax As Integer
Dim FileNo As Integer'FileNo从0循环到9
For FileNo = 0 To 9
For Y = 3 To 15
For X = Left To Right
Ret = ColorRGB(MainForm.Picture1.Point(X, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
'如果是一个有用像素点,并且文件中的数据为1，那么RightCount增加1
If GetValueFromIni(App.Path & "\Data\" & FileNo & ".ini", "CharData", X - Left & "-" & Y - 3) = "1" Then
RightCount = RightCount + 1
End If
'如果不是有用像素点，而且从文件中读取不到数据，那么RightCount也增加1
ElseIf GetValueFromIni(App.Path & "\Data\" & FileNo & ".ini", "CharData", X - Left & "-" & Y - 3) = "" Then
RightCount = RightCount + 1
End If
Next X
Next Y
'117个点中有超过114个匹配，则匹配结束
If RightCount > 114 Then
GetOneChar = FileNo
Exit Function
End If
'如果最终没有一个文件匹配超过114点
'那么就选择匹配数量最多的那个字
If RightCount > RateMax Then GetOneChar = FileNo: RateMax = RightCount
RightCount = 0
Next FileNoDim KeyPointCount As Integer
'若匹配的最终结果是0
'还需要单独判断是不是8
If GetOneChar = 0 Then
'扫描第九行
For X = Left + 2 To Left + 5
Ret = ColorRGB(MainForm.Picture1.Point(X, 8))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next X
'扫描第十行
For X = Left + 2 To Left + 5
Ret = ColorRGB(MainForm.Picture1.Point(X, 9))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next X
If KeyPointCount > 6 Then GetOneChar = 8: Exit Function
End If'若匹配的最终结果是8
'单独判断是不是0
If GetOneChar = 8 Then
KeyPointCount = 0
'扫描第九行
For X = Left + 2 To Left + 5
Ret = ColorRGB(MainForm.Picture1.Point(X, 8))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next X
'扫描第十行
For X = Left + 2 To Left + 5
Ret = ColorRGB(MainForm.Picture1.Point(X, 9))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next X
If KeyPointCount < 3 Then GetOneChar = 0: Exit Function
End If'若匹配的最终结果是8
'单独判断是不是3
If GetOneChar = 8 Then
KeyPointCount = 0
'扫描第Left列
For Y = 3 To 15
Ret = ColorRGB(MainForm.Picture1.Point(Left, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next Y
'扫描第Left+1列
For Y = 3 To 15
Ret = ColorRGB(MainForm.Picture1.Point(Left + 1, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next Y
If KeyPointCount < 6 Then GetOneChar = 3: Exit Function
End If'若匹配的最终结果是3
'单独判断是不是8
If GetOneChar = 3 Then
KeyPointCount = 0
'扫描第Left列
For Y = 3 To 15
Ret = ColorRGB(MainForm.Picture1.Point(Left, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next Y
'扫描第Left+1列
For Y = 3 To 15
Ret = ColorRGB(MainForm.Picture1.Point(Left + 1, Y))
If Ret(0) < 120 Or Ret(1) < 120 Or Ret(2) < 120 Then
KeyPointCount = KeyPointCount + 1
End If
Next Y
If KeyPointCount > 10 Then GetOneChar = 8: Exit Function
End IfEnd Function
'获取RGB值
Public Function ColorRGB(Color As Long) As Byte()
Const ByN As Integer = 256
Const ByN2 As Long = 65536
Dim A(2) As Byte
A(0) = (Color Mod ByN)
A(1) = ((Color Mod ByN2) \ ByN)
A(2) = (Color \ ByN2)
ColorRGB = A
End Function
已经有(0)位网友发表了评论，你也评一评吧！
原创文章如转载，请注明：转载自Eddy Blog
原文地址：http://www.rrgod.com/program/746.html 欢迎订阅Eddy Blog。