这个验证码识别可以在XP+IE8+excel2007中正确识别，谁能让它在win7-64+IE11+excel2010中正确识别？

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    '打开剪贴板
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long     '锁定全局内存对象中指定的内存块，并返回一个地址值，令其指向内存块的起始处
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long     '取得剪贴板数据大小
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long   '解除被锁定的全局内存对象
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)    '将一块内存的数据从一个位置复制到另一个位置
Public Declare Function EmptyClipboard Lib "user32" () As Long                     '清空剪贴板并释放剪贴板内数据的句柄。
'剪贴版数据格式定义
Public Const CF_TEXT = 1
Public Const CF_BITMAP = 2
Public Const CF_DIB = 8    '位图，这是我们下面要用到的
'DIB的结构
Public Type BITMAPINFOHEADER   '文件信息头——BITMAPINFOHEADER
    biSize As Long              'biSize BITMAPINFOHEADER结构的大小。BMP有多个版本，就靠biSize来区别：BMP3.0：BITMAPINFOHEADER（=40）,BMP4.0：BITMAPV4HEADER（=108）,BMP5.0：BITMAPV5HEADER（=124）
    biWidth As Long             'biWidth 位图的宽度，单位是像素
    biHeight As Long            'biHeight 位图的高度，单位是像素
    biPlanes As Integer         'biPlanes 设备的位平面数。现在都是1
    biBitCount As Integer       'biBitCount 图像的颜色位数:0：当biCompression=BI_JPEG时必须为0（BMP 5.0）, 1：单色位图,4：16色位图,8：256色位图,16：增强色位图，默认为555格式,24：真彩色位图,32：32位位图，默认情况下Windows不会处理最高8位，可以将它作为自己的Alpha通道
    biCompression As Long       'biCompression 压缩方式:BI_RGB：无压缩,BI_RLE8：行程编码压缩，biBitCount必须等于8,BI_RLE4：行程编码压缩，biBitCount必须等于4,BI_BITFIELDS：指定RGB掩码，biBitCount必须等于16、32,BI_JPEG：JPEG压缩（BMP 5.0）,BI_PNG：PNG压缩（BMP 5.0）
    biSizeImage As Long         'biSizeImage# 实际的位图数据所占字节（biCompression=BI_RGB时可以省略）
    biXPelsPerMeter As Long     'biXPelsPerMeter# 目标设备的水平分辨率，单位是每米的像素个数
    biYPelsPerMeter As Long     'biYPelsPerMeter# 目标设备的垂直分辨率，单位是每米的像素个数
    biClrUsed As Long           'biClrUsed# 使用的颜色数（当biBitCount等于1、4、8时才有效）。如果该项为0，表示颜色数为2^biBitCount
    biClrImportant As Long      'biClrImportant# 重要的颜色数。如果该项为0，表示所有颜色都是重要的
End Type
Public Type RGBQUAD      '调色板,只有biBitCount等于1、4、8时才有调色板。调色板实际上是一个数组，元素的个数由biBitCount和biClrUsed决定。
    rgbBlue As Byte      'rgbBlue 蓝色分量
    rgbGreen As Byte     'rgbGreen 绿色分量
    rgbRed As Byte       'rgbRed 红色分量
    rgbReserved As Byte  'rgbReserved# 保留，=0
End Type
Public Type bitmapinfo  'bitmapinfoheader结构和调色板数据合在一起就构成了bitmapinfo结构，这个结构在显示位图文件时能够用到
    bmiheader As BITMAPINFOHEADER
    bmicolors(0 To 255) As RGBQUAD
