验证码识别讲座

蓝天630902

不过，首先声明一点：不是万能的，但是相当的激动人心的。下面的方法就是所谓的“压扁”方法。压压扁，就能得到意想不到的结果。
再声明一点：不是是写给高手看的。
再补充声明一点：下面的所有代码都是在 XP＋ie8＋Excel2007 下调试通过的，不能保证其他系统也能通过。
再提一点要求：尽量多提意见、建议，我会根据你们的意见建议不断完善。
闲话少说，进入主题，看看下面的例子：“http://www.zjadc.com/ADCCSSPortal/ValidateCode/generatevalidatecode.aspx”

试试吧：
'api引用
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的结构
'Private Type BITMAPFILEHEADER    'BMP文件头——BITMAPFILEHEADER
'    bfType(0 To 1) As Byte       'bfType 指示文件的类型，必须是“BM”
'    bfSize As Long               'bfSize# 指示文件的大小，包括BITMAPFILEHEADER
'    bfReserved1 As Integer       'bfReserved1 保留，=0
'    bfReserved2 As Integer       'bfReserved2 保留，=0
'    bfOffBits As Long            'bfOffBits# 从文件头到位图数据的偏移字节数
'End Type
Private 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
Private 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
Private Type bitmapinfo  'bitmapinfoheader结构和调色板数据合在一起就构成了bitmapinfo结构，这个结构在显示位图文件时能够用到
    bmiheader As BITMAPINFOHEADER
    bmicolors(0 To 255) As RGBQUAD
End Type
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结构
    Cells.ClearContents              '清空工作表
    On Error Resume Next
    With CreateObject("InternetExplorer.application")    '创建一个空的ie
        .Visible = True                                  '让ie可见
        .Navigate "http://www.zjadc.com/ADCCSSPortal/ValidateCode/generatevalidatecode.aspx"
        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 > 10 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一次性写入单元格。
        .Quit
    End With
End Sub


BMP 图形文件详细解释:
http://club.excelhome.net/forum.php?mod=attachment&aid=MTIyMDE4M3xlYmJjODQxY3wxMzQ0NTk5NjU5fDE2NjY1MTV8ODk2MTYx

蓝天630902

上面这个太简单，但很基本。

下面这个，是带干扰的：https://jx.ac.10086.cn/sso3/common/image.jsp

改两句就可以了：

.Navigate "https://jx.ac.10086.cn/sso3/common/image.jsp"   '导航到:https://jx.ac.10086.cn/sso3/common/image.jsp，｛换作其他网址，这一句要改｝

和

If ts > 180 Then    '如果图像的BGR的均值>0，那么就把“1”赋给数组arr(i)

蓝天630902

看看这个：http://www.ln.10086.cn/adc_ec/login.jsp

反了的，
改一改：
.Navigate "http://www.ln.10086.cn/adc_ec/login.jsp"   '导航到:http://www.ln.10086.cn/adc_ec/login.jsp，｛换作其他网址，这一句要改｝

arr(i) = 1    '1或空（就是没有）的设置，是图片显示方式不同，可以更改这个设置，来看看效果，不过要把下面的arr(i) = 1一起改。

If ts > 131 Then    '如果图像的BGR的均值>0，那么就把“1”赋给数组arr(i)
arr(i) = ""    '其实就是归一化处理成1

蓝天630902

这个是歪的：http://www.e-chinalife.com/selfcard/selfcard/cardActive/cardActiveForm.jsp

蓝天630902

http://www.hongvip.com/Reg.aspx，这个就是有“调色板”的那种：

蓝天630902

现在进入主题：“压压扁”以http://www.yiqifa.com/userLogin.do为例：

蓝天630902

慢慢完善。请你提提意见，指出不足的地方，谢谢！

下面是BMP 图形文件详细解释器，把网页上的图片保存为“*.bmp　”格式文件，并且保存到“BMP 图形文件详细解释.xlsm　”同一目录，
然后修改这一句的红色部分：
.Open "GET", ThisWorkbook.Path & "\" & "DV_getcode.bmp", False

然后点击试试看就可以了。本解释器只解释“BMP 图形文件”。

缔造者

知识点浅，看不明白。这些都写在哪呀？
不过还是要支持一下。谢谢分享！

引子玄

终于看到蓝天大师开课了！不但从实践上指导，而且开始从理论上和方法上的角度，来指导E友用科学的方法学习如何采集（抓取）网页内容，非常OK！
感谢蓝天大师的辛勤授课和指导。{:soso_e179:}

在很多的网页采集（抓取）的求助中，大批的网友都亲身感受到了蓝天大师创造的网抓代码，实用而高效，为众多E友扼腕称奇。在网抓学习方面，俺也是蓝天大师的受惠者。珍惜这个难得的机会，好好学习，天天向上。

天堑小舟

感谢教导
标识学习!