如何使用VbScript创建选项对话框？

Question

我有第三方应用程序为某些操作调用vsbscript文件。我想提出一个用户提示，可以选择一个选项，下拉列表或复选框或其他选项。但是，我能找到的只是输入框选项。

我不认为HTA在我的情况下是一个选项（除非有办法从.vbs文件中调用它们吗？）

我的另一个想法是某种ActiveX控件，但我找不到默认情况下在WindowsXP / Vista上可用的内置控件。

有人对我如何做到这一点有任何想法吗？

Answer 1

简单的答案是，你真的不能。 Tmdean的解决方案是我能想到的唯一方法。也就是说，你可以修改输入框，使其看起来不是很糟糕。给这个跑步，我不认为这是史诗失败：

Dim bullet
Dim response
bullet = Chr(10) & "   " & Chr(149) & " "
Do
    response = InputBox("Please enter the number that corresponds to your selection:" & Chr(10) & bullet & "1.) Apple" & bullet & "2.) Bannana" & bullet & "3.) Pear" & Chr(10), "Select Thing")
    If response = "" Then WScript.Quit  'Detect Cancel
    If IsNumeric(response) Then Exit Do 'Detect value response.
    MsgBox "You must enter a numeric value.", 48, "Invalid Entry"
Loop
MsgBox "The user chose :" & response, 64, "Yay!"

Answer 2

如果您想使用hta，可以这样做。
VBScript：

Set WshShell = CreateObject("WScript.Shell")
'Run the hta.
WshShell.Run "Test.hta", 1, true
'Display the results.
MsgBox "Return Value = " & getReturn
Set WshShell = Nothing

Function getReturn
'Read the registry entry created by the hta.
On Error Resume Next
     Set WshShell = CreateObject("WScript.Shell")
    getReturn = WshShell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
    If ERR.Number  0 Then
        'If the value does not exist return -1
         getReturn = -1
    Else
        'Otherwise return the value in the registry & delete the temperary entry.
        WshShell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
    End if
    Set WshShell = Nothing
End Function

然后根据需要设计hta，并包括以下方法

'Call this when the OK button is clicked.
Sub OK_Click
    For Each objradiobutton In Opt
         If objradiobutton.Checked Then
              WriteResponse objradiobutton.Value
        End If
    Next
    window.Close
End Sub

'Call this when the Cancel button is clicked.
Sub Cancel_Click
     WriteResponse("CANCEL")
     window.Close
End Sub

'Write the response to the registry
Sub WriteResponse(strValue)
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegWrite "HKEY_CURRENT_USER\Volatile Environment\MsgResp", strValue
     Set WshShell = Nothing
End Sub

我使用了一组名为“选项”的单选按钮作出选择，但您可以使用任何您想要的控件。

因为hta不能返回值，所以这将创建一个临时注册表项。如果您不熟悉注册表，您也可以将结果写入文本文本文件。

这种方法很好，因为您可以按照自己喜欢的方式设计hta，而不是使用提供的输入框并选择数字（这就是DOS）。

如果你扩展hta以根据传递给它的参数创建自己，例如传入标题，要显示的消息，选项数组，一组按钮，这也可能很好。这样，只要您需要从用户那里获得输入，就可以使用相同的hta。

Answer 3

您可以使用DialogLib创建带有下拉列表和复选框的表单。 DialogLib仍处于ealy阶段，但已经非常有用了：http://www.soren.schimkat.dk/Blog/?p=189

Answer 4

试试WshShell.Popup。取决于您可能适合您的数据......

否则你可以调查PowerShell。

Answer 5

一种选择是编写Internet Explorer脚本。您可以使用VBScript启动IE并加载本地HTML文件，并将VBScript子附加到表单的提交按钮（或任何其他JavaScript事件），然后可以关闭IE窗口作为其执行的一部分。

Answer 6

您可以从VBScript启动HTA。

Set shell = CreateObject("WScript.Shell")
shell.Run "Test.hta"

修改

由于您完全控制了VBScript，您是否可以让第三方VBScript简单地调用您的HTA？您可以将UI和任何处理代码放在HTA中。

Answer 7

作为@TmDean建议的一个例子，我有时会使用哪个脚本IE（好吧，它编写了IE6脚本;我没有尝试过最近的版本。）

