スクリプト置き場

Option Explicit
Dim ObjArgDict, ObjEnableDict, dbg, ObjIE, IsTerminate
Set ObjArgDict = CreateObject("Scripting.Dictionary")
Set ObjEnableDict = CreateObject("Scripting.Dictionary")

set dbg = new DebugClass
dbg.SetDebugType(DEBUG_IE)
dbg.DebugStart

' イベントダンプ出力の有効・無効設定
With ObjEnableDict
    .Add "BeforeNavigate2",            True
    .Add "ClientToHostWindow",         False
    .Add "CommandStateChange",         False
    .Add "DocumentComplete",           False
    .Add "DownloadBegin",              True
    .Add "DownloadComplete",           True
    .Add "FileDownload",               False
    .Add "NavigateComplete2",          True
    .Add "NavigateError",              False
    .Add "NewWindow2",                 False
    .Add "OnFullScreen",               False
    .Add "OnMenuBar",                  False
    .Add "OnQuit",                     False
    .Add "OnStatusBar",                False
    .Add "OnTheaterMode",              False
    .Add "OnToolBar",                  False
    .Add "OnVisible",                  True
    .Add "PrintTemplateInstantiation", False
    .Add "PrintTemplateTeardown",      False
    .Add "PrivacyImpactedStateChange", False
    .Add "ProgressChange",             False
    .Add "PropertyChange",             False
    .Add "SetSecureLockIcon",          False
    .Add "StatusTextChange",           False
    .Add "TitleChange",                True
    .Add "UpdatePageStatus",           False
    .Add "WindowClosing",              False
    .Add "WindowSetHeight",            False
    .Add "WindowSetLeft",              False
    .Add "WindowSetResizable",         False
    .Add "WindowSetTop",               False
    .Add "WindowSetWidth",             False
End With

' IEイベントで使用される関数名と引数名を格納
With ObjArgDict
    .Add "BeforeNavigate2", Array("pDisp", "URL", "Flags", "TargetFrameName", "PostData", "Headers", "Cancel")
    .Add "ClientToHostWindow", Array("CX", "CY")
    .Add "CommandStateChange", Array("Command", "Enable")
    .Add "DocumentComplete", Array("pDisp", "URL")
    .Add "DownloadBegin", Array("")
    .Add "DownloadComplete", Array("")
    .Add "FileDownload", Array("Cancel")
    .Add "NavigateComplete2", Array("pDisp", "URL")
    .Add "NavigateError", Array("pDisp", "URL", "Frame", "StatusCode", "Cancel")
    .Add "NewWindow2", Array("ppDisp", "Cancel")
    .Add "OnFullScreen", Array("FullScreen")
    .Add "OnMenuBar", Array("MenuBar")
    .Add "OnQuit", Array("")
    .Add "OnStatusBar", Array("StatusBar")
    .Add "OnTheaterMode", Array("TheaterMode")
    .Add "OnToolBar", Array("ToolBar")
    .Add "OnVisible", Array("Visible")
    .Add "PrintTemplateInstantiation", Array("pDisp")
    .Add "PrintTemplateTeardown", Array("pDisp")
    .Add "PrivacyImpactedStateChange", Array("bImpacted")
    .Add "ProgressChange", Array("Progress", "ProgressMax")
    .Add "PropertyChange", Array("szProperty")
    .Add "SetSecureLockIcon", Array("SecureLockIcon")
    .Add "StatusTextChange", Array("Text")
    .Add "TitleChange", Array("Text")
    .Add "UpdatePageStatus", Array("pDisp", "nPage", "fDone")
    .Add "WindowClosing", Array("IsChildWindow", "Cancel")
    .Add "WindowSetHeight", Array("Height")
    .Add "WindowSetLeft", Array("Left")
    .Add "WindowSetResizable", Array("Resizable")
    .Add "WindowSetTop", Array("Top")
    .Add "WindowSetWidth", Array("Width")
End With

' IEオブジェクトを取得
Set ObjIE = WScript.CreateObject("InternetExplorer.Application", "ObjIE_")
ObjIE.GoHome

' 起動終了まで待機
Do While(ObjIE.Busy)
    WScript.Sleep 50
Loop

ObjIE.Visible = true

' IE終了まで待機
Do While(Not IsTerminate)
    WScript.Sleep 1000