End TypeSub 验证码相似法()
    Dim img          '定义目标图片对象
    Dim CtrlRange    '定义非文本对象
    Dim bytClipData() As Byte        '定义数组（一维）
    Dim arr() As String              '定义数组（一维）
    Dim brr()                        '定义二值化数组
    Dim ts As Integer                '定义整数
    Dim wjxxt As BITMAPINFOHEADER    '定义文件信息头——BITMAPINFOHEADER
    Dim tsb As RGBQUAD               '定义调色板
    Dim xt As bitmapinfo             '定义bitmapinfo结构
    On Error Resume Next
    With CreateObject("InternetExplorer.application")    '创建一个空的ie
        .Visible = True                                  '让ie可见
        .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
        Do Until .ReadyState = 4                         '等待ie完毕加载
            DoEvents
        Loop
        Set img = .Document.getElementById("ctl00_MainContent_imagecheck")                 '指定（验证码）目标图片
        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                  '判断hMem是否存在，也就是说是否复制了图片
            lpData = GlobalLock(hMem)        '锁定内存对象hMen
            lClipSize = GlobalSize(hMem)     '获得剪贴板数据字节数
            If lpData <> 0 And lClipSize > 0 Then
                ReDim bytClipData(0 To lClipSize - 1)                 '重新定义字节数组大小
                CopyMemory bytClipData(0), ByVal lpData, lClipSize    '把剪贴板数据转移到字节数组
                CopyMemory wjxxt, ByVal lpData, bytClipData(0)        '把剪贴板数据转移到文件信息头——BITMAPINFOHEADER的wjxxt数组
                With wjxxt
                    tsbcd = lClipSize - .biSizeImage - .biSize        '调色板长度,tsbcd=0则无调色板
                    txmhzjs = .biSizeImage / .biHeight                '图像每行字节数(肯定是4的倍数)
                    txmxszjs = Int(txmhzjs / .biWidth)                '图像每像素字节数
                    txmd0 = txmhzjs - txmxszjs * .biWidth             '图像末端填充“0”的字节数
                    If tsbcd = 1024 Then
                        CopyMemory xt, ByVal lpData, tsbcd + .biSize  '把剪贴板数据转移到bitmapinfo的xt数组
                    End If
                End With
            End If
            GlobalUnlock hMem    '解除锁定内存对象hMen
        End If
        EmptyClipboard           '使用了剪贴板后，就要记着清空它，
        CloseClipboard           '关闭剪贴板
        a1 = wjxxt.biSize        '把biSize赋给a1
        If tsbcd > 0 Then        '如果有调色板
            a1 = lClipSize - wjxxt.biSizeImage    '就从wjxxt.biSizeImage开始
            txmxszjs = 1                          '并且一个字节表示一个点
        End If
        '-----------------------以下二值化
        ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight)        '重新定义arr数组大小
        ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth)    '重新定义brr数组大小
        For i = 1 To wjxxt.biWidth * wjxxt.biHeight           '没有调色板的话就从第40个字节开始
            arr(i) = ""                '1或空（就是没有）的设置，是图片显示方式不同，可以更改这个设置，来看看效果，不过要把下面的arr(i) = "1"一起改。
            If tsbcd = 0 Then          '没有调色板
                ts = 0                 '置初值
                For j = 0 To txmxszjs - 1
                    ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j))    '累加每一点的BGR值，从第lClipSize - wjxxt.biSizeImage个字节开始
                Next j
                ts = ts / txmxszjs     '图像的BGR的均值（不一定），有调色板的话就不是这个意思。应该说成是图片点的信息均值更贴切些，
            Else                       '有调色板
                ts = 0
                ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue)     '从调色板取B值
                ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen)    '从调色板取G值
                ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed)      '从调色板取R值
                ts = ts / 3
            End If
            If ts < 185 Then        '如果图像的BGR的均值<185，那么就把“1”赋给数组arr(i)，否则arr(i)＝0
                arr(i) = "1"        '其实就是二值化  0，1
            End If
            If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0         '跳过图像每行末端的附加“0”，因为biSizeImage必须是4的整倍数
        Next i
        For i = 1 To wjxxt.biHeight
            For j = 1 To wjxxt.biWidth
                brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j)      '把一维数组arr写入二维数组brr，注意：要倒过来，从下往上写，比直接写入单元格要快些。
            Next j
        Next i
        Dim b(0 To 9)
        Dim a(0 To 4)
        Dim c(0 To 4)
        b(0) = "001111100111111011100111110000111100001111000011110000111100001111000011111001110111111000111100"    '这就是所谓的字模“０”
        b(1) = "000011000001110000111100011111000100110000001100000011000000110000001100000011000000110000001100"
        b(2) = "001111000111111111100011110000110000001100000111000011100001110000111000011100001111111111111111"
        b(3) = "001111101111111111000011000000110001111000011110000001110000001111000011111001110111111000111100"
        b(4) = "000001100000111000011110000111100011011000110110011001101110011011111111111111110000011000000110"
        b(5) = "011111100111111001100000111000001111110011111111110001110000001111000011111001110111111000111100"
        b(6) = "001111100111111101100011110000001101110011111110111001111100001111000011111001110111111100111100"
        b(7) = "111111111111111100000110000011000000110000011100000110000001100000111000001100000011000000110000"
        b(8) = "011111001111111011000011110000111100001101111110011111101100001111000011111001111111111101111100"        a(1) = ""
        For i = 6 To 17                         '表示第6～17行，验证码 c(1)的位置
            For j = 4 To 11                     '表示第4～11列，验证码 c(1)的位置
                a(1) = a(1) & Val(brr(i, j))    '形成对比字模 a(1)
            Next j
        Next i        a(2) = ""
        For i = 8 To 19
            For j = 17 To 24
                a(2) = a(2) & Val(brr(i, j))    '形成对比字模 a(2)
            Next j
        Next i        a(3) = ""
        For i = 6 To 17
            For j = 30 To 37
                a(3) = a(3) & Val(brr(i, j))    '形成对比字模 a(3)
            Next j
        Next i        a(4) = ""
        For i = 8 To 19
            For j = 43 To 50
                a(4) = a(4) & Val(brr(i, j))    '形成对比字模 a(4)
            Next j
        Next i        For i = 1 To 4    '对比，因为有4个验证码数字
            c(i) = 0
            xs1 = 0
            For j = 0 To 8  '因为有9个字模
                xs = 0
                For k = 1 To 96    '96＝8*12就是字模的长度
                    If Val(Mid(a(i), k, 1)) = Val(Mid(b(j), k, 1)) Then xs = xs + 1    '进行比较，如果相同就累加1
                Next k
                If xs > xs1 Then    '取得最大
                    c(i) = j
                    xs1 = xs
                Else
                    xs = 0
                End If
            Next j
        Next i
        .Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
        .Document.getElementById("ctl00_MainContent_code_op").Value = Format(c(1) & c(2) & c(3) & c(4), "0000")    '写入验证码
        '.Quit
    End With
    Erase arr()          '清空数组，释放内存
    Erase bytClipData()
    Erase brr()
End Sub