class IEDisplay
    '~ Based on original work by Tony Hinkle, tonyhinkle@yahoo.com

    private TEMPORARY_FOLDER

    private objShell
    private objIE
    private objFSO
    private objFolder
    private strName
    private streamOut
    private objDIV

    private numHeight
    private numWidth
    private numTop
    private numLeft

    private sub Class_Initialize()
    Dim strComputer
    Dim objWMIService
    Dim colItems
    Dim objItem
    Dim arrMonitors( 10, 1 )
    Dim numMonitorCount

    Set objShell = WScript.CreateObject("WScript.Shell")
    Set objIE = CreateObject("InternetExplorer.Application")

    strComputer = "."
    Set objWMIService = GetObject( "winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery( "Select  * from Win32_DesktopMonitor")

    numMonitorCount = 0 
    For Each objItem in colItems
        arrMonitors( numMonitorCount, 0 ) = objItem.ScreenHeight
        arrMonitors( numMonitorCount, 1 ) = objItem.ScreenWidth
        numMonitorCount = numMonitorCount + 1
    Next

    numHeight = arrMonitors( 0, 0 )
    numWidth = arrMonitors( 0, 1 )

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    TEMPORARY_FOLDER = 2
    set objFolder = objFSO.GetSpecialFolder( TEMPORARY_FOLDER )
    strName = objFSO.BuildPath( objFolder, objFSO.GetTempName ) & ".html"
    WriteFileU strName, Join( Array( "<HTML><HEAD><TITLE>Information</TITLE></HEAD>", _
                     "<BODY SCROLL='NO'><CENTER><FONT FACE='arial black'> <HR COLOR='BLACK'>", _
                     "<DIV id='MakeMeAnObject'></DIV>", _
                     "<HR COLOR='BLACK'></FONT></CENTER></BODY></HTML>" ), vbCRLF ), WF_CREATE        
    numTop = 0
    numLeft = 0
    end sub

    Sub Init( strPosition )
    'NW, N, NE, W, CENTRE, E, SW, S, SE
    Select Case strPosition
    Case "NW"
        numTop = 0
        numLeft = 0
    Case "N"
        numTop = 0
        numLeft = ( numWidth / 2 ) - 250
    Case "NE"
        numTop = 0
        numLeft = numWidth - 500
    Case "W"
        numTop = ( numHeight / 2 ) - 55
        numLeft = 0
    Case "CENTRE"
        numTop = ( numHeight / 2 ) - 55
        numLeft = ( numWidth / 2 ) - 250
    Case "E"
        numTop = ( numHeight / 2 ) - 55
        numLeft = numWidth - 500
    Case "SW"
        numTop = numHeight - 110
        numLeft = 0
    Case "S"
        numTop = numHeight - 110
        numLeft = ( numWidth / 2 ) - 250
    Case "SE"
        numTop = numHeight - 110
        numLeft = numWidth - 500
    Case Else
        numTop = 0
        numLeft = 0
    End Select

    SetupIE( strName )
    Set objDIV = objIE.Document.All("MakeMeAnObject")
    end sub

    private sub Class_Terminate()
    'Close IE and delete the file
    objIE.Quit
    '~ optionally you may want to get rid of the temp file
    end sub

    public sub Display( strMsg, numMillisec )
    objDIV.InnerHTML = strMsg
    WScript.Sleep numMillisec
    end sub

    Private Sub SetupIE(File2Load)
     objIE.Navigate File2Load
     objIE.ToolBar = False
     objIE.StatusBar = False
     objIE.Resizable = False

     Do
     Loop While objIE.Busy

     objIE.Width = 500
     objIE.Height = 110
     objIE.Left = numLeft
     objIE.Top = numTop
     objIE.Visible = True
     objShell.AppActivate("Microsoft Internet Explorer")
    End Sub

end class

这里缺少（来自原始帖子）WriteFileU函数

Const WF_APPEND = 1
Const WF_CREATE = 2

Const WF_FOR_APPENDING = 8
Const WF_FOR_WRITING = 2
Const WF_CREATE_NONEXISTING = True

Const CONST_READ = 1, CONST_WRITE = 2, CONST_APPEND = 8

Const AS_SYSTEMDEFAULT = -2, AS_UNICODE = -1, AS_ASCII = 0

Sub WriteFileU( sFilename, sContents, nMode )
  Dim oStream
  If nMode = WF_APPEND Then
    Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_APPENDING, WF_CREATE_NONEXISTING, AS_UNICODE )
  ElseIf nMode = WF_CREATE Then
    Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_WRITING, WF_CREATE_NONEXISTING, AS_UNICODE )
  Else
    STOP
  End If

  oStream.Write sContents
  oStream.Close
  Set oStream = Nothing
End Sub

然后作为它的使用示例

set i = new IEDisplay 
a = array("NW", "N", "NE", "W", "CENTRE", "E", "SW","S","SE")
for each aa in a
    i.init aa
    i.display "Here in " & aa & " of screen", 1000
next

现在这不是立即有用的（特别是在那里有一堆对我自己的实用程序例程的调用）但是它提供了一个框架。通过修改存储的HTML，您可以添加对列表框等的支持。

Answer 8

我知道这已经晚了11年，但是听起来这将更像原始请求所寻找的：

Sub CustomMsgBox(msg)
Dim ie, Style, FormExit
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Navigate "about:blank"

    While ie.ReadyState <> 4: WScript.Sleep 100: Wend

    ie.Toolbar = False
    ie.StatusBar = False
    ie.Width = 450
    ie.Height = 275

    ie.document.body.innerHTML = "<title>Choose a Color</title><p class='msg'>Choose an option:</p>" & "<input type='radio' id='myRadio' name='colors' value='red'>Red</br><input type='radio' id='myRadio' name='colors' value='yellow'>Yellow</br><input type='radio' id='myRadio' name='colors' value='blue'>Blue"

    Set Style = ie.document.CreateStyleSheet
    Style.AddRule "p.msg", "font-family:calibri;font-weight:bold;"

    ie.Visible = True
    ie.Quit
End Sub

Answer 9

此代码在HTA文件（我是使用WScript.Shell Run从VBS打开）中为我工作的。诀窍是将数据返回到VBS，这是通过让HTA创建VBS读取的XML文件来完成的。

Sub CopySelect(sSrcId, sTargetId)
    Dim oTarget: Set oTarget = document.getElementById(sTargetId)
    Dim oSrc: Set oSrc = document.getElementById(sSrcId)
    Dim j, n, o

    oTarget.length = 0

    For j = 0 to oSrc.length - 1
        Set o = oSrc.options(j)
        Set n = document.createElement("option")
        n.text = o.text
        n.value = o.value
        oTarget.add n
    Next
End Sub