Loop

' IEオブジェクトのイベント一覧

Sub ObjIE_BeforeNavigate2(ByVal pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel)
    Dump "BeforeNavigate2", Array(pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel)
End Sub

Sub ObjIE_ClientToHostWindow(CX, CY)
    Dump "ClientToHostWindow", Array(CX, CY)
End Sub

Sub objIE_CommandStateChange(ByVal Command, ByVal Enable)
    'Dump "CommandStateChange", Array(Command, Enable)
End Sub

Sub objIE_DocumentComplete(ByVal pDisp, URL)
    Dump "DocumentComplete", Array(pDisp, URL)
End Sub

Sub objIE_DownloadBegin()
    Dump "DownloadBegin", vbNullString
End Sub

Sub objIE_DownloadComplete()
    Dump "DownloadComplete", vbNullString
End Sub

Sub objIE_FileDownload(Cancel)
    Dump "FileDownload", Array(Cancel)
End Sub

Sub objIE_NavigateComplete2(ByVal pDisp, URL)
    Dump "NavigateComplete2", Array(pDisp, URL)
End Sub

Sub objIE_NavigateError(ByVal pDisp, URL, Frame, StatusCode, Cancel)
    Dump "NavigateError", Array(pDisp, URL, Frame, StatusCode, Cancel)
End Sub

Sub objIE_NewWindow2(ppDisp, Cancel)
    Dump "NewWindow2", Array(ppDisp, Cancel)
End Sub

Sub objIE_OnFullScreen(ByVal FullScreen)
    Dump "OnFullScreen", Array(FullScreen)
End Sub

Sub objIE_OnMenuBar(ByVal MenuBar)
    Dump "OnMenuBar", Array(MenuBar)
End Sub

Sub objIE_OnQuit()
    Dump "OnMenOnQuituBar", vbNullString
    IsTerminate = True
End Sub

Sub objIE_OnStatusBar(ByVal StatusBar)
    Dump "OnStatusBar", Array(StatusBar)
End Sub

Sub objIE_OnTheaterMode(ByVal TheaterMode)
    Dump "OnTheaterMode", Array(TheaterMode)
End Sub

Sub objIE_OnToolBar(ByVal ToolBar)
    Dump "OnToolBar", Array(ToolBar)
End Sub

Sub objIE_OnVisible(ByVal Visible)
    Dump "OnVisible", Array(Visible)
End Sub

Sub objIE_PrintTemplateInstantiation(ByVal pDisp)
    Dump "PrintTemplateInstantiation", Array(pDisp)
End Sub

Sub objIE_PrintTemplateTeardown(ByVal pDisp)
    Dump "PrintTemplateTeardown", Array(pDisp)
End Sub

Sub objIE_PrivacyImpactedStateChange(ByVal bImpacted)
    Dump "PrivacyImpactedStateChange", Array(bImpacted)
End Sub

Sub objIE_ProgressChange(ByVal Progress, ByVal ProgressMax)
    Dump "ProgressChange", Array(Progress, ProgressMax)
End Sub

Sub objIE_PropertyChange(ByVal szProperty)
    Dump "PropertyChange", Array(szProperty)
End Sub

Sub objIE_SetSecureLockIcon(ByVal SecureLockIcon)
    Dump "SetSecureLockIcon", Array(SecureLockIcon)
End Sub

Sub objIE_StatusTextChange(ByVal Text)
    Dump "StatusTextChange", Array(Text)
End Sub

Sub objIE_TitleChange(ByVal Text)
    Dump "TitleChange", Array(Text)
End Sub

Sub objIE_UpdatePageStatus(ByVal pDisp, nPage, fDone)
    Dump "UpdatePageStatus", Array(pDisp, nPage, fDone)
End Sub

Sub objIE_WindowClosing(ByVal IsChildWindow, Cancel)
    Dump "WindowClosing", Array(IsChildWindow, Cancel)
End Sub

Sub objIE_WindowSetHeight(ByVal Height)
    Dump "WindowSetHeight", Array(Height)
End Sub

Sub objIE_WindowSetLeft(ByVal Left)
    Dump "WindowSetLeft", Array(Left)
End Sub

Sub objIE_WindowSetResizable(ByVal Resizable)
    Dump "WindowSetResizable", Array(Resizable)
