簡易イミディエイトウィンドウ

Option Explicit

Const SCRIPT_LANG    = "VBScript"
Const SCRIPT_IE      = "ie"
Const SCRIPT_WSCRIPT = "WScript"
Const SCRIPT_DEBUG   = "Debug"
Const INI_WIDTH      = 300
Const INI_HEIGHT     = 400

Dim IsAlive, Ret, ObjScript,  ObjTargetIE, ObjDebug, ObjIE, ObjTextResult, ObjTextInput, ObjImputCaption
Dim ObjLF, ObjLF2, ObjLF3, ObjLF4, ObjLF5, ObjSpanSpace, ObjSpanSpace2, ObjButtonRun, ObjButtonRefresh, ObjButtonClear
IsAlive = True

' デバッグクラスの作成
Set ObjDebug = New ImmidiateDebug

' 調査対象のIEを取得
Ret = GetSelectedIEObject("調査するIEを選択してください", ObjTargetIE)
If (Ret = RETURN_NO_IE) Then
   MsgBox "IEが見つかりませんでした"
   WScript.Quit
ElseIf (Ret = RETURN_CANCEL) Then
   MsgBox "選択がキャンセルされました"
   WScript.Quit
End If

' スクリプトコントロールを作成
Set ObjScript = CreateObject("MSScriptControl.ScriptControl.1")
With ObjScript
    .AllowUI       = True
    .Language      = SCRIPT_LANG
    .UseSafeSubset = True
    .AddObject SCRIPT_IE,      ObjTargetIE
    .AddObject SCRIPT_WSCRIPT, WScript
    .AddObject SCRIPT_DEBUG,   ObjDebug
End With

' 操作する画面をIEで作成
Set ObjIE = WScript.CreateObject("InternetExplorer.Application", "Immidiate_")
With ObjIE
    .Navigate "about:blank"
    .AddressBar = false
    .MenuBar    = false
    .Resizable  = true
    .StatusBar  = false
    .ToolBar    = false
    .Width      = INI_WIDTH
    .Height     = INI_HEIGHT
    .Document.Title      = "簡易イミディエイトウィンドウ"
End With

Do While(ObjIE.Busy)
    WScript.Sleep 100
Loop

' IEオブジェクトにテキストを追加
ObjIE.Document.Body.insertAdjacentText "afterBegin", "実行結果"

' テキストに改行を追加
Set ObjLF = ObjIE.Document.createElement("BR")
ObjIE.Document.Body.insertBefore(ObjLF)

' TEXTAREAタグを作成
Set ObjTextResult = ObjIE.Document.createElement ("textarea")
With ObjTextResult
    .style.width        = INI_WIDTH  - 50
    .style.height       = INI_HEIGHT - 200
    .readOnly = True
End With
ObjIE.Document.Body.insertBefore(ObjTextResult)

' TEXTAREAタグに改行を追加
Set ObjLF2 = ObjIE.Document.createElement("BR")
ObjIE.Document.Body.insertBefore(ObjLF2)

' スペース作成のためのSPANタグを追加
Set ObjSpanSpace = ObjIE.Document.createElement ("span")
ObjSpanSpace.style.width = INI_WIDTH - 100
ObjIE.Document.Body.insertBefore(ObjSpanSpace)

' クリアボタンを追加
Set ObjButtonClear = ObjIE.Document.createElement("button")
ObjButtonClear.Value = "クリア"
ObjIE.Document.Body.insertBefore(ObjButtonClear)
Set ObjButtonClear.onclick = GetRef("Click_Clear")

' ボタンの後に改行を追加
Set ObjLF3 = ObjIE.Document.createElement("BR")
ObjIE.Document.Body.insertBefore(ObjLF3)

' 入力テキストにタイトルを設定
Set ObjImputCaption = ObjIE.Document.createElement ("span")
ObjImputCaption.InnerText = "実行コード"
ObjIE.Document.Body.insertBefore(ObjImputCaption)

