在 VBScript 中创建多选列表框 [英] Creating multi-select list box in VBScript

问题描述

我想创建一个 VBScript(不在 HTML 文件中)，它为用户提供一个可供选择的文档列表，然后使用这些选择为他们选择的每个文档运行另一个脚本.如何创建此列表框?

I want to create a VBScript (not within an HTML file) that gives the user a list of documents to select from then uses the selections to run another script for each document they chose. How do I create this list box?

推荐答案

WSH VBS 的某种 GUI 可以通过动态创建的 HTA 窗口实现.下面的代码包括两个包装类，它们有助于 HTA 窗口的创建和元素事件的处理，并展示了如何在表单上放置列表框和按钮并获取所选项目:

Some sort of GUI for WSH VBS can be implemented via dynamically created HTA window. The below code includes two wrapper classes, which facilitate HTA window creation and elements events handling, and shows how to put a listbox and buttons on the form and get selected items:

Option Explicit

' Base64-encoded background image
Const BGI = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAWIAAAB2CAYAAADybJlDAAAACXBIWXMAAC4jAAAuIwF4pT92AAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1MAAA6mAAADqYAAAXb5JfxUYAAAUjSURBVHja7N05ztxGEIBRjqHciZ34Bn3/w9QNnPsE49QwtPwc9lLd9V4kAdKwyQE+Fjnb6/1+XwCs85tDACDEAEIMgBADCDEAQgwgxAAIMYAQAyDEAEIMgBADCDEAQgwgxACM980hgD28Xq/Td7Hd/PdxzHPri+FBiBPH9hPbBVqIQYh3D+/2YRZiEOIT47tVmIUYhLhCfFMHWYhBiKsFOF2UhRiEuHKAUwRZiEGIBXhxkIUYhFiAFwdZiEGIBXhxjIUYhDhLhCP5OocFWYhBiGeHLaxdiEGI54YsNljj0n0SYhDiEYGLhGtKG2MhBiHOFuCdXiDsEmMhhtoh7hW9SLKOLWMsxFA3xD3iVznA3Y6FEEPNED8NoAB3PC5CDPVCvDLCFT4gcvv4CDHUCvGTEFYKcMw8Vn48FOpYEeG28RQ87cRjIoYaE/GnMdxpCo7O2336eH9f1/WPEIMQr4jwyo8Zt4HbaqOOoRCDEGePcCzc9pQYCzGcHeJZER45ia6ewmP0MfViHZxrxwjHle9XltvoYyTEIMIZIvwkwDNvvfT6/0IMpInw0wn4SYTj4Xa63T4RYjANr4hwj1sQKybhIc+NEIMIz4xwr3vAvSI8eyo2EQNLAphhGo1Ej92EGESyW0AWhbD3fkaHbT86lkIMNc2KcO+3ox3500lCDPWm4ZkRXjnx31lDTDgeP3wcIYZaEZ712Bk+lBG7bFOIoZbYdBsz3g0SC/a/CTGw6lZAlok/xZqEGGrFsg163FW3AnqvY8lULMQg3pkj3JKsYyghhjrT8KhL66oRbr3WI8Qg5OUm0Gz7JMQgxhmDdcoJ4UvrEmKoF9AfPVbbdN+2n8qFGNg5fkfcGhFiIFP82mb72Ho8lhDD+dOrqdxEDCyc6mLAY54+lQsxkDrspvwBx06IQUDtj4kYGDA5xnf+Hpvv07GEGEzHd4LZO5qVXqALIQZ6xaxtuu602xNiYNV03A46FkIM7BuhpNPwVEIM50VvxddBjvqC+hKEGAQ9++PG6U+IEAOzp+M7wS7xHmghBnaajk3EgEA+nI4rT8NCDNy+hO4VQtPxL3xzCIAvTKWz3zOcYRr+a9ZaTcSA2wTf9/usDQkxcCfGMWk7pQgx1PGHUAoxsNafHUM7ajouGXkhBjKFc8RXbQoxUCLGgizEgCB33+60KwIhBgR5ceB9oAPYNWTHvLBnIoa9Js2el9UnRPmIfRViYNol+CZBnh53tyaAE+O/1ScAhRgQ5cWEGBgZwa9OlW3SeqLj2rsdF/eIQQxXif/9OSYdlx73lLuuVYhhL9kvs3sELiau9b9RXnbyEmIg6wln5kln6U84CTGcK/Ptibjx72ZHefpz4cU6YJfwx6Tt3NnPLicIIYY9L9vb5us/Icg/W8OtfRRiOH9KPfXL1mPiND706kCIgenhKRblX/JiHdS5vM/wpUGzPnq81Qt8Qgym1dNPWOmjLMRQayquHPq0URZiMBVXO3GYiIEtYnjy7Yxs+xZCDDXCOipAuwW7fXB8h0/y3r4GZDthZIrwz9bfeh0XIYYzIvfVKNyJx0kfBmmDjnuXbbk1AZzukwjHhG2FEINL/4xTZpUIm4hBjKfGdtXtjZZ4WyHEwOk+jfCSk4YQg6k402S5Y4Tb0+0IMTAyPpF0XWkiLMRgKj5lKn7yy8yx+pgIMYhxlel8dYRDiEGMT5uK23VAhIUYqDgFp4rwdV3X6/1+e0phA6/Xa7dJ9rT3NQ+7B/0vAAAA//8DAERsQ7O6796eAAAAAElFTkSuQmCC"

