运行两个Internet Explorer实例

Question

我正试图运行两个InternetExplorer实例来抓取HTML。目标是为大多数功能提供一个全局IE。然而，我需要一个用于特定目的(身份验证(的实例，一旦完成，它就会被销毁。

第二个IE实例的原因是由于网站的身份验证过程，该过程将抛出一个很难确认和关闭的alert((Javascript弹出窗口。在这种情况下，我目前正在终止IE的整个实例。

注意到我在这里的另一篇文章中讨论了弹出窗口：Internet Explorer readyState从Complete恢复为Interactive

一旦我使用其PID终止IE的第二个实例，它似乎也会影响IE的全局实例。当我返回到IE的全局示例时，我得到：运行时错误"462"：远程服务器机器不存在或不可用。

复制：

1. 执行函数runIE1(可以多次运行(
2. 执行函数runIE2(可以多次运行(
3. 执行函数runIE1以获取错误

模块代码：

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://learn.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 & "rootcimv2")
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

立即窗口输出：

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(删除警报for 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>

Answer 1

在快速测试中，这种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