' 入力テキストに改行を追加
Set ObjLF4 = ObjIE.Document.createElement("BR")
ObjIE.Document.Body.insertBefore(ObjLF4)

' TEXTAREAタグを作成
Set ObjTextInput = ObjIE.Document.createElement ("textarea")
With ObjTextInput
    .style.width = INI_WIDTH  - 50
    .rows        = 2
    .readOnly    = False
End With
ObjIE.Document.Body.insertBefore(ObjTextInput)

' TEXTAREAタグに改行を追加
Set ObjLF5 = ObjIE.Document.createElement("BR")
ObjIE.Document.Body.insertBefore(ObjLF5)

' スペース作成のためのSPANタグを追加
Set ObjSpanSpace2 = ObjIE.Document.createElement ("span")
ObjSpanSpace2.style.width = INI_WIDTH - 140
ObjIE.Document.Body.insertBefore(ObjSpanSpace2)

' 実行ボタンを追加
Set ObjButtonRun = ObjIE.Document.createElement("button")
ObjButtonRun.Value = "実行"
ObjButtonRun.style.marginRight = 5
ObjIE.Document.Body.insertBefore(ObjButtonRun)
Set ObjButtonRun.onclick = GetRef("Click_Run")

' 更新ボタンを追加
Set ObjButtonRefresh = ObjIE.Document.createElement("button")
ObjButtonRefresh.Value = "更新"
ObjIE.Document.Body.insertBefore(ObjButtonRefresh)
Set ObjButtonRefresh.onclick = GetRef("Click_Rifresh")

ObjTextInput.focus
ObjIE.Visible = True

' 画面が閉じられるまで待機
Do While (IsAlive)
    WScript.Sleep 1000
Loop

WScript.Quit

Sub Click_Clear
    ObjTextResult.Value = vbNullString
    ObjTextInput.focus
End Sub

Sub Click_Rifresh
    Dim ieWidth, ieHeight
    ieWidth  = ObjIE.Width
    ieHeight = ObjIE.Height
    If ((ieWidth <= 45) OR (ieHeight <= 200)) Then
        MsgBox "ウィンドウの更新に失敗しました。"
    Else
        ObjTextResult.style.width  = ieWidth  - 50
        ObjTextResult.style.height = ieHeight - 200
        ObjSpanSpace.style.width   = ieWidth - 100
        ObjTextInput.style.width   = ieWidth  - 50
        ObjSpanSpace2.style.width  = ieWidth - 140
    End If
    ObjTextInput.focus
End Sub

Sub Click_Run
    Dim code, strRet, strSeparate
    code = ObjTextInput.Value
    ObjTextInput.Value = vbNullString
    
    ObjTextResult.Value = ObjTextResult.Value & code & vbCrLf
    
    ObjScript.ExecuteStatement ObjTextInput.Value
    If (left(code, 1) = "?") Then
        code = right(code, len(code) - 1)
        strRet = ObjScript.Eval(code)
        ObjTextResult.Value = ObjTextResult.Value & strRet & vbCrLf
    Else
        ObjScript.ExecuteStatement code
    End If
    
    strSeparate = Space(CInt((ObjIE.Width - 50) / 9))
    strSeparate = Replace(strSeparate, " ", "-")
    ObjTextResult.Value = ObjTextResult.Value & strSeparate & vbCrLf
    ObjTextResult.doScroll "pageDown"
    ObjTextInput.focus
End Sub

Sub Immidiate_OnQuit()
    IsAlive = False
End Sub

' Debug用クラス
Class ImmidiateDebug
    Public Sub Print(str)
        ObjTextResult.Value = ObjTextResult.Value & CStr(str) & vbCrLf
    End Sub
End Class

