ライブラリ

fIE_Quit (IEを確実に殺す方法)

IEのゴースト現象について、
自分の経験を基に不明なデバッグを減らすIEの閉じ方を
需要ありそうなので記載しておきます。

IE起動→スクレイピング→IE閉じる
の繰返しでたまにIE起動時でNGになることがあります。
原因は
閉じた後も裏でIEのプロセスが暫く残る事がある
ということが判明(・・;)
※他の何かが原因のケースがあるかもですが、自分の経験として。

そして対応方法として
IE.Quitの前にプロセスIDを取得しておき、
Quit後にプロセスを直に殺して対応しました。

WinAPIが多くなるのが難点です(^_^;)



使う【WinAPI】はこんな感じです~

GetWindowThreadProcessId
ウィンドウハンドル(IE.hWnd)からプロセスIDを取得

IsWindow
ウィンドウが生きてるか判定 ※IEが閉じるまで念の為に待つ用

OpenProcess
プロセスIDからプロセスのハンドルを取得

TerminateProcess
プロセスを殺す

※他にもっと簡単に解決できる方法があるかもなので、あくまで1つのケースとして
-------------------<以下、VBAソース>----------------------------------------------------------

Option Explicit
Option Private Module

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long

Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As E_WinAPI_dwDesiredAccess_DesiredAccess, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As LongPtr
Private Enum E_WinAPI_dwDesiredAccess_DesiredAccess
'    STANDARD_RIGHTS_REQUIRED = &HF0000  'アクセスフラグ、あるいは次のフラグの 1 つまたは複数を指定できる。
'    PROCESS_ALL_ACCESS = &H1F0FFF       '利用可能な範囲で、プロセスオブジェクトに対するすべてのアクセス権を指定する。
'    PROCESS_CREATE_PROCESS = &H80       '内部で使う。
'    PROCESS_CREATE_THREAD = &H2         'プロセス内にスレッドを作成するために、CreateRemoteThread 関数がこのプロセスのハンドルを使うことを認める。
'    PROCESS_DUP_HANDLE = &H40           'ハンドルを複製するために、DuplicateHandle 関数が複製元または複製先としてこのプロセスのハンドルを使うことを認める。
    PROCESS_QUERY_INFORMATION = &H400   'プロセスオブジェクトから情報を読み取るために、GetExitCodeProcess 関数と GetPriorityClass関数がこのプロセスのハンドルを使うことを認める。
'    PROCESS_SET_QUOTA = &H100           'メモリの上限(クォータ)を設定するために、AssignProcessToJobObject 関数と SetProcessWorkingSetSize 関数がこのプロセスのハンドルを使うことを認める。
'    PROCESS_SET_INFORMATION = &H200     'このプロセスの優先順位クラスを設定するために、SetPriorityClass 関数がこのプロセスのハンドルを使うことを認める。
'    PROCESS_TERMINATE = &H1             'このプロセスを終了するために、TerminateProcess 関数がこのプロセスのハンドルを使うことを認める。
'    PROCESS_VM_OPERATION = &H8          'このプロセスの仮想メモリを変更するために、VirtualProtectEx 関数、または WriteProcessMemory 関数がこのプロセスのハンドルを使うことを認める。
    PROCESS_VM_READ = &H10              'このプロセスの仮想メモリの内容を読み取るために、ReadProcessMemory 関数がこのプロセスのハンドルを使うことを認める。
'    PROCESS_VM_WRITE = &H20             'このプロセスの仮想メモリへの書き込みを行うために、WriteProcessMemory 関数がこのプロセスのハンドルを使うことを認める。
'    Synchronize = &H100000              'Windows NT/2000:このプロセスが終了するのを待つために、wait functions(待機関数)がこのプロセスのハンドルを使うことを認める。
End Enum

Private Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long

Private Function prTest()
    
    Dim IE  As InternetExplorer
    '※Explorer等,他の何かが取得されるケースがあるのでGetObjectは使わない
'    Set IE = GetObject("", "InternetExplorer.Application")
'    If IE Is Nothing Then Exit Function
    
    '表示されてるIEを全て取得
    Dim Dic As Scripting.Dictionary
    Set Dic = fIE_Dic
    If Dic.Count = 0 Then Exit Function
    
    '全てのIEを閉じる
    Dim Key As Variant
    For Each Key In Dic.Keys
        Set IE = Dic.Item(Key)
        Call fIE_Quit_Sample(IE)
    Next
    
End Function

Private Function fIE_Quit_Sample(IE As InternetExplorer)
    
    'ウィンドウハンドル、プロセスIDを取得しておく
    Dim hWnd    As LongPtr
    Dim PID     As Long
    On Error Resume Next
    hWnd = IE.hWnd
    Call GetWindowThreadProcessId(hWnd, PID)
    On Error GoTo 0
    If hWnd = 0 Then Exit Function
    
    'IEのQuitで予期せぬエラーが発生するのを防止
    On Error Resume Next
    IE.Quit
    On Error GoTo 0
    
    'IEのウィンドウがQuitで閉じるまで念の為に待つ
    Dim i   As Long
    For i = 1 To 1000   '※適宜調整
        If IsWindow(hWnd) = 0 Then Exit For
        Call Sleep(100) '※適宜調整
        DoEvents        '※適宜調整
    Next
    
    'プロセスハンドルを取得
    Dim hProcess    As LongPtr
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, PID)
    If hProcess = 0 Then Exit Function
    
    'プロセス終了
    Call TerminateProcess(hProcess, 0)
    
    '解放しておく
    Set IE = Nothing
    
End Function

Private Function fIE_Dic(Optional Visible As Boolean = True) As Scripting.Dictionary
    
    Dim Dic As Scripting.Dictionary
    Set Dic = New Scripting.Dictionary
    
    '下記でも同じだが、ShellWindowsで
'    Dim sh  As Shell32.Shell
'    Set sh = New Shell32.Shell
'    For Each sh.Windows
    
    'IE,Explorer系のコレクションオブジェクトを生成
    '※生成時にコレクション済
    Dim Shell   As ShellWindows
    Set Shell = New ShellWindows
    
    '※権限の異なるIE等が起動されていると、ForEachだとデバッグ発生となるのでForIで対応
    Dim i   As Long
    For i = 1 To Shell.Count
        
        On Error Resume Next
        Dim Win As WebBrowser
        Set Win = Nothing
        Set Win = Shell.Item(i)
        On Error GoTo 0
        
        With Win
            If fIE_IsIE(Win) = True Then
                If .Visible = Visible Then
                    Set Dic.Item(CStr(.hWnd)) = Win 'LongPtr対策でCStr
                End If
            End If
        End With
        
    Next
    
    Set fIE_Dic = Dic
    
End Function

Private Function fIE_IsIE(WebBrowser As WebBrowser) As Boolean
    
    With WebBrowser
        
        Dim Name    As String
        On Error Resume Next
        Name = Replace(.FullName, .Path, "")
        On Error GoTo 0
        
        fIE_IsIE = (LCase(Name) = LCase("iexplore.exe"))
        
    End With
    
End Function
 

IE   2021/01/17   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください