运行 两个 Internet Explorer 实例
Running two instances of Internet Explorer
我正在尝试 运行 两个 Internet Explorer 实例来抓取 HTML。目标是为大多数功能提供一个全局 IE。但是，我需要一个用于特定目的（身份验证）的实例，一旦完成就会被销毁。
出现第二个 IE 实例的原因是网站的身份验证过程会抛出一个难以确认和关闭的 alert() Javascript 弹出窗口。在这种情况下，我目前正在终止 IE 的整个实例。
请注意，我一直在另一个 post 此处讨论弹出窗口：Internet Explorer readyState reverts from Complete to Interactive
一旦我使用它的 PID 终止了 IE 的第二个实例，它似乎也会影响 IE 的全局实例。当我 return 到 IE 的全局实例时，我得到： 运行-time error '462': The remote server machine does not exist or is unavailable.
要复制：
- 执行函数运行IE1（可以运行多次）
- 执行函数运行IE2（可以运行多次）
- 执行函数运行IE1得到错误
模块代码：
Option Explicit
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal lHWnd As Long, _
ByRef lProcessId As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Public ie_browser As New InternetExplorer
Sub runIE1()
Debug.Print "--- runIE1 ---"
Debug.Print "ie_browser PID: "; ie_browser.hwnd
With ie_browser
.Navigate "http://127.0.0.1/good.html"
.Silent = True
.Visible = False
End With
Debug.Print "ie_browser1 Navigated..."
Do Until ie_browser.readyState = 4: DoEvents: Loop
Do Until ie_browser.Busy = False: DoEvents: Loop
Debug.Print "ie_browser should have parsed and rendered the page at this time"
Debug.Print "--- runIE1 ---"
End Sub
Sub runIE2()
Debug.Print "--- runIE2 ---"
Dim ie_browser2_hwnd As Long
Dim ie_browser2 As InternetExplorer
Set ie_browser2 = CreateObject("InternetExplorer.Application")
Debug.Print "ie_browser2 PID: "; ie_browser2.hwnd
With ie_browser2
.Navigate "http://127.0.0.1:9000/ftw/bad.html"
.Silent = True
.Visible = False
End With
Debug.Print "ie_browser2 Navigated..."
Debug.Print "ie_browser2 Start wait..."
Call waitForIE(ie_browser2)
Debug.Print "ie_browser2 End wait..."
'close if found
If Not ie_browser2 Is Nothing Then
Debug.Print "ie_browser2 not null..."
ie_browser2_hwnd = ie_browser2.hwnd
ie_browser2.Quit
Set ie_browser2 = Nothing
Debug.Print "ie_browser2 quit, set to null"
Call KillHwndProcess(ie_browser2_hwnd)
Debug.Print "terminated ie_browser2 PID: " & ie_browser2_hwnd
End If
Debug.Print "--- runIE2 ---"
End Sub
Public Sub waitForIE(i As InternetExplorer)
Dim ie_hwnd As Long
'Ensure browser has completed
Do While i.readyState = 4: DoEvents: Loop
'Sleep to ensure that we let the readyState to flip back
Sleep (250)
'popup occurred!
If i.readyState = 3 Then
Debug.Print "waitForIE - Popup occurred"
ie_hwnd = i.hwnd
Debug.Print "waitForIE - ie PID: " & ie_hwnd
i.Quit
Set i = Nothing
Debug.Print "waitForIE - quit IE, set to nothing..."
Call KillHwndProcess(ie_hwnd)
Debug.Print "waitForIE - Terminated IE process: " & ie_hwnd
Else
Do Until i.readyState = 4: DoEvents: Loop
Do Until i.Busy = False: DoEvents: Loop
Debug.Print "Browser should have parsed and rendered the page at this time"
Debug.Print "IE State: " & i.readyState & " IE busy: " & i.Busy
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : KillHwndProcess
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Terminate a process based on its Windows Handle (Hwnd)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' lHWnd : Windows Handle number (Hwnd)
'
' Usage:
' ~~~~~~
' Call KillHwndProcess(Application.hWnd)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2018-09-09 Initial Website Release
'---------------------------------------------------------------------------------------
Public Function KillHwndProcess(lHWnd As Long)
' https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-process
On Error GoTo Error_Handler
Dim oWMI As Object
Dim oProcesses As Object
Dim oProcess As Object
Dim lProcessId As Long
Dim sSQL As String
Const sComputer = "."
'Retrieve the ProcessId associated with the specified Hwnd
Call GetWindowThreadProcessId(lHWnd, lProcessId)
'Iterate through the matching ProcessId processes and terminate
' each one.
Set oWMI = GetObject("winmgmts:\" & sComputer & "\root\cimv2")
sSQL = "SELECT * FROM Win32_Process WHERE ProcessId=" & lProcessId
Set oProcesses = oWMI.ExecQuery(sSQL)
For Each oProcess In oProcesses
oProcess.Terminate
Next
Error_Handler_Exit:
On Error Resume Next
If Not oProcess Is Nothing Then Set oProcess = Nothing
If Not oProcesses Is Nothing Then Set oProcesses = Nothing
If Not oWMI Is Nothing Then Set oWMI = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: KillHwndProcess" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
立即输出window:
ie_browser PID: 593524
--- runIE1 ---
ie_browser PID: 593524
ie_browser Navigated...
ie_browser should have parsed and rendered the page at this time
--- runIE1 ---
--- runIE1 ---
ie_browser PID: 593524
ie_browser Navigated...
ie_browser should have parsed and rendered the page at this time
--- runIE1 ---
--- runIE1 ---
ie_browser PID: 593524
ie_browser Navigated...
ie_browser should have parsed and rendered the page at this time
--- runIE1 ---
--- runIE2 ---
ie_browser2 PID: 397928
ie_browser2 Navigated...
ie_browser2 Start wait...
waitForIE - Popup occurred
waitForIE - ie PID: 397928
waitForIE - quit IE, set to nothing...
waitForIE - Terminated IE process: 397928
ie_browser2 End wait...
--- runIE2 ---
--- runIE1 ---
文件 bad.html（删除 good.html 的警报）
<html>
<head>
<title>Bad file</title>
<meta http-equiv="X-UA-Compatible" content="IE=edge" />
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>
<body>
Bad!
<script type="text/javascript">
alert("Hello World!");
</script>
</body>
</html>
在快速测试中，这种 Windows API 方法似乎对我有用：
Option Explicit
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 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 As Integer = &HF5
Private Const WM_ACTIVATE As Integer = &H6
Private Const WA_ACTIVE As Integer = 1
Sub TestAPI()
Dim IE As InternetExplorer, el, hwnd As Long, btn As Long
Set IE = New InternetExplorerMedium
'open a test document with an auto-alert (using your example)
With IE
.Visible = False
.navigate "http://localhost/testpages/Bad.html"
End With
Application.Wait Now + TimeSerial(0, 0, 3)
'find the alert
hwnd = FindWindow("#32770", "Message from webpage")
If hwnd <> 0 Then
btn = FindWindowEx(hwnd, 0, "Button", "OK") 'find the OK button
If btn <> 0 Then ' button found
' activate the button on dialog first or it
' may not acknowledge a click msg on first try
SendMessage btn, WM_ACTIVATE, WA_ACTIVE, 0
' send button a click message
SendMessage btn, BM_CLICK, 0, 0
Else
MsgBox "button not found!"
End If
End If
IE.Visible = True 'make visible to ensure the prompt is gone...
End Sub
我正在尝试 运行 两个 Internet Explorer 实例来抓取 HTML。目标是为大多数功能提供一个全局 IE。但是，我需要一个用于特定目的（身份验证）的实例，一旦完成就会被销毁。
出现第二个 IE 实例的原因是网站的身份验证过程会抛出一个难以确认和关闭的 alert() Javascript 弹出窗口。在这种情况下，我目前正在终止 IE 的整个实例。
请注意，我一直在另一个 post 此处讨论弹出窗口：Internet Explorer readyState reverts from Complete to Interactive
一旦我使用它的 PID 终止了 IE 的第二个实例，它似乎也会影响 IE 的全局实例。当我 return 到 IE 的全局实例时，我得到： 运行-time error '462': The remote server machine does not exist or is unavailable.
要复制：
- 执行函数运行IE1（可以运行多次）
- 执行函数运行IE2（可以运行多次）
- 执行函数运行IE1得到错误
模块代码：
Option Explicit
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal lHWnd As Long, _
ByRef lProcessId As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Public ie_browser As New InternetExplorer
Sub runIE1()
Debug.Print "--- runIE1 ---"
Debug.Print "ie_browser PID: "; ie_browser.hwnd
With ie_browser
.Navigate "http://127.0.0.1/good.html"
.Silent = True
.Visible = False
End With
Debug.Print "ie_browser1 Navigated..."
Do Until ie_browser.readyState = 4: DoEvents: Loop
Do Until ie_browser.Busy = False: DoEvents: Loop
Debug.Print "ie_browser should have parsed and rendered the page at this time"
Debug.Print "--- runIE1 ---"
End Sub
Sub runIE2()
Debug.Print "--- runIE2 ---"
Dim ie_browser2_hwnd As Long
Dim ie_browser2 As InternetExplorer
Set ie_browser2 = CreateObject("InternetExplorer.Application")
Debug.Print "ie_browser2 PID: "; ie_browser2.hwnd
With ie_browser2
.Navigate "http://127.0.0.1:9000/ftw/bad.html"
.Silent = True
.Visible = False
End With
Debug.Print "ie_browser2 Navigated..."
Debug.Print "ie_browser2 Start wait..."
Call waitForIE(ie_browser2)
Debug.Print "ie_browser2 End wait..."
'close if found
If Not ie_browser2 Is Nothing Then
Debug.Print "ie_browser2 not null..."
ie_browser2_hwnd = ie_browser2.hwnd
ie_browser2.Quit
Set ie_browser2 = Nothing
Debug.Print "ie_browser2 quit, set to null"
Call KillHwndProcess(ie_browser2_hwnd)
Debug.Print "terminated ie_browser2 PID: " & ie_browser2_hwnd
End If
Debug.Print "--- runIE2 ---"
End Sub
Public Sub waitForIE(i As InternetExplorer)
Dim ie_hwnd As Long
'Ensure browser has completed
Do While i.readyState = 4: DoEvents: Loop
'Sleep to ensure that we let the readyState to flip back
Sleep (250)
'popup occurred!
If i.readyState = 3 Then
Debug.Print "waitForIE - Popup occurred"
ie_hwnd = i.hwnd
Debug.Print "waitForIE - ie PID: " & ie_hwnd
i.Quit
Set i = Nothing
Debug.Print "waitForIE - quit IE, set to nothing..."
Call KillHwndProcess(ie_hwnd)
Debug.Print "waitForIE - Terminated IE process: " & ie_hwnd
Else
Do Until i.readyState = 4: DoEvents: Loop
Do Until i.Busy = False: DoEvents: Loop
Debug.Print "Browser should have parsed and rendered the page at this time"
Debug.Print "IE State: " & i.readyState & " IE busy: " & i.Busy
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : KillHwndProcess
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Terminate a process based on its Windows Handle (Hwnd)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' lHWnd : Windows Handle number (Hwnd)
'
' Usage:
' ~~~~~~
' Call KillHwndProcess(Application.hWnd)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2018-09-09 Initial Website Release
'---------------------------------------------------------------------------------------
Public Function KillHwndProcess(lHWnd As Long)
' https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-process
On Error GoTo Error_Handler
Dim oWMI As Object
Dim oProcesses As Object
Dim oProcess As Object
Dim lProcessId As Long
Dim sSQL As String
Const sComputer = "."
'Retrieve the ProcessId associated with the specified Hwnd
Call GetWindowThreadProcessId(lHWnd, lProcessId)
'Iterate through the matching ProcessId processes and terminate
' each one.
Set oWMI = GetObject("winmgmts:\" & sComputer & "\root\cimv2")
sSQL = "SELECT * FROM Win32_Process WHERE ProcessId=" & lProcessId
Set oProcesses = oWMI.ExecQuery(sSQL)
For Each oProcess In oProcesses
oProcess.Terminate
Next
Error_Handler_Exit:
On Error Resume Next
If Not oProcess Is Nothing Then Set oProcess = Nothing
If Not oProcesses Is Nothing Then Set oProcesses = Nothing
If Not oWMI Is Nothing Then Set oWMI = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: KillHwndProcess" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
立即输出window:
ie_browser PID: 593524
--- runIE1 ---
ie_browser PID: 593524
ie_browser Navigated...
ie_browser should have parsed and rendered the page at this time
--- runIE1 ---
--- runIE1 ---
ie_browser PID: 593524
ie_browser Navigated...
ie_browser should have parsed and rendered the page at this time
--- runIE1 ---
--- runIE1 ---
ie_browser PID: 593524
ie_browser Navigated...
ie_browser should have parsed and rendered the page at this time
--- runIE1 ---
--- runIE2 ---
ie_browser2 PID: 397928
ie_browser2 Navigated...
ie_browser2 Start wait...
waitForIE - Popup occurred
waitForIE - ie PID: 397928
waitForIE - quit IE, set to nothing...
waitForIE - Terminated IE process: 397928
ie_browser2 End wait...
--- runIE2 ---
--- runIE1 ---
文件 bad.html（删除 good.html 的警报）
<html>
<head>
<title>Bad file</title>
<meta http-equiv="X-UA-Compatible" content="IE=edge" />
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>
<body>
Bad!
<script type="text/javascript">
alert("Hello World!");
</script>
</body>
</html>
在快速测试中，这种 Windows API 方法似乎对我有用：
Option Explicit
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 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 As Integer = &HF5
Private Const WM_ACTIVATE As Integer = &H6
Private Const WA_ACTIVE As Integer = 1
Sub TestAPI()
Dim IE As InternetExplorer, el, hwnd As Long, btn As Long
Set IE = New InternetExplorerMedium
'open a test document with an auto-alert (using your example)
With IE
.Visible = False
.navigate "http://localhost/testpages/Bad.html"
End With
Application.Wait Now + TimeSerial(0, 0, 3)
'find the alert
hwnd = FindWindow("#32770", "Message from webpage")
If hwnd <> 0 Then
btn = FindWindowEx(hwnd, 0, "Button", "OK") 'find the OK button
If btn <> 0 Then ' button found
' activate the button on dialog first or it
' may not acknowledge a click msg on first try
SendMessage btn, WM_ACTIVATE, WA_ACTIVE, 0
' send button a click message
SendMessage btn, BM_CLICK, 0, 0
Else
MsgBox "button not found!"
End If
End If
IE.Visible = True 'make visible to ensure the prompt is gone...
End Sub