End Sub

Sub objIE_WindowSetTop(ByVal Top)
    Dump "WindowSetTop", Array(Top)
End Sub

Sub objIE_WindowSetWidth(ByVal Width)
    Dump "WindowSetWidth", Array(Width)
End Sub

' IEオブジェクトのイベントの内容をダンプ出力
Sub Dump(FuncName, ArgVals)
    Dim ArgNames, IsEnable, msg, index
    ArgNames = ObjArgDict.Item(FuncName)
    IsEnable = ObjEnableDict.Item(FuncName)
    
    ' イベントダンプが無効の場合は処理を行わない
    If (Not IsEnable) Then
        Exit Sub
    End If
    
    ' 引数の有無によりメッセージの設定処理を変更
    if (ArgNames(0) <> vbNullString) Then
        
        msg = "【" & FuncName & "】" & vbcr & vblf
        for index=0 to UBound(ArgNames)
            msg = msg & "　　　" & ArgNames(index) & " ： " & GetStringVal(ArgVals(index)) & vbcr & vblf
        next
    
    Else
    
        msg = "【" & FuncName & "】" & vbcr & vblf
    
    End If
    
    ' ダンプ出力を行う
    dbg.DebugOut msg
    
End Sub

Function GetStringVal(Val)

Select Case TypeName(Val)
    
        Case "String"
            GetStringVal = """" & Val & """"
            
        Case "Long"
            GetStringVal = CStr(Val)
    
        Case "Boolean"
            GetStringVal = CStr(Val)
    
        Case "Empty"
            GetStringVal = "Empty"
    
        Case "Nothing"
            GetStringVal = "Nothing"
    
        Case "IWebBrowser2"
            GetStringVal = "[IWebBrowser2]" & Val.LocationName
            
        Case Else
            MsgBox "未定義のType：" & Typename(Val)
            GetStringVal = CStr(Val)
    
    End Select

End Function

'###########################################################
'                        デバッグクラス
' [クラス名]
'    DebugClass
'
' [関数]
'  ○SetDebugType(type as Integer)
'      ・機能
'                デバッグ情報の出力先を指定する。
'      ・引数
'          type：以下の2つから選択。
'                DEBUG_FILE → デバッグ情報をファイルに出力
'                DEBUG_IE   → デバッグ情報をIEに出力
'      ・戻り値
'          True：成功
'         False：失敗
'
'  ○SetFileName(path as String)
'      ・機能
'                デバッグ情報出力先がファイルの場合に、出力先となるファイル名を指定する。
'                デフォルト値として、"debug.txt"がスクリプトと同じディレクトリに作成される。
'      ・引数
'          path：出力先ファイルのフルパスを指定する。
'      ・戻り値
'          True：成功
'         False：失敗
'
'  ○DebugStart()
'      ・機能
'                デバッグ開始のフラグを立てる。
'                デバッグ開始のフラグが立っていない場合はDebugOutコール時に何も処理を行わない。
'      ・戻り値
'          True：成功
'         False：失敗
'
'  ○DebugStop()
'      ・機能
'                デバッグ開始のフラグを下ろす。
'                デバッグ開始のフラグが立っていない場合はDebugOutコール時に何も処理を行わない。
'                現在、必ずTrueを返す。
'      ・戻り値
'          True：成功
'         False：失敗
'
'  ○DebugOut(content as String)
'      ・機能
'                デバッグ情報出力先に対して指定したデバッグ情報をアペンドする。
'                デバッグ情報の前には出力時刻が表示される。
'      ・引数
'       content：デバッグ情報の文字列
'      ・戻り値
'          True：成功
'         False：失敗
'
' [制限事項]
'      ・出力先がIEの時、IEウィンドウを閉じた後にIEに出力しようとするとエラーとなる。
'      ・ファイル出力先のディレクトリがない場合などのエラー処理は行っていない。
'
'
Const DebugFile = "Debug.txt"
Const DEBUG_FILE = 0
Const DEBUG_IE   = 1

Class DebugClass