'###########################################################
'               選択されたIEオブジェクトを取得
' 関数
'    GetSelectedIEObject(Caption As String, obj As Object)
'
' 引数
'     Caption：選択ダイアログに表示するキャプション
'         obj：選択されたIEオブジェクトが格納されるオブジェクト
'
' 戻り値
'    選択状態を戻り値として返す。値は以下の通り。
'        RETURN_OK：正常に取得
'     RETURN_NO_IE：IEが存在しない
'    RETURN_CANCEL：IE選択をキャンセル
'
' 制限事項
'    SelectList、GetPropertyValと同じ

Const RETURN_OK     = 0
Const RETURN_NO_IE  = 1
Const RETURN_CANCEL = 2

Function GetSelectedIEObject(Caption, obj)

Dim ObjShell, ObjDict, ObjWnd, myList, index, SelectIndex

Set ObjShell=CreateObject("Shell.Application")
Set ObjDict = CreateObject("Scripting.Dictionary")

myList = vbNullString
index = 0

' IEオブジェクト一覧をカンマ区切りで取得
For Each ObjWnd In ObjShell.Windows
    If (typename(ObjWnd.Document) = "HTMLDocument") Then
        myList = myList & GetPropertyVal(ObjWnd.Document, "Title", "NoTitle") & "(" & ObjWnd.locationURL & "),"
        objDict.Add index, ObjWnd
        index = index + 1
    End If
Next

' IEオブジェクトがある場合は不要なカンマを削除、無い場合は終了
If (right(myList,1) = ",") Then
    myList = left(mylist, len(mylist)-1)
Else
    GetSelectedIEObject = RETURN_NO_IE
    Exit Function
End If

' 捜査対象のIEを選択
SelectIndex = SelectList(split(myList,","), TYPE_INDEX, Caption)

' IEオブジェクトを取得、キャンセルされた場合は中断する
If (SelectIndex = -1) Then
    GetSelectedIEObject = RETURN_CANCEL
    Exit Function
Else
    GetSelectedIEObject = RETURN_OK
    Set obj = objDict.Item(CInt(SelectIndex))
End If

End Function
'###########################################################

'###########################################################
'            ドロップダウンリストで項目を選択
' 関数名
'    SelectList
'
' 引数
'    ItemList：配列形式のVariant型
'              ドロップダウンリストに設定する項目を指定
'    Type    ：戻り値の型
'              TYPE_INDEX → 数値型のインデックス(0-origine)で返す
'                            キャンセル時は-1を返す
'              TYPE_STRING → 選択された項目の文字列を返す
'                             キャンセル時は"Cancel"を返す
'    Caption ：ダイアログに表示させる文字
'
' 戻り値
'    第2引数Typeに応じて変化
'    詳細は引数の説明を参照
'
' 制限事項
'    IE右上の×ボタンから画面を閉じた場合、エラーが発生
'

Dim RetVal
Dim ObjListIE
Const TYPE_INDEX    = 0
Const TYPE_STRING   = 1
Const STRING_CANCEL = "Cancel"
Const SELECT_WIDTH  = "300px"     ' (IE_WIDTH-50)程度
Const SELECT_MARGINBOTTOM = "10px"
Const IE_HEIGHT     = 150
Const IE_WIDTH      = 350
Const IE_LEFT       = 300
Const IE_TOP        = 300

Function SelectList(ItemList, RetType, Caption)

Dim ObjSelect, ObjLF, ObjButton1, ObjButton2, ObjOption, item, index
    
    ' キャンセル時の戻り値を設定
    RetVal = STRING_CANCEL
    
    ' IEオブジェクトを取得
    Set ObjListIE = WScript.CreateObject("InternetExplorer.Application")
    ObjListIE.Navigate "about:blank"
    
    ' 起動終了まで待機
    Do While(ObjListIE.Busy)
        WScript.Sleep 50
    Loop

