ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
楼主: 蓝天630902

[原创] 验证码识别,直接判断

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2012-5-20 21:40 | 显示全部楼层
本帖已被收录到知识树中,索引项:图像处理和GDI
蓝天630902 发表于 2012-5-20 20:13
是想详细地说一说,总是怕说不清爽,所有一直没有说。

在论坛里搜了一下,好像是通过分割图片,然后对每个数字进行识别?
识别的方式需要自己去整理?》

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-6-25 19:13 | 显示全部楼层
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'剪贴版数据格式定义
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const CF_HDROP = 15
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
' 内存操作定义
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Sub 验证码识别()
    Dim a(1 To 4)
    Dim img
    Dim CtrlRange
    Dim bytClipData()  As Byte
    Dim arr(0 To 1200)
    Dim ts As Integer
    On Error Resume Next
    With CreateObject("InternetExplorer.application") '创建一个空的ie
        .Visible = True                               '让ie可见
        .Navigate "http://119.145.135.38/fscx/jzsac/certPic.do" '导航到http://119.145.135.38/fscx/jzsac/certPic.do
        Do Until .ReadyState = 4               '等待ie完毕加载
            DoEvents
        Loop
        Set img = .Document.All.tags("img")(0) '指定(验证码)目标图片
        Set CtrlRange = .Document.body.createControlRange()  '创建非文本对象 ControlRange 集合
        CtrlRange.Add img                      '向非文本对象 ControlRange 集合中添加 img 对象
        CtrlRange.execCommand "Copy", True     '从 ControlRange 集合中copy img 对象(图片)到剪贴板
        Dim hMem As Long, lpData As Long
        OpenClipboard 0&                       '打开粘贴板
        hMem = GetClipboardData(8)             '获得粘贴板数据,指定格式为:CF_DIB = 8
        If CBool(hMem) Then
            lpData = GlobalLock(hMem)          '锁定内存对象hMen
            lClipSize = GlobalSize(hMem)       '获得粘贴板数据字节数
            If lpData <> 0 And lClipSize > 0 Then
                ReDim bytClipData(0 To lClipSize - 1) As Byte      '重新定义字节数组大小
                CopyMemory bytClipData(0), ByVal lpData, lClipSize '粘贴板转化成字节数组
            End If
            GlobalUnlock hMem                  '解除锁定内存对象hMen
        End If
        CloseClipboard                         '关闭粘贴板
        For i = 1 To 1260
            ts = (Val(bytClipData((i - 1) * 3 + 40)) + Val(bytClipData((i - 1) * 3 + 41)) + Val(bytClipData((i - 1) * 3 + 42))) / 3
            If ts > 150 Then
                ts = 0
            Else
                ts = 1
            End If
            arr(i) = ts
        Next i
        For i = 1 To 4
            a(i) = 0
            If arr(13 * 60 + 8 + (i - 1) * 14) = 1 And arr(14 * 60 + 8 + (i - 1) * 14) = 1 Then a(i) = 1: GoTo 1 '16位色,所以乘以“3”,60是宽,14是字间距,40是图片开始字节
            If arr(4 * 60 + 6 + (i - 1) * 14) = 1 Then a(i) = 2: GoTo 1
            If arr(16 * 60 + 11 + (i - 1) * 14) = 0 Then a(i) = 3: GoTo 1
            If arr(7 * 60 + 5 + (i - 1) * 14) = 1 Then a(i) = 4: GoTo 1
            If arr(12 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 5: GoTo 1
            If arr(9 * 60 + 8 + (i - 1) * 14) = 1 And arr(11 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 6: GoTo 1
            If arr(16 * 60 + 13 + (i - 1) * 14) = 1 Then a(i) = 7: GoTo 1
            If arr(10 * 60 + 8 + (i - 1) * 14) = 1 And arr(11 * 60 + 8 + (i - 1) * 14) = 1 Then a(i) = 8: GoTo 1
            If arr(9 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 9
1:
        Next i
        Cells(1, 1) = a(1) & a(2) & a(3) & a(4)
       '.Quit                     '关闭ie
        'MsgBox "OK"
    End With
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-6-25 19:20 | 显示全部楼层
本帖最后由 蓝天630902 于 2012-6-25 19:36 编辑

验证码图片.rar

验证码图片.rar

377.95 KB, 下载次数: 203

TA的精华主题

TA的得分主题

发表于 2012-6-25 20:05 | 显示全部楼层
蓝天630902 发表于 2012-6-25 19:20
验证码图片.rar

可以考虑做一个通用的验证码识别,带自适应学习功能的。目前的代码特异性还是强了点,不能通用。

TA的精华主题

TA的得分主题

发表于 2012-6-25 22:46 | 显示全部楼层
蓝天630902 发表于 2012-6-25 19:13
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declar ...

谢谢蓝天老师,不过还是想讨教一下“'16位色,所以乘以“3”,60是宽,14是字间距,40是图片开始字节
”这一部分的原理,不知可否告知一二!!

TA的精华主题

TA的得分主题

发表于 2012-6-25 22:48 | 显示全部楼层
蓝天630902 发表于 2012-6-25 19:20
验证码图片.rar

在用直接获取验证码时,不知可否屏蔽了IE的允许窗口(不是手动改IE的安全设置)。

TA的精华主题

TA的得分主题

发表于 2012-6-25 23:44 | 显示全部楼层
想在代码运行前先用代码修改注册表,将IE的的该项设置修改好,然后再运行验证码的代码,运行完毕后再将注册表的IE设置复原,不过不知代码怎么写,等高手.............

TA的精华主题

TA的得分主题

发表于 2012-6-26 01:29 | 显示全部楼层
弹出的IE允许访问窗口问题做了一个方案,在我的文件测试过,不知可否通用,还请老师斧正!
在蓝天老师代码的基础上,前后分别加入下面代码,就可实现过程不用人工干预了。
  1.     Set Regedit_XG = CreateObject("WScript.Shell")
  2.     Jz = Regedit_XG.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407")                   '读取注册表“安全设置-Internet区域”中的“允许对剪贴板进行编程访问”设置(3=禁用、0=启用、1=提示)原始值
  3.     Regedit_XG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407", "0", "REG_DWORD"      '修改注册表“安全设置-Internet区域”中的“允许对剪贴板进行编程访问”设置(3=禁用、0=启用、1=提示),使系统默认为“允许访问剪贴板”
  4.    
  5.     Regedit_XG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407", Jz, "REG_DWORD"      '恢复注册表“安全设置-Internet区域”中的“允许对剪贴板进行编程访问”设置(3=禁用、0=启用、1=提示)原始值
  6.     Set Regedit_XG = Nothing
复制代码

评分

参与人数 1鲜花 +2 收起 理由
蓝天630902 + 2 测试通过

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-6-27 22:14 | 显示全部楼层
yahaa_L 发表于 2012-6-26 01:29
弹出的IE允许访问窗口问题做了一个方案,在我的文件测试过,不知可否通用,还请老师斧正!
在蓝天老师代码 ...

Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'剪贴版数据格式定义
Private Const CF_DIB = 8

Sub 验证码识别()
    Dim a(1 To 4)
    Dim img       '(验证码)图片
    Dim CtrlRange '非文本对象集合
    Dim bytClipData()  As Byte '定义字节数组
    Dim arr(0 To 1260)
    Dim ts As Integer
    On Error Resume Next
    Set Regedit_XG = CreateObject("WScript.Shell")              '创建一个空的VBS“壳”
    Jz = Regedit_XG.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407")                   '读取注册表“安全设置-Internet区域”中的“允许对剪贴板进行编程访问”设置(3=禁用、0=启用、1=提示)原始值
    Regedit_XG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407", "0", "REG_DWORD"      '修改注册表“安全设置-Internet区域”中的“允许对剪贴板进行编程访问”设置(3=禁用、0=启用、1=提示),使系统默认为“允许访问剪贴板”
    With CreateObject("InternetExplorer.application")           '创建一个空的ie
        .Visible = True                                         '让ie可见
        .Navigate "http://119.145.135.38/fscx/web/loginForm.do" '导航到http://119.145.135.38/fscx/web/loginForm.do
        Do Until .ReadyState = 4               '等待ie完毕加载
            DoEvents
        Loop
        Set img = .Document.All.tags("img")(0) '指定(验证码)目标图片
        Set CtrlRange = .Document.body.createControlRange()  '创建非文本对象 ControlRange 集合
        CtrlRange.Add img                      '向非文本对象 ControlRange 集合中添加 img 对象
        CtrlRange.execCommand "Copy", True     '从 ControlRange 集合中copy img 对象(图片)到剪贴板
        Dim hMem As Long, lpData As Long
        OpenClipboard 0&                       '打开粘贴板
        hMem = GetClipboardData(8)             '获得粘贴板数据,指定格式为:CF_DIB = 8
        If CBool(hMem) Then
            lpData = GlobalLock(hMem)          '锁定内存对象hMen
            lClipSize = GlobalSize(hMem)       '获得粘贴板数据字节数
            If lpData <> 0 And lClipSize > 0 Then
                ReDim bytClipData(0 To lClipSize - 1) As Byte      '重新定义字节数组大小
                CopyMemory bytClipData(0), ByVal lpData, lClipSize '粘贴板转化成字节数组
            End If
            GlobalUnlock hMem                  '解除锁定内存对象hMen
        End If
        CloseClipboard                         '关闭粘贴板
        For i = 1 To 1260                      '归一化处理
            ts = (Val(bytClipData((i - 1) * 3 + 40)) + Val(bytClipData((i - 1) * 3 + 41)) + Val(bytClipData((i - 1) * 3 + 42))) / 3 '40是图片开始字节
            If ts > 150 Then
                ts = 0
            Else
                ts = 1
            End If
            arr(i) = ts
        Next i
        For i = 1 To 4
            a(i) = 0                                                          '0
            If arr(13 * 60 + 8 + (i - 1) * 14) = 1 And arr(14 * 60 + 8 + (i - 1) * 14) = 1 Then a(i) = 1: GoTo 1 '16位色,所以乘以“3”RGB各占一字节,60是宽,14是字间距,
            If arr(4 * 60 + 6 + (i - 1) * 14) = 1 Then a(i) = 2: GoTo 1       '2
            If arr(16 * 60 + 11 + (i - 1) * 14) = 0 Then a(i) = 3: GoTo 1     '3
            If arr(7 * 60 + 5 + (i - 1) * 14) = 1 Then a(i) = 4: GoTo 1       '4
            If arr(12 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 5: GoTo 1      '5
            If arr(9 * 60 + 8 + (i - 1) * 14) = 1 And arr(11 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 6: GoTo 1  '6
            If arr(16 * 60 + 13 + (i - 1) * 14) = 1 Then a(i) = 7: GoTo 1     '7
            If arr(10 * 60 + 8 + (i - 1) * 14) = 1 And arr(11 * 60 + 8 + (i - 1) * 14) = 1 Then a(i) = 8: GoTo 1 '8
            If arr(9 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 9               '9
1:
        Next i
        Cells(1, 1) = a(1) & a(2) & a(3) & a(4)             '识别后的验证码
        .Document.All.tags("INPUT")(0).Value = "1234567890" '填写登录名
        .Document.All.tags("INPUT")(1).Value = "0987654321" '填写密  码
        .Document.All.tags("INPUT")(2).Value = Cells(1, 1)  '填写验证码
        .Document.All.tags("img")(1).Click                  '点击“登录”按钮
        '.Quit                     '关闭ie
        'MsgBox "OK"
    End With
    Regedit_XG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407", Jz, "REG_DWORD"      '恢复注册表“安全设置-Internet区域”中的“允许对剪贴板进行编程访问”设置(3=禁用、0=启用、1=提示)原始值
    Set Regedit_XG = Nothing      '释放VBS“壳”
End Sub

评分

参与人数 1鲜花 +3 收起 理由
VBA万岁 + 3 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2012-12-2 07:17 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-18 04:10 , Processed in 0.060995 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表