自动识别网页验证码VB代码
2009-05-19 07:31
573 查看
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
'Private Type BITMAP:bmType As Long: bmWidth As Long:bmHeight As Long:bmWidthBytes As Long:bmPlanes As Integer:bmBitsPixel As Integer:bmBits As Long:end Type
Const COR = 148
Const rk = 7 '字宽高
Const rg = 11
Const Zg = 4 '几个字符
Public Fg As Long
Public Fb As Long 'Public a(0 To rk * 2 * Zg, 0 To 19) As shuju
![](http://static11.photo.sina.com.cn/bmiddle/60011932x6a385fb59f0a&690)
Private bB(0 To Zg - 1, 0 To rk, 0 To rg) As Boolean '字框
Private Sub Command1_Click()
i = CInt(Rnd() * 8)
Picture1.Picture = LoadPicture(App.Path & "/" & Trim(Str(i)) & ".bmp")
![](http://static4.photo.sina.com.cn/bmiddle/60011932x6a2b35641fd3&690)
Dim ok As Boolean 'Dim bm As BITMAP
Dim doc(3), dot As Long ''GetObject Picture1.Picture.Handle, Len(bm), bm
For gg = 0 To Zg - 1 'Picture2.Height = Picture1.Height: Picture2.Width = Picture1.Width
For gao = 0 To rg
For ku = 0 To rk
kuan = 6 + ku + 13 * gg 'To (gg + 1) * (6 + rk) - 1 'bm.bmWidth - 1
bB(gg, ku, gao) = FR(GetPixel(Picture1.hdc, kuan, gao + 4)) 'dot = 'bRed = Red(dot)
Next ku
Next gao
Next gg '上边对整个图片初步处理,下边分块处理
Dim jieguo As String
jieguo = ""
For i = 1 To Zg
If is2(i - 1) Then
jieguo = jieguo + Trim(Str(2))
ElseIf is0(i - 1) Then
jieguo = jieguo + Trim(Str(0))
ElseIf is1(i - 1) Then
jieguo = jieguo + Trim(Str(1))
ElseIf is4(i - 1) Then
jieguo = jieguo + Trim(Str(4))
ElseIf is3(i - 1) Then
jieguo = jieguo + Trim(Str(3))
ElseIf is5(i - 1) Then
jieguo = jieguo + Trim(Str(5))
ElseIf is6(i - 1) Then
jieguo = jieguo + Trim(Str(6))
ElseIf is7(i - 1) Then
jieguo = jieguo + Trim(Str(7))
ElseIf is9(i - 1) Then
jieguo = jieguo + Trim(Str(9))
ElseIf is8(i - 1) Then
jieguo = jieguo + Trim(Str(8))
Else: jieguo = jieguo + Trim(Str(i))
End If 'Picture2.PSet (kuan + 10 * i - 10, gao), (1 - b(kuan, gao).dot) * 16777215:'SavePicture Picture2.Image, "c:/me2.bmp" ''输出结果第二图 '''''Label2.Caption = jieguo
Next
La.Caption = jieguo
End Sub
Public Function FR(ByVal mlColor As Long) As Boolean 'fed = mlColor And &HFF:Fg = (mlColor / &H100) And &HFF:Fb = (mlColor / &H10000) And &HFF '108
FR = 1
If (mlColor And &HFF) > COR Or ((mlColor / &H100) And &HFF) > COR Or ((mlColor / &H10000) And &HFF) > COR Then FR = 0
End Function
Function is0(i) As Boolean
is0 = True
For gao = 2 To 9: For kuan = 3 To 5 '长3*7竖框
If bB(i, kuan, gao) Then: is0 = False: Exit Function '怎么不跳转呀
Next: Next
End Function
Public Function is1(i) As Boolean
k1 = 1
For gao = 0 To rk: For kuan = 3 To 4 '长2*11竖条
If bB(i, kuan, gao) = False Then: k1 = 0: GoTo ere
Next: Next
ere: is1 = k1
End Function
Public Function is2(i) As Boolean
k1 = 1: k2 = 1 ''''''
For gao = 3 To 5: For kuan = 0 To 4 '3*5空
If bB(i, kuan, gao) Then k1 = 0: GoTo ere
Next: Next
For gao = 10 To 11: For kuan = 1 To 6 '尾实
If bB(i, kuan, gao) = False Then k2 = 0: GoTo ere
Next: Next
ere: is2 = k1 And k2
End Function
Public Function is3(i) As Boolean
k1 = 1: k2 = 1 '''''''''''**
For gao = 2 To 3: For kuan = 1 To 3 '上部4*2的空
If bB(i, kuan, gao) Then k1 = 0: GoTo ere
Next: Next
For gao = 0 To 10 ': 1长竖
If bB(i, 5, gao) = False Then k2 = 0: GoTo ere
Next
ere: is3 = k1 And k2
End Function
Public Function is4(i) As Boolean
k1 = 1: k2 = 1 '''''''''''****
For gao = 0 To 11: For kuan = 5 To 6 '长竖2*11的实
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere '
Next: Next
For kuan = 0 To 7 ': 1长横
If bB(i, kuan, 8) = False Then k2 = 0: GoTo ere '
Next
ere: is4 = k1 And k2
End Function
Public Function is5(i) As Boolean
k1 = 1: k2 = 1 '''''''''''****
For gao = 0 To 1: For kuan = 3 To 6 '长竖4*2的实
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere ' k2 = k2 And k1:
Next: Next
For kuan = 1 To 5 ': 1长竖
If bB(i, kuan, 4) = False Then k2 = 0: GoTo ere
Next
ere: is5 = k1 And k2
End Function
Public Function is6(i) As Boolean
k1 = 1: k2 = 1 '''''''''''*****************
For gao = 6 To 9: For kuan = 2 To 5 '长竖4*3的空
If bB(i, kuan, gao) Then k1 = 0: GoTo ere ' k2 = k2 And k1:
Next: Next
For kuan = 2 To 4 ': 1长竖
If bB(i, kuan, 11) = False Then k2 = 0: GoTo ere
Next
ere: is6 = k1 And k2
End Function
Public Function is7(i) As Boolean
k1 = 1: k2 = 1 '''''''''''*****************
For gao = 0 To 1: For kuan = 2 To 7 '长竖2*8的实
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere '
Next: Next
For gao = 3 To 11: For kuan = 0 To 2 '长竖2*8的实
If bB(i, kuan, 8) Then k2 = 0: GoTo ere '
Next: Next
ere: is7 = k1 And k2
End Function
Public Function is8(i) As Boolean '用横条来识别8,8中至少有长度为3的横条3个,'5也有可能有,但是5在前面,已经识别。9也可能有,所以要把先识别9
k1 = 1: k2 = 1
For gao = 0 To 6 Step 6: For kuan = 2 To 5
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere '
Next: Next
For kuan = 2 To 5 '长横实3
If bB(i, kuan, 11) = False Then k2 = 0: GoTo ere '
Next
ere: is8 = k1 And k2
End Function
Public Function is9(i) As Boolean
k1 = 1: k2 = 1
For gao = 2 To 5: For kuan = 2 To 4
If bB(i, kuan, gao) Then k1 = 0: GoTo ere '
Next: Next
For kuan = 4 To 5 '长横实3
If bB(i, kuan, 7) = False Then k2 = 0: GoTo ere '
Next
ere: is9 = k1 And k2
End Function
Private Sub Form_Load()
'Picture1.Picture = LoadPicture("c:/3.bmp")
End Sub
'Private Type BITMAP:bmType As Long: bmWidth As Long:bmHeight As Long:bmWidthBytes As Long:bmPlanes As Integer:bmBitsPixel As Integer:bmBits As Long:end Type
Const COR = 148
Const rk = 7 '字宽高
Const rg = 11
Const Zg = 4 '几个字符
Public Fg As Long
Public Fb As Long 'Public a(0 To rk * 2 * Zg, 0 To 19) As shuju
Private bB(0 To Zg - 1, 0 To rk, 0 To rg) As Boolean '字框
Private Sub Command1_Click()
i = CInt(Rnd() * 8)
Picture1.Picture = LoadPicture(App.Path & "/" & Trim(Str(i)) & ".bmp")
Dim ok As Boolean 'Dim bm As BITMAP
Dim doc(3), dot As Long ''GetObject Picture1.Picture.Handle, Len(bm), bm
For gg = 0 To Zg - 1 'Picture2.Height = Picture1.Height: Picture2.Width = Picture1.Width
For gao = 0 To rg
For ku = 0 To rk
kuan = 6 + ku + 13 * gg 'To (gg + 1) * (6 + rk) - 1 'bm.bmWidth - 1
bB(gg, ku, gao) = FR(GetPixel(Picture1.hdc, kuan, gao + 4)) 'dot = 'bRed = Red(dot)
Next ku
Next gao
Next gg '上边对整个图片初步处理,下边分块处理
Dim jieguo As String
jieguo = ""
For i = 1 To Zg
If is2(i - 1) Then
jieguo = jieguo + Trim(Str(2))
ElseIf is0(i - 1) Then
jieguo = jieguo + Trim(Str(0))
ElseIf is1(i - 1) Then
jieguo = jieguo + Trim(Str(1))
ElseIf is4(i - 1) Then
jieguo = jieguo + Trim(Str(4))
ElseIf is3(i - 1) Then
jieguo = jieguo + Trim(Str(3))
ElseIf is5(i - 1) Then
jieguo = jieguo + Trim(Str(5))
ElseIf is6(i - 1) Then
jieguo = jieguo + Trim(Str(6))
ElseIf is7(i - 1) Then
jieguo = jieguo + Trim(Str(7))
ElseIf is9(i - 1) Then
jieguo = jieguo + Trim(Str(9))
ElseIf is8(i - 1) Then
jieguo = jieguo + Trim(Str(8))
Else: jieguo = jieguo + Trim(Str(i))
End If 'Picture2.PSet (kuan + 10 * i - 10, gao), (1 - b(kuan, gao).dot) * 16777215:'SavePicture Picture2.Image, "c:/me2.bmp" ''输出结果第二图 '''''Label2.Caption = jieguo
Next
La.Caption = jieguo
End Sub
Public Function FR(ByVal mlColor As Long) As Boolean 'fed = mlColor And &HFF:Fg = (mlColor / &H100) And &HFF:Fb = (mlColor / &H10000) And &HFF '108
FR = 1
If (mlColor And &HFF) > COR Or ((mlColor / &H100) And &HFF) > COR Or ((mlColor / &H10000) And &HFF) > COR Then FR = 0
End Function
Function is0(i) As Boolean
is0 = True
For gao = 2 To 9: For kuan = 3 To 5 '长3*7竖框
If bB(i, kuan, gao) Then: is0 = False: Exit Function '怎么不跳转呀
Next: Next
End Function
Public Function is1(i) As Boolean
k1 = 1
For gao = 0 To rk: For kuan = 3 To 4 '长2*11竖条
If bB(i, kuan, gao) = False Then: k1 = 0: GoTo ere
Next: Next
ere: is1 = k1
End Function
Public Function is2(i) As Boolean
k1 = 1: k2 = 1 ''''''
For gao = 3 To 5: For kuan = 0 To 4 '3*5空
If bB(i, kuan, gao) Then k1 = 0: GoTo ere
Next: Next
For gao = 10 To 11: For kuan = 1 To 6 '尾实
If bB(i, kuan, gao) = False Then k2 = 0: GoTo ere
Next: Next
ere: is2 = k1 And k2
End Function
Public Function is3(i) As Boolean
k1 = 1: k2 = 1 '''''''''''**
For gao = 2 To 3: For kuan = 1 To 3 '上部4*2的空
If bB(i, kuan, gao) Then k1 = 0: GoTo ere
Next: Next
For gao = 0 To 10 ': 1长竖
If bB(i, 5, gao) = False Then k2 = 0: GoTo ere
Next
ere: is3 = k1 And k2
End Function
Public Function is4(i) As Boolean
k1 = 1: k2 = 1 '''''''''''****
For gao = 0 To 11: For kuan = 5 To 6 '长竖2*11的实
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere '
Next: Next
For kuan = 0 To 7 ': 1长横
If bB(i, kuan, 8) = False Then k2 = 0: GoTo ere '
Next
ere: is4 = k1 And k2
End Function
Public Function is5(i) As Boolean
k1 = 1: k2 = 1 '''''''''''****
For gao = 0 To 1: For kuan = 3 To 6 '长竖4*2的实
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere ' k2 = k2 And k1:
Next: Next
For kuan = 1 To 5 ': 1长竖
If bB(i, kuan, 4) = False Then k2 = 0: GoTo ere
Next
ere: is5 = k1 And k2
End Function
Public Function is6(i) As Boolean
k1 = 1: k2 = 1 '''''''''''*****************
For gao = 6 To 9: For kuan = 2 To 5 '长竖4*3的空
If bB(i, kuan, gao) Then k1 = 0: GoTo ere ' k2 = k2 And k1:
Next: Next
For kuan = 2 To 4 ': 1长竖
If bB(i, kuan, 11) = False Then k2 = 0: GoTo ere
Next
ere: is6 = k1 And k2
End Function
Public Function is7(i) As Boolean
k1 = 1: k2 = 1 '''''''''''*****************
For gao = 0 To 1: For kuan = 2 To 7 '长竖2*8的实
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere '
Next: Next
For gao = 3 To 11: For kuan = 0 To 2 '长竖2*8的实
If bB(i, kuan, 8) Then k2 = 0: GoTo ere '
Next: Next
ere: is7 = k1 And k2
End Function
Public Function is8(i) As Boolean '用横条来识别8,8中至少有长度为3的横条3个,'5也有可能有,但是5在前面,已经识别。9也可能有,所以要把先识别9
k1 = 1: k2 = 1
For gao = 0 To 6 Step 6: For kuan = 2 To 5
If bB(i, kuan, gao) = False Then k1 = 0: GoTo ere '
Next: Next
For kuan = 2 To 5 '长横实3
If bB(i, kuan, 11) = False Then k2 = 0: GoTo ere '
Next
ere: is8 = k1 And k2
End Function
Public Function is9(i) As Boolean
k1 = 1: k2 = 1
For gao = 2 To 5: For kuan = 2 To 4
If bB(i, kuan, gao) Then k1 = 0: GoTo ere '
Next: Next
For kuan = 4 To 5 '长横实3
If bB(i, kuan, 7) = False Then k2 = 0: GoTo ere '
Next
ere: is9 = k1 And k2
End Function
Private Sub Form_Load()
'Picture1.Picture = LoadPicture("c:/3.bmp")
End Sub
相关文章推荐
- VB的验证码识别与自动充值部分
- 后台自动登录网页vb脚本实例代码
- Python3.5+sklearn 使用SVM自动识别字母验证码
- VB函数解析自动识别工具 VB代码库函数库添加管理工具
- 去噪:用于验证码图片识别的类续(C#代码)
- vb.net 2005实现自动登陆网页
- 12306登陆窗体验证码自动识别
- python人工智能写验证码自动识别demo地址
- 自动识别验证码软件的使用方法(新手教程)
- 自动识别验证码的时代何时到来
- 网页自动满屏实现代码
- Delphi QQ网页登陆验证码获取显示(非识别)
- 让手机网页浏览器自动适应页面的代码
- 用Python实现china-pub登录验证码的识别--代码版
- 代码笔记 | 自动爬取百度贴吧的网页
- 正方教务系统验证码自动识别(非打码平台)
- Asp.net 2.0 自定义控件开发专题讲解[为用户控件增加DataSource属性, 能够自动识别不同数据源](示例代码下载)
- Asp.net 2.0 自定义控件开发专题讲解[为用户控件增加DataSource属性, 能够自动识别不同数据源](示例代码下载)
- vb.net2005 网页自动填写并提交
- Asp.net 2.0 自定义控件开发专题讲解[为用户控件增加DataSource属性, 能够自动识别不同数据源](示例代码下载)