处理网页弹出窗口！急须解决（第二部分 截图内容）
弹出窗口截图
请高手再看看
上篇内容：
引用 1 楼 lyserver 的回复:
网页中的button属于无窗口控件，根本没有hwnd，又怎么能够使用sendmessage发送消息呢。
解决办法是通过DOM调用该button标签的click方法。
？？？是点了网页中的一个“签收”按钮后，弹出一个对话框.要再次点击该对话框中的“确定”按钮。才能进行签收操作。
~~~~~~~~~~~~~~~~~~~~~~~~
程序内容
Option Explicit
Dim ie As Object
Dim SWs As Object
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const BM_CLICK = &HF5
Private Sub Command1_Click()
Dim i As Integer
On Error Resume Next
For Each ie In SWs
If ie.LocationURL = Combo1.Text Then
For i = 0 To ie.Document.Frames.Item(1).Document.All.length - 1
If UCase(ie.Document.Frames.Item(1).Document.All(i).tagname) = "INPUT" Then
If ie.Document.Frames.Item(1).Document.All(i).Type = "checkbox" Then
ie.Document.Frames.Item(1).Document.All(i).Checked = True
ElseIf ie.Document.Frames.Item(1).Document.All(i).Value = "签收" Then
ie.Document.Frames.Item(1).Document.All(i).Click
End If
End If
Next i
End If
Next
End Sub
Private Sub Command2_Click()
On Error Resume Next
Dim hwnd0 As Long
Dim hwnd1 As Long
hwnd0 = FindWindow(vbNullString, "Microsoft Internet Explorer")
hwnd1 = FindWindowEx(hwnd0, 0, "Button", "确定")
SendMessage hwnd1, BM_CLICK, 0, 0
End Sub
Private Sub Form_Load()
Set ie = CreateObject("InternetExplorer.Application")
Set SWs = CreateObject("Shell.Application").Windows
Timer1.Enabled = False
Timer1.Interval = 500
End Sub
在第一个按钮将网页中的所有的全部选定后，点击“签收”网页按钮后，弹出一个
确认框，再点击“确定”按钮实现功能。现在是弹出的这个确认框，实现不了点击。请高手指点一下！
qq 87755438
--------------------编程问答-------------------- ie.Document.parentWindow.execScript "function alert(){return;}"
这样试试。 --------------------编程问答--------------------
--------------------编程问答-------------------- EnumWindows AddressOf EnumWindowsProc, ByVal 0&
Option Explicit
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const BM_CLICK = &HF5
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Sub Main()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim lRet As Long
Dim strBuffer As String
Dim hwndOK As Long
strBuffer = String(200, vbNullChar)
lRet = GetClassName(hwnd, strBuffer, Len(strBuffer))
strBuffer = Left(strBuffer, lRet)
If strBuffer = "#32770" Then '判断是不是对话框
strBuffer = String(200, vbNullChar)
lRet = GetWindowText(hwnd, strBuffer, Len(strBuffer))
strBuffer = Replace(strBuffer, vbNullChar, "")
If InStr(1, strBuffer, " Internet Explorer", vbBinaryCompare) > 0 Then '判断标题是否包含Internet Explorer字符串
hwndOK = FindWindowEx(hwnd, 0, "Button", vbNullString)
If hwndOK <> 0 Then
SendMessage hwndOK, BM_CLICK, 0, ByVal 0& '关闭对话框
SendMessage hwndOK, BM_CLICK, 0, ByVal 0& '需要发送两次消息
EnumWindowsProc = False
Exit Function
End If
End If
End If
EnumWindowsProc = True
End Function
编译时说Addressof 参数错
--------------------编程问答-------------------- 你把代码复制到标准模块里了吗？ --------------------编程问答-------------------- Private Sub Command1_Click()
Dim i As Integer
On Error Resume Next
For Each ie In SWs
If ie.LocationURL = Combo1.Text Then
For i = 0 To ie.Document.Frames.Item(1).Document.All.length - 1
If UCase(ie.Document.Frames.Item(1).Document.All(i).tagname) = "INPUT" Then
If ie.Document.Frames.Item(1).Document.All(i).Type = "checkbox" Then
ie.Document.Frames.Item(1).Document.All(i).Checked = True
ElseIf ie.Document.Frames.Item(1).Document.All(i).Value = "签收" Then
ie.Document.Frames.Item(1).Document.All(i).Click
End If
End If
Next i
End If
Next
Dim hwnd0 As Long
Dim hwnd1 As Long
hwnd0 = FindWindow(vbNullString, "Microsoft Internet Explorer")
hwnd1 = FindWindowEx(hwnd0, 0, "Button", "确定")
SendMessage hwnd1, BM_CLICK, 0, 0
End Sub
__________
1，复制了。
2，能不能改动一下你给我的程序代码，直接在第一全部选定数据占击“签收”按钮后，进行对弹出窗口的操作。
--------------------编程问答-------------------- Private Sub Command1_Click()
Dim i As Integer
On Error Resume Next
For Each ie In SWs
If ie.LocationURL = Combo1.Text Then
For i = 0 To ie.Document.Frames.Item(1).Document.All.length - 1
If UCase(ie.Document.Frames.Item(1).Document.All(i).tagname) = "INPUT" Then
If ie.Document.Frames.Item(1).Document.All(i).Type = "checkbox" Then
ie.Document.Frames.Item(1).Document.All(i).Checked = True
ElseIf ie.Document.Frames.Item(1).Document.All(i).Value = "签收" Then
ie.Document.Frames.Item(1).Document.All(i).Click
End If
End If
Next i
End If
Next
Dim hwnd0 As Long
Dim hwnd1 As Long
hwnd0 = FindWindow(vbNullString, "Microsoft Internet Explorer")
hwnd1 = FindWindowEx(hwnd0, 0, "Button", "确定")
SendMessage hwnd1, BM_CLICK, 0, 0
End Sub
__________
1，复制了。
2，能不能改动一下你给我的程序代码，直接在第一全部选定数据占击“签收”按钮后，进行对弹出窗口的操作。
--------------------编程问答-------------------- 以下代码复制到标准模块里
Option Explicit
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const BM_CLICK = &HF5
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Public Sub CloseDialog()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim lRet As Long
Dim strBuffer As String
Dim hwndOK As Long
strBuffer = String(200, vbNullChar)
lRet = GetClassName(hwnd, strBuffer, Len(strBuffer))
strBuffer = Left(strBuffer, lRet)
If strBuffer = "#32770" Then '判断是不是对话框
strBuffer = String(200, vbNullChar)
lRet = GetWindowText(hwnd, strBuffer, Len(strBuffer))
strBuffer = Replace(strBuffer, vbNullChar, "")
If InStr(1, strBuffer, " Internet Explorer", vbBinaryCompare) > 0 Then '判断标题是否包含Internet Explorer字符串
hwndOK = FindWindowEx(hwnd, 0, "Button", vbNullString)
If hwndOK <> 0 Then
SendMessage hwndOK, BM_CLICK, 0, ByVal 0& '关闭对话框
SendMessage hwndOK, BM_CLICK, 0, ByVal 0& '需要发送两次消息
End If
End If
End If
EnumWindowsProc = True
End Function
以下代码复制到窗口模块里：
--------------------编程问答-------------------- 还是对弹出窗口没有操作到
Private Sub Command1_Click()
Dim i As Integer
Dim objInput As Object
On Error Resume Next
For Each ie In SWs
If ie.LocationURL = Combo1.Text Then
For Each objInput In ie.Document.Frames.Item(1).Document.getElementsByTagName("INPUT")
If objInput.Type = "checkbox" Then
objInput.Checked = True
ElseIf objInput.Value = "签收" Then
objInput.Click
End If
Next
End If
Next
Call CloseDialog
End Sub
--------------------编程问答-------------------- 弹出个编译错误
操作符addressof 使用无效
~~~~~~~~~~~~~
Public Sub CloseDialog()
EnumWindows AddressOf EnumWindwosProc ,ByVal 0&
End Sub
~~~~~~~~~~~~~ --------------------编程问答--------------------
~~~~~~~~~~~~~~~~~~~~~该问题已解决，但还是没有处理弹出窗口！！！不知为什么！ --------------------编程问答-------------------- 在这儿我问一下，你的网页是怎么打开的？是WEBBROWSER控件打开的吗？如果是的话那么问题就是：在VB的webbrowser中弹出的对话框是模式对话框，弹出后VB代码处于暂停状态，就不能去查找对话框的句柄了。我也遇过此类问题，现在也没解除决！
Option Explicit我这个要是IE打开的网页弹出的窗口能自动点击，用WEBBROWSER控件打开网页弹出的窗口就不能点击了，楼主看看是不是一样的问题 --------------------编程问答-------------------- wb弹出窗口有个事件吧 不记得了
Const MK_LBUTTON = 1
'http://topic.csdn.net/u/20100312/09/bd98168f-038a-45a5-97c7-00b9b08f94de.html?seed=452989452&r=63867885#r_63867885
'发鼠标消息还是用PostMessage吧
Private Sub Command1_Click()
Dim hpwnd As Long, hcwnd As Long, iresult As Long
hpwnd = FindWindow(vbNullString, "Microsoft Intenet Expolor") 'IE的名字，可能在这儿会写错
hcwnd = FindWindowEx(hpwnd, 0, "Button", "确定")
SetForegroundWindow hcwnd
iresult = PostMessage(hcwnd, WM_LBUTTONDOWN, ByVal MK_LBUTTON, ByVal 0&)
iresult = PostMessage(hcwnd, WM_LBUTTONUP, ByVal 0&, ByVal 0&)
End Sub
老马博客里边有IE事件的文章 建议去看看 --------------------编程问答-------------------- 最近在学COM，也是晕晕愣愣的 --------------------编程问答-------------------- 时间过去了，限于自身技术能力，未能解决此问题。
近来工作比较忙，写程序的事就暂放一边了。但是在此非常感谢lyserver(江南春) 兄弟的无私帮助！
谢谢 --------------------编程问答-------------------- 哈哈，跟我的问题有些类似啊 “弹出网页对话框后，怎样拿回控制权？”
http://topic.csdn.net/u/20100804/11/cce9464d-272c-48b8-8a75-f228b96ef86c.html
不过，还是有解决办法的。 参见上贴。
--------------------编程问答-------------------- 正确的实现方法是实现IDocHostShowUI接口，在IDocHostShowUI_ShowMessage中直接IDocHostShowUI_ShowMessage = vbOK即可 --------------------编程问答-------------------- 顶起……搬个小板凳听课来的…… --------------------编程问答-------------------- 方法我看到了，getlastpopup,是可以拿到Handle，一般还会碰到个问题，里面有个ok button要点，还需要进一步拿到ok button的handle。模拟点击才可以。我懒得，到此就再没试过了 --------------------编程问答--------------------
这个要去试，我觉得拿lastpopup window 也不保险
补充：VB , 网络编程