解决方案 »

  1.   

    这代码主要部分应该和ie+excel无关吧，你检查一下图片复制和最后输出的时候的相关数据......
      

  2.   

    这是EH论坛上蓝天大师前年的作品，当时他就说他的程序只在IE8上测试通过，他的有关验证码识别的作品（都是基于IE8的）很多，很遗憾他已经两年不露面了。
      

  3.   

    很遗憾，我的也是ie8 + win7 64 家庭普通版，无法安装ie9以及以上的（曾用网上的方法升级过旗舰版，没多久系统变非法的.....所以还是老老实实用ie8吧）还是那句话，那图像识别部分应该是与ie无关的，你自己调试下，应该是可以的。
      

  4.   


    不过我很想知道，在ie8 + win7 64 家庭普通版 里，这段代码能正常识别吗？我只在 xp+ie8下测试，把这段代码放在excel2007中是正常运行的，老师您能帮我在你的系统下试一试吗？谢谢
      

  5.   

    在ie8 + win7 64 家庭普通版+excel2003/2007都是可以的
    而且在vb里，修改了一下图片来源（用loadpicture加载保存在本地的验证码图片）也是可以识别的。所以说你那代码的主要识别部分应该与ie是无关的，所以你按照下面2个步骤来调试：
    1、看看是不是图片复制部分的问题（我没有ie11，不过就算是ie11那种复制应该也是可以的吧）。方法是在CtrlRange.execCommand "Copy", True  后面添加一句：Sheet1.Paste
    运行完成后看看sheet1的表格中是否有图片(当然要提前清除所有的图片)
    2、最后输出部分在End With 后面添加：debug.print c(1),c(2),c(3),c(4)。看看结果是什么如果第1步能得到图片，那就应该没有问题的
      

  6.   


    图片没有，反而这段代码 “Sheet1.Paste” 出现在sheet1里面了，在我的系统里虽然没有报错，但识别出来的全是 1111
      

  7.   

    好吧，你用下面的代码试试：如果sheet1表格中没有图片，那就是获取图片部分的代码有问题。
    'Option Explicit
    Sub 验证码相似法()
        Dim img          '定义目标图片对象
        Dim CtrlRange    '定义非文本对象
        Dim bytClipData() As Byte        '定义数组（一维）
        Dim arr() As String              '定义数组（一维）
        Dim brr()                        '定义二值化数组
        Dim ts As Integer                '定义整数
        Dim wjxxt As BITMAPINFOHEADER    '定义文件信息头——BITMAPINFOHEADER
        Dim tsb As RGBQUAD               '定义调色板
        Dim xt As bitmapinfo             '定义bitmapinfo结构
        On Error Resume Next
        With CreateObject("InternetExplorer.application")    '创建一个空的ie
            .Visible = True                                  '让ie可见
            .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
            Do Until .ReadyState = 4                         '等待ie完毕加载
                DoEvents
            Loop
            Set img = .Document.getElementById("ctl00_MainContent_imagecheck") '指定（验证码）目标图片
            Set CtrlRange = .Document.body.createControlRange()    '创建非文本对象 ControlRange 集合
            CtrlRange.Add img                                      '向非文本对象 ControlRange 集合中添加 img 对象
            CtrlRange.execCommand "Copy", True                     '从 ControlRange 集合中copy img 对象（图片）到剪贴板,这样子读取的图片是不包含“位图文件头”的。也就是说，是从位图文件的第二部分开始读取的
            Sheet1.Paste
            Dim hMem As Long, lpData As Long
            OpenClipboard 0&                     '打开剪贴板
            hMem = GetClipboardData(8)           '获得剪贴板数据，指定格式为：CF_DIB = 8
            If CBool(hMem) Then                  '判断hMem是否存在，也就是说是否复制了图片
                lpData = GlobalLock(hMem)        '锁定内存对象hMen
                lClipSize = GlobalSize(hMem)     '获得剪贴板数据字节数
                If lpData <> 0 And lClipSize > 0 Then
                    ReDim bytClipData(0 To lClipSize - 1)                 '重新定义字节数组大小
                    CopyMemory bytClipData(0), ByVal lpData, lClipSize    '把剪贴板数据转移到字节数组
                    CopyMemory wjxxt, ByVal lpData, bytClipData(0)        '把剪贴板数据转移到文件信息头——BITMAPINFOHEADER的wjxxt数组
                    With wjxxt
                        tsbcd = lClipSize - .biSizeImage - .biSize        '调色板长度,tsbcd=0则无调色板
                        txmhzjs = .biSizeImage / .biHeight                '图像每行字节数(肯定是4的倍数)
                        txmxszjs = Int(txmhzjs / .biWidth)                '图像每像素字节数
                        txmd0 = txmhzjs - txmxszjs * .biWidth             '图像末端填充“0”的字节数
                        If tsbcd = 1024 Then
                            CopyMemory xt, ByVal lpData, tsbcd + .biSize  '把剪贴板数据转移到bitmapinfo的xt数组
                        End If
                    End With
                End If
                GlobalUnlock hMem    '解除锁定内存对象hMen
            End If
            EmptyClipboard           '使用了剪贴板后，就要记着清空它，
            CloseClipboard           '关闭剪贴板
            a1 = wjxxt.biSize        '把biSize赋给a1
            If tsbcd > 0 Then        '如果有调色板
                a1 = lClipSize - wjxxt.biSizeImage    '就从wjxxt.biSizeImage开始
                txmxszjs = 1                          '并且一个字节表示一个点
            End If
            '-----------------------以下二值化
            ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight)        '重新定义arr数组大小
            ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth)    '重新定义brr数组大小
            For i = 1 To wjxxt.biWidth * wjxxt.biHeight           '没有调色板的话就从第40个字节开始
                arr(i) = ""                '1或空（就是没有）的设置，是图片显示方式不同，可以更改这个设置，来看看效果，不过要把下面的arr(i) = "1"一起改。
                If tsbcd = 0 Then          '没有调色板
                    ts = 0                 '置初值
                    For j = 0 To txmxszjs - 1
                        ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j))    '累加每一点的BGR值，从第lClipSize - wjxxt.biSizeImage个字节开始
                    Next j
                    ts = ts / txmxszjs     '图像的BGR的均值（不一定），有调色板的话就不是这个意思。应该说成是图片点的信息均值更贴切些，
                Else                       '有调色板
                    ts = 0
                    ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue)     '从调色板取B值
                    ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen)    '从调色板取G值
                    ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed)      '从调色板取R值
                    ts = ts / 3
                End If
                If ts < 185 Then        '如果图像的BGR的均值<185，那么就把“1”赋给数组arr(i)，否则arr(i)＝0
                    arr(i) = "1"        '其实就是二值化  0，1
                End If
                If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0         '跳过图像每行末端的附加“0”，因为biSizeImage必须是4的整倍数
            Next i
            For i = 1 To wjxxt.biHeight
                For j = 1 To wjxxt.biWidth
                    brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j)      '把一维数组arr写入二维数组brr，注意：要倒过来，从下往上写，比直接写入单元格要快些。
                Next j
            Next i
            Dim b(0 To 9)
            Dim a(0 To 4)
            Dim c(0 To 4)
            b(0) = "001111100111111011100111110000111100001111000011110000111100001111000011111001110111111000111100"    '这就是所谓的字模“０”
            b(1) = "000011000001110000111100011111000100110000001100000011000000110000001100000011000000110000001100"
            b(2) = "001111000111111111100011110000110000001100000111000011100001110000111000011100001111111111111111"
            b(3) = "001111101111111111000011000000110001111000011110000001110000001111000011111001110111111000111100"
            b(4) = "000001100000111000011110000111100011011000110110011001101110011011111111111111110000011000000110"
            b(5) = "011111100111111001100000111000001111110011111111110001110000001111000011111001110111111000111100"
            b(6) = "001111100111111101100011110000001101110011111110111001111100001111000011111001110111111100111100"
            b(7) = "111111111111111100000110000011000000110000011100000110000001100000111000001100000011000000110000"
            b(8) = "011111001111111011000011110000111100001101111110011111101100001111000011111001111111111101111100"        a(1) = ""
            For i = 6 To 17                         '表示第6～17行，验证码 c(1)的位置
                For j = 4 To 11                     '表示第4～11列，验证码 c(1)的位置
                    a(1) = a(1) & Val(brr(i, j))    '形成对比字模 a(1)
                Next j
            Next i        a(2) = ""
            For i = 8 To 19
                For j = 17 To 24
                    a(2) = a(2) & Val(brr(i, j))    '形成对比字模 a(2)
                Next j
            Next i        a(3) = ""
            For i = 6 To 17
                For j = 30 To 37
                    a(3) = a(3) & Val(brr(i, j))    '形成对比字模 a(3)
                Next j
            Next i        a(4) = ""
            For i = 8 To 19
                For j = 43 To 50
                    a(4) = a(4) & Val(brr(i, j))    '形成对比字模 a(4)
                Next j
            Next i        For i = 1 To 4    '对比，因为有4个验证码数字
                c(i) = 0
                xs1 = 0
                For j = 0 To 8  '因为有9个字模
                    xs = 0
                    For k = 1 To 96    '96＝8*12就是字模的长度
                        If Val(Mid(a(i), k, 1)) = Val(Mid(b(j), k, 1)) Then xs = xs + 1    '进行比较，如果相同就累加1
                    Next k
                    If xs > xs1 Then    '取得最大
                        c(i) = j
                        xs1 = xs
                    Else
                        xs = 0
                    End If
                Next j
            Next i
            .Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
            .Document.getElementById("ctl00_MainContent_code_op").Value = Format(c(1) & c(2) & c(3) & c(4), "0000")    '写入验证码
            '.Quit
        End With
        Debug.Print c(1), c(2), c(3), c(4)
        Erase arr()          '清空数组，释放内存
        Erase bytClipData()
        Erase brr()
    End Sub
      

  8.   

    我跟踪了一下，这句 ：CtrlRange.Add img 没有添加成功
      

  9.   

    这句就没成功：Set CtrlRange = .Document.body.createControlRange()
    在XP里面这些玩这句后，有个length=0（执行完下一句，就=1），而在新系统里什么也没有
      

  10.   

    那没辙了，没有ie11，不知道啥情况。不过你可以用webbrowser试一试（不知结果如何）：
    在sheet1中添加一个webbrowser(Microsoft Web Browser)并改名WB，然后复制下面代码到模块里（api以及常数，结构定义单独复制），运行test
    Sub Test()
        ''用webbrowser加载图片
        Dim img, CtrlRange
        With Sheet1.WB
            .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
            Do Until .ReadyState = 4                         '等待ie完毕加载
                DoEvents
            Loop
            Set img = .Document.getElementById("ctl00_MainContent_imagecheck")                 '指定（验证码）目标图片
            Set CtrlRange = .Document.body.createControlRange()    '创建非文本对象 ControlRange 集合
            CtrlRange.Add img                                      '向非文本对象 ControlRange 集合中添加 img 对象
            CtrlRange.execCommand "Copy", True                     '从 ControlRange 集合中copy img 对象（图片）到剪贴板,这样子读取的
        End With
        验证码相似法1
    End Sub
    Sub 验证码相似法1()
        Dim bytClipData() As Byte        '定义数组（一维）
        Dim arr() As String              '定义数组（一维）
        Dim brr()                        '定义二值化数组
        Dim ts As Integer                '定义整数
        Dim wjxxt As BITMAPINFOHEADER    '定义文件信息头——BITMAPINFOHEADER
        Dim tsb As RGBQUAD               '定义调色板
        Dim xt As bitmapinfo             '定义bitmapinfo结构
        On Error Resume Next
        Dim hMem As Long, lpData As Long
        OpenClipboard 0&                     '打开剪贴板
        hMem = GetClipboardData(8)           '获得剪贴板数据，指定格式为：CF_DIB = 8
        If CBool(hMem) Then                  '判断hMem是否存在，也就是说是否复制了图片
            lpData = GlobalLock(hMem)        '锁定内存对象hMen
            lClipSize = GlobalSize(hMem)     '获得剪贴板数据字节数
            If lpData <> 0 And lClipSize > 0 Then
                ReDim bytClipData(0 To lClipSize - 1)                 '重新定义字节数组大小
                CopyMemory bytClipData(0), ByVal lpData, lClipSize    '把剪贴板数据转移到字节数组
                CopyMemory wjxxt, ByVal lpData, bytClipData(0)        '把剪贴板数据转移到文件信息头——BITMAPINFOHEADER的wjxxt数组
                With wjxxt
                    tsbcd = lClipSize - .biSizeImage - .biSize        '调色板长度,tsbcd=0则无调色板
                    txmhzjs = .biSizeImage / .biHeight                '图像每行字节数(肯定是4的倍数)
                    txmxszjs = Int(txmhzjs / .biWidth)                '图像每像素字节数
                    txmd0 = txmhzjs - txmxszjs * .biWidth             '图像末端填充“0”的字节数
                    If tsbcd = 1024 Then
                        CopyMemory xt, ByVal lpData, tsbcd + .biSize  '把剪贴板数据转移到bitmapinfo的xt数组
                    End If
                End With
            End If
            GlobalUnlock hMem    '解除锁定内存对象hMen
        End If
        EmptyClipboard           '使用了剪贴板后，就要记着清空它，
        CloseClipboard           '关闭剪贴板
        a1 = wjxxt.biSize        '把biSize赋给a1
        If tsbcd > 0 Then        '如果有调色板
            a1 = lClipSize - wjxxt.biSizeImage    '就从wjxxt.biSizeImage开始
            txmxszjs = 1                          '并且一个字节表示一个点
        End If
        '-----------------------以下二值化
        ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight)        '重新定义arr数组大小
        ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth)    '重新定义brr数组大小
        For i = 1 To wjxxt.biWidth * wjxxt.biHeight           '没有调色板的话就从第40个字节开始
            arr(i) = ""                '1或空（就是没有）的设置，是图片显示方式不同，可以更改这个设置，来看看效果，不过要把下面的arr(i) = "1"一起改。
            If tsbcd = 0 Then          '没有调色板
                ts = 0                 '置初值
                For j = 0 To txmxszjs - 1
                    ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j))    '累加每一点的BGR值，从第lClipSize - wjxxt.biSizeImage个字节开始
                Next j
                ts = ts / txmxszjs     '图像的BGR的均值（不一定），有调色板的话就不是这个意思。应该说成是图片点的信息均值更贴切些，
            Else                       '有调色板
                ts = 0
                ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue)     '从调色板取B值
                ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen)    '从调色板取G值
                ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed)      '从调色板取R值
                ts = ts / 3
            End If
            If ts < 185 Then        '如果图像的BGR的均值<185，那么就把“1”赋给数组arr(i)，否则arr(i)＝0
                arr(i) = "1"        '其实就是二值化  0，1
            End If
            If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0         '跳过图像每行末端的附加“0”，因为biSizeImage必须是4的整倍数
        Next i
        For i = 1 To wjxxt.biHeight
            For j = 1 To wjxxt.biWidth
                brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j)      '把一维数组arr写入二维数组brr，注意：要倒过来，从下往上写，比直接写入单元格要快些。
            Next j
        Next i
        Dim b(0 To 9)
        Dim a(0 To 4)
        Dim c(0 To 4)
        b(0) = "001111100111111011100111110000111100001111000011110000111100001111000011111001110111111000111100"    '这就是所谓的字模“０”
        b(1) = "000011000001110000111100011111000100110000001100000011000000110000001100000011000000110000001100"
        b(2) = "001111000111111111100011110000110000001100000111000011100001110000111000011100001111111111111111"
        b(3) = "001111101111111111000011000000110001111000011110000001110000001111000011111001110111111000111100"
        b(4) = "000001100000111000011110000111100011011000110110011001101110011011111111111111110000011000000110"
        b(5) = "011111100111111001100000111000001111110011111111110001110000001111000011111001110111111000111100"
        b(6) = "001111100111111101100011110000001101110011111110111001111100001111000011111001110111111100111100"
        b(7) = "111111111111111100000110000011000000110000011100000110000001100000111000001100000011000000110000"
        b(8) = "011111001111111011000011110000111100001101111110011111101100001111000011111001111111111101111100"
        a(1) = ""
        For i = 6 To 17                         '表示第6～17行，验证码 c(1)的位置
            For j = 4 To 11                     '表示第4～11列，验证码 c(1)的位置
                a(1) = a(1) & Val(brr(i, j))    '形成对比字模 a(1)
            Next j
        Next i
        a(2) = ""
        For i = 8 To 19
            For j = 17 To 24
                a(2) = a(2) & Val(brr(i, j))    '形成对比字模 a(2)
            Next j
        Next i
        a(3) = ""
        For i = 6 To 17
            For j = 30 To 37
                a(3) = a(3) & Val(brr(i, j))    '形成对比字模 a(3)
            Next j
        Next i    a(4) = ""
        For i = 8 To 19
            For j = 43 To 50
                a(4) = a(4) & Val(brr(i, j))    '形成对比字模 a(4)
            Next j
        Next i
        For i = 1 To 4    '对比，因为有4个验证码数字
            c(i) = 0
            xs1 = 0
            For j = 0 To 8  '因为有9个字模
                xs = 0
                For k = 1 To 96    '96＝8*12就是字模的长度
                    If Val(Mid(a(i), k, 1)) = Val(Mid(b(j), k, 1)) Then xs = xs + 1    '进行比较，如果相同就累加1
                Next k
                If xs > xs1 Then    '取得最大
                    c(i) = j
                    xs1 = xs
                Else
                    xs = 0
                End If
            Next j
        Next i
        MsgBox c(1) & c(2) & c(3) & c(4)
        Erase arr()          '清空数组，释放内存
        Erase bytClipData()
        Erase brr()
    End Sub
      

  11.   

    加载时，webbrowser的内容总是不变，识别出的验证码不对，总是888，看来IE升级后，可能需要大改动
      

  12.   

    验证码图片在IE临时文件夹可以找到，不过是jpg格式的
      

  13.   


    看来太费劲，算了，我也装个IE8吧，你那里套用这段代码能识别这个验证码吗？ http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447
    看起来差不多，但不知道应该怎么改
      

  14.   

    1、ie11据说是可以当成ie10，9，8，7等来使用，应该没有必要再安装一个ie8；
    2、想用你那个代码来识别http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447，是不行的，虽然都是纯数字，但是亦增加了旋转，难度增加........
      

  15.   


    我试了试，如果创建好IE后，按F12，可以选择IE8，IMG就可以加载进ControlRange中了，但是接下来这句 If CBool(hMem) Then  '判断hMem是否存在，也就是说是否复制了图片 ，是false，说明图片还是没有复制成功，不知道又哪里不兼容了，看来太难了
      

  16.   

    可以尝试ie11手动打开网站，找到验证码图片，然后右键复制，再运行#13楼的【 Sub 验证码相似法1()】 过程，如果还是不能读取出来，那就放弃吧，只能从文件着手了（缓存文件）......
      

  17.   


    执行到：ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue)     '从调色板取B值
    提示：下标越界
      

  18.   


        Structure FILETIME
            Dim dwLowDateTime As Int32
            Dim dwHighDateTime As Int32
        End Structure    Structure INTERNET_CACHE_ENTRY_INFO
            Dim dwStructSize As Int32       ' version of cache system.
            Dim lpszSourceUrlName As Int32     ' embedded pointer to the URL name string.
            Dim lpszLocalFileName As Int32     ' embedded pointer to the local file name.
            Dim CacheEntryType As Int32     ' cache type bit mask.
            Dim dwUseCount As Int32     ' current users count of the cache entry.
            Dim dwHitRate As Int32      ' num of times the cache entry was retrieved.
            Dim dwSizeLow As Int32      ' low DWORD of the file size.
            Dim dwSizeHigh As Int32     ' high DWORD of the file size.
            Dim LastModifiedTime As FILETIME        ' last modified time of the file in GMT format.
            Dim ExpireTime As FILETIME      ' expire time of the file in GMT format
            Dim LastAccessTime As FILETIME      ' last accessed time in GMT format
            Dim LastSyncTime As FILETIME        ' last time the URL was synchronized
            ' with the source
            Dim lpHeaderInfo As Int32      ' embedded pointer to the header info.
            Dim dwHeaderInfoSize As Int32       ' size of the above header.
            Dim lpszFileExtension As Int32     ' File extension used to retrive the urldata as a file.
            Dim dwExemptDelta As Int32  ' Exemption delta from last access
        End Structure    Declare Unicode Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoW" (ByVal lpszUrlName As String, ByRef lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByRef lpcbCacheEntryInfo As Int32) As Int32        Dim bmp As Drawing.Bitmap
            Dim g As Graphics
            Dim data As Imaging.BitmapData
            Dim urlinfo(10) As INTERNET_CACHE_ENTRY_INFO
            Dim fok As Int32
            Dim dw As Int32
            Dim url As String
            Dim web As SHDocVw.WebBrowser
            Dim doc As mshtml.HTMLDocument
            Dim eimg As mshtml.HTMLImg        web = CreateObject("InternetExplorer.Application")
            web.Visible = True
            web.Navigate("http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx")
            While web.Busy Or Not web.ReadyState = SHDocVw.tagREADYSTATE.READYSTATE_COMPLETE
                Application.DoEvents()
            End While
            doc = web.Document
            eimg = doc.GetElementById("ctl00_MainContent_imagecheck")
            dw = Len(urlinfo(0)) * 11
            fok = GetUrlCacheEntryInfo(eimg.src, urlinfo(0), dw)
            url = Runtime.InteropServices.Marshal.PtrToStringUni(urlinfo(0).lpszLocalFileName)
            bmp = New Bitmap(url)
            data = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format1bppIndexed)
            Dim p1 As IntPtr
            Dim np As Int32
            Dim b As Byte        p1 = data.Scan0
            np = 0
            For r As Int32 = 1 To data.Height
                For c As Int32 = 1 To data.Width / 8
                    b = Runtime.InteropServices.Marshal.ReadByte(p1, np)
                    np += 1
                    For m As Int32 = 7 To 0 Step -1
                        Debug.Write(IIf(b And (2 ^ m), "-", "0"))
                    Next
                Next
                If data.Width Mod 8 > 0 Then
                    b = Runtime.InteropServices.Marshal.ReadByte(p1, np)
                    np += 1
                    For m As Int32 = 7 To 8 - data.Width Mod 8 Step -1
                        Debug.Write(IIf(b And (2 ^ m), "-", "0"))
                    Next
                End If
                Debug.Write(vbCrLf)
                If np Mod 8 > 0 Then np += 8
            Next
            bmp.UnlockBits(data)
            'bmp.Save("D:\Administrator\desktop\aa.bmp")
            g = Graphics.FromHwnd(Me.Handle)
            g.DrawImage(bmp, 0, 0)  '窗口显示黑白数字图像----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
    -----0000---------------------000000----------------------
    ----000000--------------------000000----------------------
    ---000---00-------0000--------00------------0000----------
    ---00----00------000000-------0------------000000---------
    ---------00-----00----00-----000000-------000---00--------
    --------00------------00-----0000000------00----00--------
    -------000---------0000------00---000-----------00--------
    ------000----------0000------------00----------00---------
    -----000-------------000-----00----00---------000---------
    ----00----------------00-----000--000--------000----------
    ---00000000-----00----00------000000--------000-----------
    ---00000000-----000--000-------0000--------00-------------
    -----------------000000-------------------00000000--------
    ------------------0000--------------------00000000--------
    ----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
    ----------------------------------------------------------
      

  19.   

    你这种识别验证码方式没有容错，判断不出机率很高你这种识别验证码方式没有容错，判断不出机率很高
    我来一个：
    引用VerifyCodeIdentify.dll， 下载地址：http://pan.baidu.com/s/1mgJtYTq
    将字模库.txt和你的应用程序放在同一文件夹下。
    Sub 验证码相似法2()
        Dim img          '定义目标图片对象
        Dim CtrlRange    '定义非文本对象    On Error Resume Next
        With CreateObject("InternetExplorer.application")    '创建一个空的ie
            .Visible = True                                  '让ie可见
            .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
            Do Until .ReadyState = 4                         '等待ie完毕加载
                DoEvents
            Loop
            Set img = .Document.getElementById("ctl00_MainContent_imagecheck")                 '指定（验证码）目标图片
            Set CtrlRange = .Document.body.createControlRange()    '创建非文本对象 ControlRange 集合
            CtrlRange.Add img                                      '向非文本对象 ControlRange 集合中添加 img 对象
            CtrlRange.execCommand "Copy", True                     '从 ControlRange 集合中copy img 对象（图片）到剪贴板,这样子读取的图片是不包含“位图文件头”的。也就是说，是从位图文件的第二部分开始读取的
            ''''''''''''''''''''''''''''
            Dim vci As New clsVCI
            Dim p As StdPicture
            Set p = Clipboard.GetData
            Set vci.vc_picture = p
            vci.Similarity = 0.8
            vci.ReadTemplate Replace(App.Path & "\字模库.txt", "\\", "\")        .Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
            .Document.getElementById("ctl00_MainContent_code_op").Value = vci.VerifyCode(185, 185, 185, 4, 5, 8, 1)   '写入验证码
             Set vci = Nothing
              ''''''''''''''''''''''''''''''''''''''
            '.Quit
        End With
    End Sub
      

  20.   

    在我的资源里也能下载到VerifyCodeIdentify.dll
      

  21.   

    你这种识别验证码方式没有容错，判断不出机率很高
    我来一个：
    引用VerifyCodeIdentify.dll， 下载地址：http://pan.baidu.com/s/1mgJtYTq
    将字模库.txt和你的应用程序放在同一文件夹下。
    Sub 验证码相似法2()
        Dim img          '定义目标图片对象
        Dim CtrlRange    '定义非文本对象    On Error Resume Next
        With CreateObject("InternetExplorer.application")    '创建一个空的ie
            .Visible = True                                  '让ie可见
            .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
            Do Until .ReadyState = 4                         '等待ie完毕加载
                DoEvents
            Loop
            Set img = .Document.getElementById("ctl00_MainContent_imagecheck")                 '指定（验证码）目标图片
            Set CtrlRange = .Document.body.createControlRange()    '创建非文本对象 ControlRange 集合
            CtrlRange.Add img                                      '向非文本对象 ControlRange 集合中添加 img 对象
            CtrlRange.execCommand "Copy", True                     '从 ControlRange 集合中copy img 对象（图片）到剪贴板,这样子读取的图片是不包含“位图文件头”的。也就是说，是从位图文件的第二部分开始读取的
            ''''''''''''''''''''''''''''
            Dim vci As New clsVCI
            Dim p As StdPicture
            Set p = Clipboard.GetData
            Set vci.vc_picture = p
            vci.Similarity = 0.8
            vci.ReadTemplate Replace(App.Path & "\字模库.txt", "\\", "\")        .Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
            .Document.getElementById("ctl00_MainContent_code_op").Value = vci.VerifyCode(185, 185, 185, 4, 5, 8, 1)   '写入验证码
             Set vci = Nothing
              ''''''''''''''''''''''''''''''''''''''
            '.Quit
        End With
    End Sub
    你的这段代码能识别我的验证码吗，我的验证码有点倾斜，但是纯数字应该不算难吧
    http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447
      

  22.   

    你这种识别验证码方式没有容错，判断不出机率很高
    我来一个：
    引用VerifyCodeIdentify.dll， 下载地址：http://pan.baidu.com/s/1mgJtYTq
    将字模库.txt和你的应用程序放在同一文件夹下。
    Sub 验证码相似法2()
        Dim img          '定义目标图片对象
        Dim CtrlRange    '定义非文本对象    On Error Resume Next
        With CreateObject("InternetExplorer.application")    '创建一个空的ie
            .Visible = True                                  '让ie可见
            .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
            Do Until .ReadyState = 4                         '等待ie完毕加载
                DoEvents
            Loop
            Set img = .Document.getElementById("ctl00_MainContent_imagecheck")                 '指定（验证码）目标图片
            Set CtrlRange = .Document.body.createControlRange()    '创建非文本对象 ControlRange 集合
            CtrlRange.Add img                                      '向非文本对象 ControlRange 集合中添加 img 对象
            CtrlRange.execCommand "Copy", True                     '从 ControlRange 集合中copy img 对象（图片）到剪贴板,这样子读取的图片是不包含“位图文件头”的。也就是说，是从位图文件的第二部分开始读取的
            ''''''''''''''''''''''''''''
            Dim vci As New clsVCI
            Dim p As StdPicture
            Set p = Clipboard.GetData
            Set vci.vc_picture = p
            vci.Similarity = 0.8
            vci.ReadTemplate Replace(App.Path & "\字模库.txt", "\\", "\")        .Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
            .Document.getElementById("ctl00_MainContent_code_op").Value = vci.VerifyCode(185, 185, 185, 4, 5, 8, 1)   '写入验证码
             Set vci = Nothing
              ''''''''''''''''''''''''''''''''''''''
            '.Quit
        End With
    End Sub

    CtrlRange.Add img 
    运行时错误 438，对象不支持该属性或方法，是不是非要IE8才行？
      

  23.   

    你这种识别验证码方式没有容错，判断不出机率很高
    我来一个：
    引用VerifyCodeIdentify.dll， 下载地址：http://pan.baidu.com/s/1mgJtYTq
    将字模库.txt和你的应用程序放在同一文件夹下。
    Sub 验证码相似法2()
        Dim img          '定义目标图片对象
        Dim CtrlRange    '定义非文本对象    On Error Resume Next
        With CreateObject("InternetExplorer.application")    '创建一个空的ie
            .Visible = True                                  '让ie可见
            .Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
            Do Until .ReadyState = 4                         '等待ie完毕加载
                DoEvents
            Loop
            Set img = .Document.getElementById("ctl00_MainContent_imagecheck")                 '指定（验证码）目标图片
            Set CtrlRange = .Document.body.createControlRange()    '创建非文本对象 ControlRange 集合
            CtrlRange.Add img                                      '向非文本对象 ControlRange 集合中添加 img 对象
            CtrlRange.execCommand "Copy", True                     '从 ControlRange 集合中copy img 对象（图片）到剪贴板,这样子读取的图片是不包含“位图文件头”的。也就是说，是从位图文件的第二部分开始读取的
            ''''''''''''''''''''''''''''
            Dim vci As New clsVCI
            Dim p As StdPicture
            Set p = Clipboard.GetData
            Set vci.vc_picture = p
            vci.Similarity = 0.8
            vci.ReadTemplate Replace(App.Path & "\字模库.txt", "\\", "\")        .Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
            .Document.getElementById("ctl00_MainContent_code_op").Value = vci.VerifyCode(185, 185, 185, 4, 5, 8, 1)   '写入验证码
             Set vci = Nothing
              ''''''''''''''''''''''''''''''''''''''
            '.Quit
        End With
    End Sub

    CtrlRange.Add img 
    运行时错误 438，对象不支持该属性或方法，是不是非要IE8才行？换成IE8，上面通过了，但这句Set p = Clipboard.GetData又提示错误 424，要求对象，是不是要引用什么？
      

  24.   

    你不是在vb6下运行吗？是在VBA下？
      

  25.   

    我没装VB6，我是在excel里面的VBA里运行，我的系统win7-64,+IE11+excel2010，实在找不到能运行的验证码识别例子，只能切换到 xp+ie8+excel2007里，才可以识别
      

  26.   

    这个我直接复制到VBA里面，不能运行，好多红字，是不是只能在VB环境里运行？
      

  27.   

    这是vb.net写的，直接取文件，ie11应该可以用
      

  28.   

    这么说vba不能用？我是想在excel里面调用识别验证码
      

  29.   

    可以生成com让vba调用
      

  30.   

    你的这段代码能识别下面的验证码吗，这个验证码有点倾斜，但是纯数字
    http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447
    你代码中的点阵庄的字符，怎么变成可以用的数字？我网上也找到一段点啊能把上面网址中的验证码在excel中显示出点阵状的字符，但我不知道怎么把他提取成可以使用的数字
      

  31.   

    Sub 验证码识别()
        Dim img          '定义目标图片对象
        Dim CtrlRange    '定义非文本对象
        Dim bytClipData() As Byte        '定义数组（一维）
        Dim arr() As String              '定义数组（一维）
        Dim brr()                        '定义二值化数组
        Dim ts As Integer                '定义整数
        Dim wjxxt As BITMAPINFOHEADER    '定义文件信息头——BITMAPINFOHEADER
        Dim tsb As RGBQUAD               '定义调色板
        Dim xt As bitmapinfo             '定义bitmapinfo结构
        Dim b
        Dim c
        Dim a(1 To 4)
        Dim tmp()
        Dim temp As String
        Cells.Clear    '清空工作表
        b = Split(",69b9768a84,567667975,99668986,246866543,444ddd222,79b6446b97,46669d96,48a8679b96,38cb77bc83,344554ddd22", ",")
        c = Split(",6,2,5,7,1,0,3,9,8,4", ",")
        On Error Resume Next
        Cells.Clear
        With CreateObject("InternetExplorer.application")           '创建一个空的ie
            .Visible = True                                         '让ie可见
            .Navigate "http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447"
            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                  '判断hMem是否存在，也就是说是否复制了图片
                lpData = GlobalLock(hMem)        '锁定内存对象hMen
                lClipSize = GlobalSize(hMem)     '获得剪贴板数据字节数
                If lpData <> 0 And lClipSize > 0 Then
                    ReDim bytClipData(0 To lClipSize - 1)                 '重新定义字节数组大小
                    CopyMemory bytClipData(0), ByVal lpData, lClipSize    '把剪贴板数据转移到字节数组
                    CopyMemory wjxxt, ByVal lpData, bytClipData(0)        '把剪贴板数据转移到文件信息头——BITMAPINFOHEADER的wjxxt数组
                    With wjxxt
                        tsbcd = lClipSize - .biSizeImage - .biSize        '调色板长度,tsbcd=0则无调色板
                        txmhzjs = .biSizeImage / .biHeight                '图像每行字节数(肯定是4的倍数)
                        txmxszjs = Int(txmhzjs / .biWidth)                '图像每像素字节数
                        txmd0 = txmhzjs - txmxszjs * .biWidth             '图像末端填充“0”的字节数
                        If tsbcd = 1024 Then
                            CopyMemory xt, ByVal lpData, tsbcd + .biSize  '把剪贴板数据转移到bitmapinfo的xt数组
                        End If
                    End With
                End If
                GlobalUnlock hMem    '解除锁定内存对象hMen
            End If
            EmptyClipboard           '使用了剪贴板后，就要记着清空它，
            CloseClipboard           '关闭剪贴板
            a1 = wjxxt.biSize        '把biSize赋给a1
            If tsbcd > 0 Then        '如果有调色板
                a1 = lClipSize - wjxxt.biSizeImage    '就从wjxxt.biSizeImage开始
                txmxszjs = 1                          '并且一个字节表示一个点
            End If
            ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight)        '重新定义arr数组大小
            ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth)    '重新定义brr数组大小
            For i = 1 To wjxxt.biWidth * wjxxt.biHeight           '没有调色板的话就从第40个字节开始
                arr(i) = ""                '1或空（就是没有）的设置，是图片显示方式不同，可以更改这个设置，来看看效果，不过要把下面的arr(i) = "1"一起改。
                If tsbcd = 0 Then          '没有调色板
                    ts = 0                 '置初值
                    For j = 0 To txmxszjs - 1
                        ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j))    '累加每一点的BGR值，从第lClipSize - wjxxt.biSizeImage个字节开始
                    Next j
                    ts = ts / txmxszjs     '图像的BGR的均值（不一定），有调色板的话就不是这个意思。应该说成是图片点的信息均值更贴切些，
                Else                       '有调色板
                    ts = 0
                    ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue)     '从调色板取B值
                    ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen)    '从调色板取G值
                    ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed)      '从调色板取R值
                    ts = ts / 3
                End If
                If ts < 205 Then         '如果图像的BGR的均值>10，那么就把“1”赋给数组arr(i)
                    arr(i) = "1"        '其实就是二值化
                End If
                If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0         '跳过图像每行末端的附加“0”，因为biSizeImage必须是4的整倍数
            Next i
            For i = 1 To wjxxt.biHeight
                For j = 1 To wjxxt.biWidth
                    brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j)      '把一维数组arr写入二维数组brr，注意：要倒过来，从下往上写，比直接写入单元格要快些。
                Next j
            Next i
            Range(Cells(1, 1), Cells(wjxxt.biHeight, wjxxt.biWidth)) = brr                 '把二维数组brr一次性写入单元格。
            temp = ""
            For i = 1 To wjxxt.biWidth
                For j = 1 To wjxxt.biHeight
                    Cells(wjxxt.biHeight + 1, i) = Cells(wjxxt.biHeight + 1, i) + arr((j - 1) * wjxxt.biWidth + i)    '累加，就是所谓的“压压扁”，写入wjxxt.biWidth+1行。
                Next j
                If Cells(wjxxt.biHeight + 1, i) = 10 Then Cells(wjxxt.biHeight + 1, i) = "a"    '把10用ａ表示、11用ｂ表示…………
                If Cells(wjxxt.biHeight + 1, i) = 11 Then Cells(wjxxt.biHeight + 1, i) = "b"
                If Cells(wjxxt.biHeight + 1, i) = 12 Then Cells(wjxxt.biHeight + 1, i) = "c"
                If Cells(wjxxt.biHeight + 1, i) = 13 Then Cells(wjxxt.biHeight + 1, i) = "d"
                If Cells(wjxxt.biHeight + 1, i) <> "" Then
                    temp = temp & Cells(wjxxt.biHeight + 1, i)    '把wjxxt.biWidth+1行的数串起来
                Else
                    temp = temp & ","
                    temp = Replace(temp, ",,", ",")
                End If
            Next i
            Rows(wjxxt.biHeight + 1 & ":" & wjxxt.biHeight + 1).ClearContents
            temp = Right(temp, Len(temp) - 1)
            temp = Left(temp, Len(temp) - 1)
            '下面的循环才是真正的识别
            For j = 1 To UBound(b)
                temp = Replace(temp, b(j), c(j))   '裁减字符串
            Next j
            ttp = Split(temp, ",")
            p = 0
            For i = 0 To UBound(ttp)
                If Len(ttp(i)) = 1 Then
                    p = p + 1
                    a(p) = ttp(i)
                Else
                    If Len(tmp(i)) > 1 Then
                        For j = 1 To UBound(b)
                            ttp(i) = Replace(ttp(i), Left(b(j), Len(b(j)) - 3), c(j))    '裁减字符串
                            ttp(i) = Replace(ttp(i), Right(b(j), Len(b(j)) - 3), c(j))    '裁减字符串
                        Next j
                        p = p + 1
                        a(p) = Left(ttp(i), 1)
                        p = p + 1
                        a(p) = Right(ttp(i), 1)
                    End If
                End If
            Next i
            Range("A1:A1").NumberFormatLocal = "@"
            Cells(1, 1) = Format(a(1) & a(2) & a(3) & a(4), "0000")   '这就是识别后的验证码
            .Quit
        End With
    End Sub
    这个在excel中的Cells(1, 1)中提取出来数字不对，但点阵中显示的是对的，我这个只能在IE8中显示出来，ie11不行