' IEオブジェクトにテキストを追加
    ObjListIE.Document.Body.insertAdjacentText "afterBegin", Caption
    
    ' SELECTタグを作成
    Set ObjSelect = ObjListIE.Document.createElement ("select")
    ObjSelect.style.width = SELECT_WIDTH
    ObjSelect.style.marginBottom = SELECT_MARGINBOTTOM
    ObjListIE.Document.Body.insertBefore(ObjSelect)
    
    ' SELECTタグにOPTIONを追加
    index = 0
    For Each item In ItemList
        Set ObjOption = ObjListIE.Document.createElement("OPTION")
        ObjSelect.Options.Add ObjOption
        ObjOption.text = item
        ObjOption.Value = item
    Next
    
    ' SELECTタグに改行を追加
    Set ObjLF = ObjListIE.Document.createElement("BR")
    ObjListIE.Document.Body.insertBefore(ObjLF)
    
    ' Cancelボタンを追加
    Set ObjButton1 = ObjListIE.Document.createElement("button")
    ObjButton1.Value = "CANCEL"
    ObjButton1.style.styleFloat = "right"
    ObjListIE.Document.Body.insertBefore(ObjButton1)
    Set ObjButton1.onclick = GetRef("Click_Cancel")
    
    ' OKボタンを追加
    Set ObjButton2 = ObjListIE.Document.createElement("button")
    ObjButton2.Value = "OK"
    ObjButton2.style.styleFloat = "right"
    ObjListIE.Document.Body.insertBefore(ObjButton2)
    Set ObjButton2.onclick = GetRef("Click_OK")

' IEオブジェクトのステータスを設定
    With ObjListIE
        .height     = IE_HEIGHT
        .width      = IE_WIDTH
        .Left       = IE_LEFT
        .Top        = IE_TOP
        .AddressBar = false
        .MenuBar    = false
        .Resizable  = false
        .StatusBar  = false
        .ToolBar    = false
        .Visible    = true
    End With
    
    ObjListIE.Document.title = "ドロップダウン選択"

Do While(ObjListIE.Busy)
        WScript.Sleep 100
    Loop
    
    CreateObject("WScript.Shell").AppActivate "about:blank"

' ボタン押下まで待機
    Do While (ObjListIE.Visible)
        WScript.Sleep 100
    Loop

' OKボタンが押された場合は選択項目を返す
    If (RetVal = "OK") Then
        If (RetType = TYPE_INDEX) Then
            RetVal = ObjSelect.selectedIndex
        Else
            RetVal = ObjSelect.Value
        End If
    Else
        If (RetType = TYPE_INDEX) Then
            RetVal = -1
        Else
            RetVal = STRING_CANCEL
        End If
    End If

' IEオブジェクトを解放
    ObjListIE.Quit
    
    SelectList = RetVal

End Function

' OKボタン押下時
Function Click_OK
    RetVal = "OK"
    ObjListIE.Visible = false
End Function

' CANCELボタン押下時
Function Click_Cancel
    RetVal = "Cancel"
    ObjListIE.Visible = false
End Function

'###########################################################

'###########################################################
'            オブジェクトのプロパティ値を取得
' 関数
'    GetPropertyVal(Obj As Object, PropName As String, ErrVal As Variant)
'
' 引数
'         Obj：プロパティを取得するオブジェクト
'    PropName：取得するプロパティ名
'      ErrVal：取得できない場合に返す値
'
' 戻り値
'    オブジェクトのプロパティ値を返す。
'    オブジェクトが指定されたプロパティ名を持っていない場合はErrValを返す。
'
' 制限事項
'    直前のエラーがクリアされる

Function GetPropertyVal(Obj, PropName, ErrVal)
    Err.Clear
    On Error Resume Next
    GetPropertyVal = Eval("Obj." & PropName)
    
    If (Err.Number <> 0) Then
        GetPropertyVal = ErrVal
        Err.Clear
    End If

End Function
'###########################################################

簡易イミディエイトウィンドウ

スクリーンショット