|
|
楼主 |
发表于 2012-6-27 22:14
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
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
查看全部评分
-
|
楼主: 蓝天630902
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-5-20 21:40
