Creating multi-select list box in VBScript [closed]

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

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.