Private ObjDebugIE, ObjDebugFile, DebugType, IsDebugStart, DebugFileName
    
    '----------------------------------------------------
    ' コンストラクタ
    Private Sub Class_Initialize
        Dim CurrentDir
        DebugType = vbNullString
        IsDebugStart = False
        CurrentDir = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString)
        DebugFileName = CurrentDir & DebugFile
    End Sub
    
    '----------------------------------------------------
    ' デストラクタ
    Private Sub Class_Terminate
        
        ' ファイル出力の場合は開いているファイルをクローズ
        If (DebugType = DEBUG_FILE) Then
            ObjDebugFile.close
        End If
        
    End Sub
    
    '----------------------------------------------------
    ' デバッグの種類を設定
    Public Function SetDebugType(strType)
        
        ' デバッグ実行中は種類変更は無効
        If (IsDebugStart) Then
            SetDebugType = False
            Exit Function
        End If
        
        ' 現在対応しているのはIEとFileのみ
        If ((strType = DEBUG_FILE) Or (strType = DEBUG_IE)) Then
            DebugType = strType
            SetDebugType = True
        Else
            SetDebugType = False
        End If
    
    End Function
    
    '----------------------------------------------------
    ' 出力ファイル名を設定
    Function SetFileName(path)
        DebugFileName = path
        ChangeObjFile
        SetFileName = true
    End Function
    
    '----------------------------------------------------
    ' 処理を開始する
    Function DebugStart
    
        ' 既に開始されている場合は処理を行わない
        If (IsDebugStart) Then
            DebugStart = True
            Exit Function
        End If
    
        ' デバッグの種類が設定されていない場合はFALSEを返す
        If ( DebugType = vbNullString) Then
            IsDebugStart = False
            DebugStart = False
            Exit Function
        End If
        
        If (DebugType = DEBUG_IE) Then
        
            ' 既にIEが作成されている場合は処理を行わない
            If (Not IsEmpty(ObjDebugIE)) Then
                IsDebugStart = True
                DebugStart = True
                Exit Function
            End If
            
            ' IEオブジェクトを作成
            Set ObjDebugIE = CreateObject("InternetExplorer.Application")

' IEオブジェクトのステータスを設定
            With ObjDebugIE
                .height     = 400
                .width      = 300
                .Left       = 300
                .Top        = 300
                .AddressBar = false
                .MenuBar    = false
                .Resizable  = true
                .StatusBar  = false
                .ToolBar    = false
                .Visible    = true
            End With
        
            ObjDebugIE.Navigate "about:blank"
            
            ' 起動終了まで待機
            Do While(ObjDebugIE.Busy)
                WScript.Sleep 100
            Loop
            
            ObjDebugIE.Document.Title = "デバッグ出力"
            
        ElseIf (DebugType = DEBUG_FILE) Then
        
            ' ObjDebugFileを作成
            ChangeObjFile
            
        End If
        
        IsDebugStart = True
        DebugStart = True

End Function
    
    '----------------------------------------------------
    ' 処理を停止する
    Function DebugStop
        IsDebugStart = False
        DebugStop = True
    End Function
    
    '----------------------------------------------------
    ' デバッグ出力を行う
    Function DebugOut(content)
    
        DebugOut = False
        
        ' デバッグが開始されていない場合は処理を行わない
        If (Not IsDebugStart) Then
            Exit Function
        End If
        
        
        ' デバッグの種類に応じて出力先を変える
        If (DebugType = DEBUG_IE) Then
        
            content = Replace (content, vbCrLf, "<BR>")
            ObjDebugIE.Document.Body.InnerHTML = ObjDebugIE.Document.Body.InnerHTML & "[" & Date & " " & Time & "]" & "<BR>" & content & "<BR>"
            DebugOut = True
        
        ElseIf (DebugType = DEBUG_FILE) Then
        
            ObjDebugFile.Write "[" & Date & " " & Time & "]" & vbCrLf & content & vbCrLf
            DebugOut = True
        
        End If
    
    End Function
    
    '----------------------------------------------------
    ' ObjDebugFileを変更する
    Private Function ChangeObjFile
    
        ' 既に開いているファイルを閉じる
        If (Not IsEmpty(ObjDebugFile)) Then
            ObjDebugFile.close
        End If
        
        Dim fso
        ' ファイルシステムオブジェクトを作成
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        '追記書き込みでファイルを開く
        Set ObjDebugFile = fso.OpenTextFile(DebugFileName, 8, True)
    
    End Function

End Class
'###########################################################

IEイベントダンプ

スクリーンショット