Dim aItems, i

' Array containing items for ListBox
aItems = Array("Item A", "Item B", "Item C", "Item D", "Item E")

' Create HTA window wrapper
With New clsSmallWrapperForm
    ' Setup window
    .ShowInTaskbar = "yes"
    .Title = "Test HTA UserForm"
    .BackgroundImage = BGI
    .Width = 354
    .Height = 118
    .Visible = False
    ' Create window
    .Create
    ' Assign handlers
    Set .Handlers = New clsSmallWrapperHandlers
    ' Add ListBox
    With .AddElement("ListBox1", "SELECT")
        .size = 6
        .multiple = True
        .style.left = "15px"
        .style.top = "10px"
        .style.width = "250px"
    End With
    .AppendTo "Form"
    ' Add ListBox items
    For i = 0 To UBound(aItems)
        .AddElement , "OPTION"
        .AddText aItems(i)
        .AppendTo "ListBox1"
    Next
    ' Add OK Button
    With .AddElement("Button1", "INPUT")
        .type = "button"
        .value = "OK"
        .style.left = "285px"
        .style.top = "10px"
        .style.width = "50px"
        .style.height = "20px"
    End With
    .AppendTo "Form"
    ' Add Cancel Button
    With .AddElement("Button2", "INPUT")
        .type = "button"
        .value = "Cancel"
        .style.left = "285px"
        .style.top = "40px"
        .style.width = "50px"
        .style.height = "20px"
    End With
    .AppendTo "Form"
    ' Add Label
    With .AddElement("Label1", "SPAN")
        .style.left = "15px"
        .style.top = "98px"
        .style.width = "350px"
    End With
    .AddText "Choose items"
    .AppendTo "Form"
    ' Show window
    .Visible = True
    ' Wait window closing or user choise
    Do While .ChkDoc And Not .Handlers.Selected
        WScript.Sleep 100
    Loop
    ' Read results from array .Handlers.SelectedItems
    If .Handlers.Selected Then
        MsgBox "Selected " & (UBound(.Handlers.SelectedItems) + 1) & " Item(s)" & vbCrLf & Join(.Handlers.SelectedItems, vbCrLf)
    Else
        MsgBox "Window closed"
    End If
    ' The rest part of code ...

End With

