
'VBSApp class

'Intended to support identical handling of class procedures by .vbs/.wsf files and .hta files.

'This can be useful when writing a class that might be used in both types of "apps". Note that the VBScript code in the two examples below is identical except for the comments and indentation.

'' 'test.vbs "arg one" "arg two"
'' With CreateObject("includer")
''     Execute .read("VBSApp")
'' End With
'' Dim app : Set app = New VBSApp
'' MsgBox app.GetFullName,, "app.GetFullName" '..\test.vbs
'' MsgBox app.GetArg(1),, "app.GetArg(1)" 'arg two
'' MsgBox app.GetArgsCount,, "app.GetArgsCount" '2
'' app.Quit
'
'' &lt;!--test.hta "arg one" "arg two"-->
'' &lt;hta:application id="oHta" icon="msdt.exe"> &lt;!--an id must be used for command-line args functionality-->
''     &lt;script language="VBScript">
''         With CreateObject("includer")
''             Execute .read("VBSApp")
''         End With
''         Dim app : Set app = New VBSApp
''         MsgBox app.GetFullName,, "app.GetFullName" '..\test.hta
''         MsgBox app.GetArg(1),, "app.GetArg(1)" 'arg two
''         MsgBox app.GetArgsCount,, "app.GetArgsCount" '2
''         app.Quit
''     &lt;/script>
'' &lt;/hta:application>
'
Class VBSApp

    'Private Method InitializeHtaDependencies
    'Remark: Initializes members required for .hta files.
    Private Sub InitializeHtaDependencies
        With CreateObject("includer")
            Execute .read("HTAApp")
        End With
        Set hta = New HTAApp
    End Sub

    'Property GetArgs
    'Returns: array of strings
    'Remark: Returns an array of command-line arguments.
    Property Get GetArgs
        If Not "Empty" = TypeName(arguments) Then
            GetArgs = arguments
            Exit Property
        End If
        With CreateObject("includer")
            Execute .read("VBSArrays")
        End With
        Dim arrayUtility : Set arrayUtility = New VBSArrays
        If IAmAnHta Then
            hta.SetObj hta.GetId
            'strip off the first argument, which is the filespec
            arguments = arrayUtility.RemoveFirstElement(hta.GetArgs)
        ElseIf IAmAScript Then
            arguments = arrayUtility.CollectionToArray(WScript.Arguments)
        End If
        GetArgs = arguments
    End Property

    'Property GetArgsString
    'Returns: a string
    'Remark: Returns the command-line arguments string. Can be used when restarting a script for example, in order to retain the original arguments. Each argument is wrapped wih double quotes. The return string has a leading space, by design, unless there are no arguments.
    Property Get GetArgsString
        If Not "Empty" = TypeName(argumentsString) Then
            GetArgsString = argumentsString
            Exit Property
        End If
        Dim i, s, args : s = "" : args = GetArgs
        For i = 0 To UBound(args)
            s = s & " """ & args(i) & """"
        Next
        argumentsString = s
        GetArgsString = s
    End Property
    
    'Property GetArg
    'Parameter: an integer
    'Returns: a string
    'Remark: Returns the command-line argument having the specified zero-based index.
    Property Get GetArg(index)
        Dim args : args = GetArgs
        GetArg = args(index)
    End Property

    'Property GetArgsCount
    'Returns: an integer
    'Remark: Returns the number of arguments.
    Property Get GetArgsCount
        Dim args : args = GetArgs
        GetArgsCount = UBound(args) + 1
    End Property

    'Property GetFullName
    'Returns: a string
    'Remark: Returns the filespec of the calling script or hta.
    Property Get GetFullName : GetFullName = filespec : End Property

    'Property GetFileName
    'Returns: a string
    'Remark: Returns the name of the calling script or hta, including the filename extension.
    Property Get GetFileName : GetFileName = fso.GetFileName(filespec) : End Property

    'Property GetBaseName
    'Returns: a string
    'Remark: Returns the name of the calling script or hta, without the filename extension.
    Property Get GetBaseName : GetBaseName = fso.GetBaseName(filespec) : End Property

    'Property GetExtensionName
    'Returns: a string
    'Remark: Returns the filename extension of the calling script or hta.
    Property Get GetExtensionName : GetExtensionName = fso.GetExtensionName(filespec) : End Property
    
    'Property GetParentFolderName
    'Returns: a string
    'Remark: Returns the folder that contains the calling script or hta.
    Property Get GetParentFolderName : GetParentFolderName = fso.GetParentFolderName(filespec) : End Property

    'Property GetExe
    'Returns: a string
    'Remark: Returns "mshta.exe" to hta files, and "wscript.exe" or "cscript.exe" to scripts, depending on the host.
    Property Get GetExe
        If IAmAnHta Then
            GetExe = "mshta.exe"
        ElseIf IAmAScript Then
            GetExe = LCase(Right(WScript.FullName, 11))
        Else
            Err.Raise 3, GetFileName, "Couldn't determine the host .exe; source: VBSApp.GetExe"
        End If
    End Property

    'Method RestartWith
    'Parameters: #1: host; #2: switch; #3: elevating"
    'Remark: Restarts the script/app with the specified host (typically "wscript.exe", "cscript.exe", or "mshta.exe") and retaining the command-line arguments. Paramater #2 is a cmd.exe switch, "/k" or "/c". Parameter #3 is a boolean, True if restarting with elevated privileges. If userInteractive, first warns user that the User Account Control dialog will open.
    Sub RestartWith(host, switch, elevating)
        With CreateObject("includer")
            Execute .read("VBSApp")
            Execute .read("StringFormatter")
        End With
        Dim app : Set app = New VBSApp
        Dim format : Set format = New StringFormatter
        Dim privileges : If elevating Then privileges = "runas" Else privileges = ""
        Dim start
        If "cscript" = LCase(fso.GetBaseName(host)) Then
            start = ""
        Else 
            'prevent console window from needlessly persisting
            start = "start"
        End If
        If elevating And userInteractive Then If vbCancel = MsgBox(format(Array( _
            " Restart %s with elevated privileges? %s (The User Account Control dialog may open.)", _
            GetFileName, vbLf _
        )), vbOKCancel + vbQuestion, GetBaseName) Then Quit
        Dim args : args = format(Array( _
            "%s cd ""%s"" & %s %s ""%s"" %s", _
             switch, GetParentFolderName, start, host, me.GetFullName, GetArgsString _
        ))
        With CreateObject("Shell.Application")
            .ShellExecute "cmd", args, GetParentFolderName, privileges
        End With
        'close the current instance of this script
        Quit
    End Sub

    'Method SetUserInteractive
    'Parameter: boolean
    'Remark: Sets userInteractive value. Setting to True can be useful for debugging. Default is True.
    Sub SetUserInteractive(newUserInteractive)
        userInteractive = newUserInteractive
        If userInteractive Then
            visibility = visible
        Else
            visibility = hidden
        End If
    End Sub

    'Property GetUserInteractive
    'Returns: boolean
    'Remark: Returns the userInteractive setting. This setting also may affect the visibility of selected console windows.
    Property Get GetUserInteractive : GetUserInteractive = userInteractive : End Property

    'Method SetVisiblity
    'Parameter: 0 (hidden) or 1 (normal)
    'Remark: Sets the visibility of selected command windows. SetUserInteractive also affects this setting. Default is True.
    Sub SetVisiblity(newVisibility) : visibility = newVisibility : End Sub

    'Property GetVisibility
    'Returns: 0 (hidden) or 1 (normal)
    'Remark: Returns the current visibility setting. SetUserInteractive also affects this setting.
    Property Get GetVisibility : GetVisibility = visibility : End Property
    
    'Method Quit
    'Remark: Gracefully closes the hta/script.
    Sub Quit
        ReleaseObjectMemory
        If IAmAnHta Then
            Self.close
        ElseIf IAmAScript Then
            WScript.Quit
        End If
    End Sub
    
    'Method Sleep
    'Parameter: an integer
    'Remark: Pauses execution of the script or .hta for the specified number of milliseconds.
    Sub Sleep(ByVal milliseconds)
        If IAmAScript Then
            WScript.Sleep milliseconds
        ElseIf IAmAnHta Then
            hta.Sleep milliseconds
        Else
            Err.Raise 54,, "VBSApp.Sleep: unknown app type."
        End If
    End Sub
    
    'Property WScriptHost
    'Returns: "wscript.exe"
    'Remark: Can be used as an argument for the method RestartIfNotPrivileged.
    Public Property Get WScriptHost : WSCriptHost = "wscript.exe" : End Property
    
    'Property CScriptHost
    'Returns: "cscript.exe"
    'Remark: Can be used as an argument for the method RestartIfNotPrivileged.
    Public Property Get CScriptHost : CSCriptHost = "cscript.exe" : End Property
    
    'Property GetHost
    'Returns: "wscript.exe" or "cscript.exe" or "mshta.exe"
    'Remark: Returns the current host. Can be used as an argument for the method RestartIfNotPrivileged.
    Public Property Get GetHost : GetHost = GetExe : End Property
   
    Private fso
    Private hta
    Private filespec, arguments, argumentsString
    Private IAmAnHta, IAmAScript
    Private userInteractive, visibility, visible, hidden

    Sub Class_Initialize
        Set fso = CreateObject("Scripting.FileSystemObject")
        hidden = 0
        visible = 1

        SetUserInteractive True
        InitializeAppTypes
    End Sub
    
    'Determine whether the source file is a script or an hta
    Private Sub InitializeAppTypes
        On Error Resume Next
            Dim x : x = WScript.ScriptName
            If Err Then IAmAnHta = True Else IAmAnHta = False
        On Error Goto 0
        IAmAScript = Not IAmAnHta
        If IAmAScript Then
            filespec = WScript.ScriptFullName
        ElseIf IAmAnHta Then
            InitializeHtaDependencies
            filespec = hta.GetFilespec
        Else
            Err.Raise 2, GetFileName, "VBSApp.InitializeAppTypes could not determine the type of file that is calling it."
        End If
    End Sub

    Private Sub ReleaseObjectMemory
        Set fso = Nothing
    End Sub

    Sub Class_Terminate
        ReleaseObjectMemory
    End Sub
End Class
