|
|
楼主 |
发表于 2012-10-31 09:05
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
kewinly 发表于 2012-10-29 03:38 
蓝天大师，你的功力让小弟佩服得五体投地，小弟进入这个http://www.haiguan.info/onlinesearch/gateway/Gat ...
弄一个“相似法”给你吧（但是，没有认真测试，先用一用。看看有没有什么毛病）：
'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的结构
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 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结构
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_code_op").Value = Format(c(1) & c(2) & c(3) & c(4), "0000") '写入验证码
'.Quit
End With
Erase arr() '清空数组，释放内存
Erase bytClipData()
Erase brr()
End Sub
|
|
楼主: 蓝天630902
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-10-18 20:25