Class clsSmallWrapperHandlers

    ' Handlers class implements events processing
    ' Edit code to provide the necessary behavior
    ' Keep conventional VB handlers names: Public Sub <ElementID>_<EventName>()

    Public oswForm ' mandatory property

    Public Selected
    Public SelectedItems

    Private Sub Class_Initialize()
        Selected = False
        SelectedItems = Array()
    End Sub

    Public Sub ListBox1_Click()
        Dim vItem
        With CreateObject("Scripting.Dictionary")
            For Each vItem In oswForm.Window.ListBox1.childNodes
                If vItem.Selected Then .Item(vItem.innerText) = ""
            Next
            SelectedItems = .Keys()
        End With
        oswForm.Window.Label1.style.color = "buttontext"
        oswForm.Window.Label1.innerText = (UBound(SelectedItems) + 1) & " selected"
    End Sub

    Public Sub Button1_Click()
        Selected = UBound(SelectedItems) >= 0
        If Selected Then
            oswForm.Window.close
        Else
            oswForm.Window.Label1.style.color = "darkred"
            oswForm.Window.Label1.innerText = "Choose at least 1 item"
        End If
    End Sub

    Public Sub Button2_Click()
        oswForm.Window.close
    End Sub

End Class

Class clsSmallWrapperForm

    ' Utility class for HTA window functionality
    ' Do not modify

    ' HTA tag properties
    Public Border ' thick | dialog | none | thin
    Public BorderStyle ' normal | complex | raised | static | sunken
    Public Caption ' yes | no
    Public ContextMenu ' yes | no
    Public Icon ' path
    Public InnerBorder ' yes | no
    Public MinimizeButton ' yes | no
    Public MaximizeButton ' yes | no
    Public Scroll ' yes | no | auto
    Public Selection ' yes | no
    Public ShowInTaskbar ' yes | no
    Public SysMenu ' yes | no
    Public WindowState ' normal | minimize | maximize

    ' Form properties
    Public Title
    Public BackgroundImage
    Public Width
    Public Height
    Public Left
    Public Top
    Public Self

    Dim oWnd
    Dim oDoc
    Dim bVisible
    Dim oswHandlers
    Dim oLastCreated

    Private Sub Class_Initialize()
        Set Self = Me
        Set oswHandlers = Nothing
        Border = "thin"
        ContextMenu = "no"
        InnerBorder = "no"
        MaximizeButton = "no"
        Scroll = "no"
        Selection = "no"
    End Sub

    Private Sub Class_Terminate()
        On Error Resume Next
        oWnd.Close
    End Sub

    Public Sub Create()
        ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
        Dim sName, sAttrs, sSignature, oShellWnd, oProc
        sAttrs = ""
        For Each sName In Array("Border", "Caption", "ContextMenu", "MaximizeButton", "Scroll", "Selection", "ShowInTaskbar", "Icon", "InnerBorder", "BorderStyle", "SysMenu", "WindowState", "MinimizeButton")
            If Eval(sName) <> "" Then sAttrs = sAttrs & " " & sName & "=" & Eval(sName)
        Next
        If Len(sAttrs) >= 240 Then Err.Raise 450, "<HTA:APPLICATION" & sAttrs & " />"
        sSignature = Mid(Replace(CreateObject("Scriptlet.TypeLib").Guid, "-", ""), 2, 16)
        Set oProc = CreateObject("WScript.Shell").Exec("mshta ""about:<script>moveTo(-32000,-32000);document.title='*'</script><hta:application" & sAttrs & " /><object id='s' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>s.putProperty('" & sSignature & "',document.parentWindow);</script>""")
        Do
            If oProc.Status > 0 Then Err.Raise 507, "mshta.exe"
            For Each oShellWnd In CreateObject("Shell.Application").Windows
                On Error Resume Next
                Set oWnd = oShellWnd.GetProperty(sSignature)
                If Err.Number = 0 Then
                    On Error Goto 0
                    With oWnd
                        Set oDoc = .document
                        With .document
                            .open
                            .close
                            .title = Title
                            .getElementsByTagName("head")(0).appendChild .createElement("style")
                            .styleSheets(0).cssText = "* {font:8pt tahoma;position:absolute;}"
                            .getElementsByTagName("body")(0).id = "Form"
                        End With
                        .Form.style.background = "buttonface"
                        If BackgroundImage <> "" Then
                            .Form.style.backgroundRepeat = "no-repeat"
                            .Form.style.backgroundImage = "url(" & BackgroundImage & ")"
                        End If
                        If IsEmpty(Width) Then Width = .Form.offsetWidth
                        If IsEmpty(Height) Then Height = .Form.offsetHeight
                        .resizeTo .screen.availWidth, .screen.availHeight
                        .resizeTo Width + .screen.availWidth - .Form.offsetWidth, Height + .screen.availHeight - .Form.offsetHeight
                        If IsEmpty(Left) Then Left = CInt((.screen.availWidth - Width) / 2)
                        If IsEmpty(Top) Then Top = CInt((.screen.availHeight - Height) / 2)
                        bVisible = IsEmpty(bVisible) Or bVisible
                        Visible = bVisible
                        .execScript "var smallWrapperThunks = (function(){" &_
                            "var thunks,elements={};return {" &_
                                "parseHandlers:function(h){" &_
                                    "thunks=h;for(var key in thunks){var p=key.toLowerCase().split('_');if(p.length==2){elements[p[0]]=elements[p[0]]||{};elements[p[0]][p[1]]=key;}}}," &_
                                "forwardEvents:function(e){" &_
                                    "if(elements[e.id.toLowerCase()]){for(var key in e){if(key.search('on')==0){var q=elements[e.id.toLowerCase()][key.slice(2)];if(q){eval(e.id+'.'+key+'=function(){thunks.'+q+'()}')}}}}}}})()"
                        If Not oswHandlers Is Nothing Then
                            .smallWrapperThunks.parseHandlers oswHandlers
                            .smallWrapperThunks.forwardEvents .Form
                        End If
                    End With
                    Exit Sub
                End If
                On Error Goto 0
            Next
            WScript.Sleep 100
        Loop
    End Sub

    Public Property Get Handlers()
        Set Handlers = oswHandlers
    End Property

    Public Property Set Handlers(oHandlers)
        Dim oElement
        If Not oswHandlers Is Nothing Then Set oswHandlers.oswForm = Nothing
        Set oswHandlers = oHandlers
        Set oswHandlers.oswForm = Me
        If ChkDoc Then
            oWnd.smallWrapperThunks.parseHandlers oswHandlers
            For Each oElement In oDoc.all
                If oElement.id <> "" Then oWnd.smallWrapperThunks.forwardEvents oElement
            Next
        End If
    End Property

    Public Sub ForwardEvents(oElement)
        If ChkDoc Then oWnd.smallWrapperThunks.forwardEvents oElement
    End Sub

    Public Function AddElement(sId, sTagName)
        Set oLastCreated = oDoc.createElement(sTagName)
        If VarType(sId) <> vbError Then
            If Not(IsNull(sId) Or IsEmpty(sId)) Then oLastCreated.id = sId
        End If
        oLastCreated.style.position = "absolute"
        Set AddElement = oLastCreated
    End Function

    Public Function AppendTo(vNode)
        If Not IsObject(vNode) Then Set vNode = oDoc.getElementById(vNode)
        vNode.appendChild oLastCreated
        ForwardEvents oLastCreated
        Set AppendTo = oLastCreated
    End Function

    Public Function AddText(sText)
        oLastCreated.appendChild oDoc.createTextNode(sText)
    End Function

    Public Property Get Window()
        Set Window = oWnd
    End Property

    Public Property Get Document()
        Set Document = oDoc
    End Property

    Public Property Get Visible()
        Visible = bVisible
    End Property

    Public Property Let Visible(bWindowVisible)
        bVisible = bWindowVisible
        If ChkDoc Then
            If bVisible Then
                oWnd.moveTo Left, Top
            Else
                oWnd.moveTo -32000, -32000
            End If
        End If
    End Property

    Public Function ChkDoc()
        On Error Resume Next
        ChkDoc = CBool(TypeName(oDoc) = "HTMLDocument")
    End Function

End Class

事实上，这只是一个草案，一些操作，如泛型类型元素的创建，可以通过在clsSmallWrapperForm中添加具有此类功能的包装器和方法来简化.

In fact that is just a draft, and some operations like generic types elements creation can be simplified by adding wrappers and methods with such functionality to clsSmallWrapperForm.

这篇关于在 VBScript 中创建多选列表框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！