Dim oWB, oWBm
Dim oDOCm
Dim oWINm
Dim Path
Path = WScript.ScriptFullName
Path = Left(path, InstrRev(path, "."))
Path = path & "html"
Set oWBm = WScript.CreateObject("InternetExplorer.Application", "WB2_")
oWBm.left = 0
oWBm.top = 0
oWBm.width = 700
oWBm.height = 500
oWBm.menubar = FALSE
oWBm.toolbar = FALSE
oWBm.statusbar = FALSE
oWBm.addressbar = FALSE
oWBm.Visible = TRUE
oWBm.Navigate2 "about:blank"
MsgBox "起動中です。" & vbCR & vbCR & "ＯＫをクリックすると終了します。", 0, "ＩＥイベントモニタ Ver.0.01"
'////////////////////////////////////////////////////////
Sub WB2_DocumentComplete(obj, str)
If (obj Is oWBm) And IsEmpty(oDOCm) Then
Set oDOCm = oWBm.Document
If TypeName(oDOCm) = "HTMLDocument" Then
oDOCm.WriteLn ""
oDOCm.WriteLn ""
oDOCm.WriteLn "ＩＥイベントモニタ"
oDOCm.WriteLn ""
oDOCm.WriteLn ""
oDOCm.WriteLn ""
oDOCm.WriteLn ""
oDOCm.WriteLn ""
oDOCm.WriteLn ""
Set oWINm = oDOCm.ParentWindow
Set oWB = WScript.CreateObject("InternetExplorer.Application", "WB_")
oWB.Visible = TRUE
oWB.Navigate2 "about:blank"
End If
End If
End Sub
Sub PutStr(strEvent, strArgv)
oDOCm.All.Space.OuterHTML = "" & strEvent & " " & strArgv & "
"
oWINm.ScrollBy 0, 100
End Sub
'////////////////////////////////////////////////////////
Sub WB_BeforeNavigate2(pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel)
PutStr "BeforeNavigate2", "(1)" & pDisp & " (2)" & URL & " (3)" & Flags & " (4)" & TargetFrameName & " (5)*** (6)" & Headers & " (7)" & Cancel
End Sub
Sub WB_CommandStateChange(Command, Enable)
PutStr "CommandStateChange", "(1)" & Command & " (2)" & Enable
End Sub
Sub WB_DocumentComplete(pDisp, URL)
PutStr "DocumentComplete", "(1)" & pDisp & " (2)" & URL
End Sub
Sub WB_DownloadBegin
PutStr "DownloadBegin", ""
End Sub
Sub WB_DownloadComplete
PutStr "DownloadComplete", ""
End Sub
Sub WB_DragDrop(Source, X, Y)
PutStr "DragDrop", "(1)" & Source & " (2)" & X & " (3)" & Y
End Sub
Sub WB_DragOver(Source, X, Y, State)
PutStr "DragOver", "(1)" & Source & " (2)" & X & " (3)" & Y & " 4:" & State
End Sub
Sub WB_GotFocus
PutStr "GotFocus", ""
End Sub
Sub WB_LostFocus
PutStr "LostFocus", ""
End Sub
Sub WB_NavigateComplete2(pDisp, URL)
PutStr "NavigateComplete2", "(1)" & pDisp & " (2)" & URL
End Sub
Sub WB_NewWindow2(ppDisp, Cancel)
PutStr "NewWindow2", "(1)***" & " (2)" & Cancel
End Sub
Sub WB_OnFullScreen(FullScreen)
PutStr "OnFullScreen", "(1)" & FullScreen
End Sub
Sub WB_OnMenuBar(MenuBar)
PutStr "OnMenuBar", "(1)" & MenuBar
End Sub
Sub WB_OnQuit
PutStr "OnQuit", ""
End Sub
Sub WB_OnStatusBar(StatusBar)
PutStr "OnStatusBar", "(1)" & StatusBar
End Sub
Sub WB_OnTheaterMode(TheaterMode)
PutStr "OnTheaterMode", "(1)" & TheaterMode
End Sub
Sub WB_OnToolBar(ToolBar)
PutStr "OnToolBar", "(1)" & ToolBar
End Sub
Sub WB_OnVisible(Visible)
PutStr "OnVisible", "(1)" & Visible
End Sub
Sub WB_ProgressChange(Progress, ProgressMax)
PutStr "ProgressChange", "(1)" & Progress & " (2)" & ProgressMax
End Sub
Sub WB_PropertyChange(szProperty)
PutStr "PropertyChange", "(1)" & szProperty
End Sub
Sub WB_StatusTextChange(Text)
PutStr "StatusTextChange", "(1)" & Text
End Sub
Sub WB_TitleChange(Text)
PutStr "TitleChange", "(1)" & Text
End Sub
'////////////////////////////////////////////////////////