PC Professionell 2006 May/PCpro_2006_05.ISO/files/free_security/msshared/Shared_Computer_Toolkit_ENU.msi/FileInclude012

Text (UTF-16) | 2005-09-02 | 75.2 KB | 1,078 lines

' ***
' *** --------------------------------------------------------------------------
' *** Filename:        GetStarted.vbs
' *** --------------------------------------------------------------------------
' *** Description:    Code for the Getting Started HTA
' *** --------------------------------------------------------------------------
' *** Version:        1.0
' *** Notes:
' *** --------------------------------------------------------------------------
' *** Copyright (C) Microsoft Corporation 2005, All Rights Reserved
' *** --------------------------------------------------------------------------
' ***

' ~~~
' ~~~ Force variables to be declared and turn off script error messages unless in DEBUG mode
' ~~~
Option Explicit
If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

' ~~~
' ~~~ Declare global variables and constants
' ~~~
Const GSKEY            = "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\SCTRunGettingStarted"
' ~~~ GSKEY            = "": Do Not Show Getting Started at Startup, "<hta path/file>": Run Getting Started at Startup

Const SRPKEY            = "HKLM\SOFTWARE\Policies\Microsoft\Windows\Safer\CodeIdentifiers\PolicyScope"
' ~~~ SRPKEY           = 0: SRP for All Users (Installed default), 1: Skip Administrators

Const WelcomeLogonKEY        = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\LogonType"
' ~~~ WelcomeLogonKey      = 0: Classic CAD Mode, 1: Welcome Screen

Const WelcomeOffCompKEY1   = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\ShutdownWithoutLogon"
' ~~~ WelcomeOffCompKEY1   = 0: Disable Turn off Computer, 1: Enable Turn off Computer (default)

Const WelcomeOffCompKEY2   = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\system\shutdownwithoutlogon"
' ~~~ WelcomeOffCompKEY2   = 0: Disable Shutdown, 1: Enable Shutdown (default)

Const LastLogonKEY        = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\system\dontdisplaylastusername"
' ~~~ LastLogonKEY         = 0: Display last username (default), 1: Don't display last username

CONST NoLMHashKEY       = "HKLM\SYSTEM\CurrentControlSet\Control\Lsa\NoLMHash"
' ~~~ NoLMHashKEY       = 0: LMHash used (default), 1: Don't store passwords using LMHash

Const NoAcctCacheKEY        = "HKLM\SYSTEM\CurrentControlSet\Control\Lsa\DisableDomainCreds"
' ~~~ NoAcctCacheKEY       = 0: Enable storage (default), 1: Disable storage

Const DelRoamingCacheKEY   = "HKLM\SOFTWARE\Policies\Microsoft\Windows\System\DeleteRoamingCache"
' ~~~ DelRoamingCacheKEY   = 0: Do not delete roaming profiles (default), 1: Delete them

Const ProfileErrActionKEY  = "HKLM\SOFTWARE\Policies\Microsoft\Windows\System\ProfileErrorAction"
' ~~~ ProfileErrActionKEY  = 0: Allow logon without roaming profile (default), 1: Don't allow this

Const Excel70KEY           = "HKLM\SOFTWARE\Classes\Excel.Sheet.5\BrowserFlags"
Const Excel2000KEY         = "HKLM\SOFTWARE\Classes\Excel.Sheet.8\BrowserFlags"
Const Word70KEY            = "HKLM\SOFTWARE\Classes\Word.Document.6\BrowserFlags"
Const Word2000KEY          = "HKLM\SOFTWARE\Classes\Word.Document.8\BrowserFlags"
Const Project98KEY         = "HKLM\SOFTWARE\Classes\MSProject.Project.8\BrowserFlags"
Const PowerPoint2000KEY    = "HKLM\SOFTWARE\Classes\PowerPoint.Show.8\BrowserFlags"
' ~~~ Office KEYs          = 9 (Excel7) or 8 (all else): Prevent opening documents within IE, Removed: Allow opening documents within IE

Dim sAppDir, sCurrentUser, oWelcome, bShowAtStartup, bExpand, iSRPScope, bDomainMember, iWDPcmdver
Dim s1, s2, s3, s4, s5, s6, s7, s8, srp
Dim sGroupName

' ***
' *** --------------------------------------------------------------------------
' *** Name:        PreChecks
' *** --------------------------------------------------------------------------
' *** Purpose:        This function is started before the HTA is visible,
' ***             to perform several important checks and routines.
' *** --------------------------------------------------------------------------
' ***
Sub PreChecks
    ' ~~~ Ignore errors when resizing the HTA
    On Error Resume Next

    ' ~~~ Force Window size to the full screen less a five percent border
    window.resizeTo screen.width*.9, screen.height*.9
    window.moveTo    screen.width*.05, screen.height*.05

    bExpand     = False
    bProcessing = True
End Sub

' ***
' *** --------------------------------------------------------------------------
' *** Name:        Init
' *** --------------------------------------------------------------------------
' *** Purpose:        This function is initiated by Main, which is called by
' ***             OnLoad
' *** --------------------------------------------------------------------------
' ***
Sub Init
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~create Welcome object and set it
    sCurrentUser = oNetwork.UserName
    Set oWelcome = New Welcome
    oWelcome.User = sCurrentUser

    ' ~~~ Load prechecks into the UI and update the UI

    bDomainMember = DomainMember()
    sAppDir       = GetRootFolder

    Call LoadStartup
    Call LoadSRP
    Call UpdateStartup
    Call UpdateSRP
    Call UpdateWelcome
    Call BodyDisable(False)
    Call UpdateWDP
End Sub

' ***
' *** --------------------------------------------------------------------------
' *** Name:        Load
' *** --------------------------------------------------------------------------
' *** Purpose:
' *** --------------------------------------------------------------------------
' ***
Sub Load
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
End Sub

' ------------------------------------------------------------------------------
' Name:            LoadStartup()
' ------------------------------------------------------------------------------
' Purpose:
' ------------------------------------------------------------------------------
Sub LoadStartup()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    bShowAtStartup = False
    If RegRead(GSKEY) <> "" Then bShowAtStartup = True
End Sub

' ------------------------------------------------------------------------------
' Name:            UpdateStartup()
' ------------------------------------------------------------------------------
' Purpose:
' ------------------------------------------------------------------------------
Sub UpdateStartup()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    If bShowAtStartup Then
        Startup.src = "graphics/chkbox-1.gif"
    Else
        Startup.src = "graphics/chkbox-0.gif"
    End If
End Sub

' ------------------------------------------------------------------------------
' Name:            ClickStartup()
' ------------------------------------------------------------------------------
' Purpose:
' ------------------------------------------------------------------------------
Sub ClickStartup()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    bShowAtStartup = NOT bShowAtStartup
    UpdateStartup

    If bShowAtStartup Then
        RegWrite GSKEY, Chr(34) & sAppDir & "\GetStarted.hta" & Chr(34), "REG_SZ"
    Else
        RegDelete(GSKEY)
    End If
End Sub

' ***
' *** --------------------------------------------------------------------------
' *** Name:        LoadSRP
' *** --------------------------------------------------------------------------
' *** Purpose:
' *** --------------------------------------------------------------------------
' ***
Sub LoadSRP
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ SRPKEY;  0 = SRP for All Users (Installed default), 1 = Skip Administrators
    iSRPScope = RegRead(SRPKEY)
End Sub

' ***
' *** --------------------------------------------------------------------------
' *** Name:        UpdateSRP
' *** --------------------------------------------------------------------------
' *** Purpose:
' *** --------------------------------------------------------------------------
' ***
Sub UpdateSRP()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    If iSRPScope <> 0 Then
        srpAdmin.style.display = "block"
        srpAdmin2.style.display = "block"
    End If
End Sub


' ***
' *** --------------------------------------------------------------------------
' *** Name:        UpdateWelcome
' *** --------------------------------------------------------------------------
' *** Purpose:
' *** --------------------------------------------------------------------------
' ***
Sub UpdateWelcome()
'    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ Set the checkbox for Prevent account name from being saved in CAD
    chkLastLogon.checked = RegRead(LastLogonKEY)

    ' ~~~ Set the checkbox for using LMHash
    chkNoLMHash.checked = RegRead(NoLMHashKEY)

    ' ~~~ Set the checkbox for Caching .NET Passports
    chkNoAcctCache.checked = RegRead(NoAcctCacheKEY)


    ' ~~~ Set the checkbox for ACL's in C:
    chkPreventWindir.checked = GetAceStatus( Left( oShell.ExpandEnvironmentStrings("%WINDIR%"), 3))

    ' ~~~ Set the checkbox for Delete Roaming Profile Cache
    chkDelRoamingCache.checked = RegRead(DelRoamingCacheKEY)

    ' ~~~ Set the checkbox for logon only if roaming profile available
    chkProfileErrAction.checked = RegRead(ProfileErrActionKEY)

    ' ~~~ Set the Remove Shutdown/Turn off computer checkbox
    If RegRead(WelcomeOffCompKEY1) = 0 and RegRead(WelcomeOffCompKEY2) = 0 Then
        chkWelcomeOffComp.checked = True
    Else
        chkWelcomeOffComp.checked = False
    End If

    ' ~~~ Set the Prevent Office documents from opening in IE checkbox
    chkOfficeIE.checked = CheckOfficeIE

    If NOT bDomainMember Then
        ' ~~~ If this is a workgroup computer, set several checkboxes and info

        ' ~~~ Set the Use Welcome logon screen checkbox
        chkWelcomeLogon.checked = RegRead(WelcomeLogonKEY)

        If oWelcome.IsLocal Then
            ' ~~~ If the current user is local indicate the current state of it on the Welcome screen
            welcomeUser.innerHTML = "<B>" & sCurrentUser & "</B>"
            chkWelcomeRemAcct.checked = oWelcome.IsDisabled
        Else
            ' ~~~ If the current user is not local remove the option to remove them from the Welcome screen
            trWelcomeRemAcct.style.display = "none"
            chkWelcomeRemAcct.style.display = "none"
        End If

    Else
        ' ~~~ If this is a domain computer, turn off the Welcome related checkboxes
        trWelcomeLogon.style.display = "none"
        chkWelcomeLogon.style.display = "none"
        trWelcomeRemAcct.style.display = "none"
        chkWelcomeRemAcct.style.display = "none"

        ' ~~~ Domain computer - turn off the password test button and text.
        Q11.style.display = "none"
        pStep2b.style.display = "none"
        Step2PassTest.style.display = "none"
    End If
End Sub

' ***
' *** --------------------------------------------------------------------------
' *** Name:        PassPolicyCheck
' *** --------------------------------------------------------------------------
' *** Purpose:        Ensure password policy not in place to impact PassChecks
' *** --------------------------------------------------------------------------
' ***
Function PassPolicyCheck
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim oMachine, oUser, Passwords, Password
    PassPolicyCheck = False

    ' ~~~ Initialize constants
    CONST EX_USER   = "SCTTestx"
    CONST EX_PASS   = "Testing12345a~!a"

    ' ~~~ Initialize variables and create a test account
    Set oMachine = GetObject("WinNT://" & sComputer)
    Set oUser    = oMachine.Create("user", EX_USER)
    oUser.SetPassword EX_PASS
    oUser.SetInfo

    ' ~~~ Establish the passwords we'll run this account through
    Passwords = Array("Password!123B-", "password!567A-")

    ' ~~~ Ignore errors resulting from failed password changes
    On Error Resume Next

    For each Password in Passwords
        ' ~~~ Change the password and change it back
        oUser.ChangePassword EX_PASS, Password
        Err.Clear
        oUser.changePassword Password, EX_PASS
    Next

    ' ~~~ If we can change the password back to the beginning after all of this, then there is no Password Policy to interfere
    If err.number = 0 Then PassPolicyCheck = True

    ' ~~~ Delete the test account
    Set oUser    = Nothing
    oMachine.Delete "user", EX_USER
    Set oMachine = Nothing
End Function


' ***
' *** --------------------------------------------------------------------------
' *** Name:        PassChecks
' *** --------------------------------------------------------------------------
' *** Purpose:        Test local admin account for several weak passwords
' *** --------------------------------------------------------------------------
' ***
Sub PassChecks
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim oUser, Passwords, Password
    CONST TEMP_PASS = "Testing12345a~!"

    ' ~~~ If this is a Domain account then do not do password checks
    If NOT oWelcome.IsLocal Then
        MsgBox L_DomainNote_Text, vbInformation, L_DomainTitle_TEXT
        Exit Sub
    End If

    ' ~~~ Check that no Password Policy is in place... or the checks below will cause problems for this admin account
    If NOT PassPolicyCheck() Then
        MsgBox L_PassPolicy_TEXT, vbInformation, L_PassTitle_TEXT
        Exit Sub
    End If

    ' ~~~ Initialize variables
    Set oUser    = GetObject("WinNT://" & sComputer & "/" & sCurrentUser & ", user")
    Passwords    = Array("", sCurrentUser, "Password", "password", oNetwork.ComputerName)

    ' ~~~ Ignore errors resulting from failed password changes
    On Error Resume Next

    ' ~~~ So as not to change the password and not be able to change it back
    For each Password in Passwords

        ' ~~~ Attempt to change the password
        Err.Clear
        oUser.ChangePassword Password, TEMP_PASS

        ' ~~~ If the password change was successful (i.e. no error), change it back and provide warning
        If err.number = 0 Then
            oUser.changePassword TEMP_PASS, Password
            MsgBox L_PassWarn_TEXT, vbCritical, L_PassWarnTitle_TEXT
            Exit Sub
        End If
    Next

    ' ~~~ Didn't find the password
    MsgBox L_PassNote_TEXT, vbInformation, L_PassTitle_TEXT
    Set oUser = Nothing
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            UpdateWDP()
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub UpdateWDP()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ Set the WDP.cmd version #
    iWDPcmdVer = 4

    ' ~~~ Learn how WDP is currently configured
    Dim oDiskProtect
    Set oDiskProtect = New DiskProtect

    ' ~~~ If the Overlay hasn't been created yet, and the Toolkit can't see space for a Protection Partition, then the prereqs have not been done yet.
    If Not(oDiskProtect.OverlayCreated) Then
        If oDiskProtect.CalcOVSize = 0 Then
            wdpPrereq.style.display = "inline"
            Step1Text.style.display = "block"
        Else
            wdpDisabled.style.display = "inline"
        End If
    ' ~~~ If the Overlay has been created, indicate if WDP is on or off
    Else
        If oDiskProtect.Enabled Then
            wdpEnabled.style.display = "inline"
        Else
            wdpDisabled.style.display = "inline"
        End If
    End If
    wdpQuery.style.display = "none"
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickLastLogon()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Remove last username from the CTRL-ALT-DEL logon dialog or not
' *** ------------------------------------------------------------------------------
' ***
Sub ClickLastLogon
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ LastLogonKEY;  0 = Display last username (default), 1 = Don't display last username

    If chkLastLogon.checked Then
        RegWrite LastLogonKEY, 1, "REG_DWORD"
    Else
        RegWrite LastLogonKEY, 0, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickNoLMHash()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Prevent storing passwords using LMHash
' *** ------------------------------------------------------------------------------
' ***
Sub ClickNoLMHash
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ NoLMHashKEY; 0 = Store LMHash passwords (default), 1 = Disable use of LMHash values for password storage

    If chkNoLMHash.checked Then
        RegWrite NoLMHashKEY, 1, "REG_DWORD"
    Else
        RegWrite NoLMHashKEY, 0, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickNoAcctCache()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Prevent caching of .NET Passport accounts in user profiles or not
' *** ------------------------------------------------------------------------------
' ***
Sub ClickNoAcctCache
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ NoAcctCacheKEY; 0 = Enable storage (default), 1 = Disable storage

    If chkNoAcctCache.checked Then
        RegWrite NoAcctCacheKEY, 1, "REG_DWORD"
    Else
        RegWrite NoAcctCacheKEY, 0, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickPreventWindir()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Prevent creation of files/Folders in root directory
' *** ------------------------------------------------------------------------------
' ***
Sub ClickPreventWindir
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim sDrivename

    sDrivename = Left( oShell.ExpandEnvironmentStrings("%WINDIR%"), 3)

    If chkPreventWindir.Checked Then
        Call AddAce( sDrivename )
    Else
        Call RemoveAce(sDrivename)
    End If

End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickDelRoamingCache()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Delete local copies of roaming user profiles
' *** ------------------------------------------------------------------------------
' ***
Sub ClickDelRoamingCache
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ DelRoamingCacheKEY; 0 = do not delete roaming profiles (default), 1 = delete them

    If chkDelRoamingCache.checked Then
        RegWrite DelRoamingCacheKEY, 1, "REG_DWORD"
    Else
        RegWrite DelRoamingCacheKEY, 0, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickProfileErrAction()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Delete local copies of roaming user profiles
' *** ------------------------------------------------------------------------------
' ***
Sub ClickProfileErrAction
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ ProfileErrActionKEY; 0 = allow logon without roaming profile (default), 1 = don't allow this

    If chkProfileErrAction.checked Then
        RegWrite ProfileErrActionKEY, 1, "REG_DWORD"
    Else
        RegWrite ProfileErrActionKEY, 0, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickWelcomeLogon()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Use the Welcome Logon Screen or not
' *** ------------------------------------------------------------------------------
' ***
Sub ClickWelcomeLogon
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ WelcomeLogonKEY; 0 = Classic CAD Mode, 1 = Welcome Screen

    If chkWelcomeLogon.checked Then
        RegWrite WelcomeLogonKEY, 1, "REG_DWORD"
    Else
        RegWrite WelcomeLogonKEY, 0, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickWelcomeOffComp()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Disable 'Turn off Computer' or not
' *** ------------------------------------------------------------------------------
' ***
Sub ClickWelcomeOffComp
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    ' ~~~ WelcomeOffCompKEY1; 0 = Disable Turn off Computer, 1 = Enable Turn off Computer (default)
    ' ~~~ WelcomeOffCompKEY2; 0 = Disable Shutdown, 1 = Enable Shutdown (default)

    If chkWelcomeOffComp.checked Then
        RegWrite WelcomeOffCompKEY1, 0, "REG_DWORD"
        RegWrite WelcomeOffCompKEY2, 0, "REG_DWORD"
    Else
        RegWrite WelcomeOffCompKEY1, 1, "REG_DWORD"
        RegWrite WelcomeOffCompKEY2, 1, "REG_DWORD"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickOfficeIE()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Prevent Office documents from opening in Internet Explorer
' ***               See KB 162059 for more information.
' *** ------------------------------------------------------------------------------
' ***
Sub ClickOfficeIE
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    If chkOfficeIE.checked Then
        RegWrite Excel70KEY,        9, "REG_DWORD"
        RegWrite Excel2000KEY,      8, "REG_DWORD"
        RegWrite Word70KEY,         8, "REG_DWORD"
        RegWrite Word2000KEY,       8, "REG_DWORD"
        RegWrite Project98KEY,      8, "REG_DWORD"
        RegWrite PowerPoint2000KEY, 8, "REG_DWORD"
    Else
        RegDelete(Excel70KEY)
        RegDelete(Excel2000KEY)
        RegDelete(Word70KEY)
        RegDelete(Word2000KEY)
        RegDelete(Project98KEY)
        RegDelete(PowerPoint2000KEY)
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            CheckOfficeIE()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Determine if all OfficeIE settings are in place.
' *** ------------------------------------------------------------------------------
' ***
Function CheckOfficeIE
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    CheckOfficeIE = False

    If RegRead(Excel70KEY) = 9 and RegRead(Excel2000KEY) = 8 and RegRead(Word70KEY) = 8 and RegRead(Word2000KEY) = 8 and RegRead(Project98KEY) = 8 and RegRead(PowerPoint2000KEY) = 8 Then
        CheckOfficeIE = True
    End If
End Function

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ClickWelcomeRemAcct()
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub ClickWelcomeRemAcct
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    If chkWelcomeRemAcct.checked Then
        oWelcome.Disable
        if LCase(sCurrentUser) <> LCase( GetAdminName() ) Then DisableAdministrator
    Else
        oWelcome.Enable
    End If

End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            DisableAdministrator()
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub DisableAdministrator
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim oWelcomeAdmin

    ' ~~~ Create Welcome object, set it, and disable it
    Set oWelcomeAdmin = New Welcome
    oWelcomeAdmin.User = GetAdminName()
    oWelcomeAdmin.Disable

    Set oWelcomeAdmin = Nothing
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ResText(res)
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Function ResText(res)
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
    ResText = document.all(res).innerHTML
End Function

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            Light(objBtn, bOn)
' *** ------------------------------------------------------------------------------
' *** Purpose:        This sub is executed to highlight the common buttons
' *** ------------------------------------------------------------------------------
' ***
Sub Light(objBtn, bOn)
    On Error Resume Next

    If bOn Then
        objBtn.filters.Light.Clear
        objBtn.filters.Light.AddAmbient 150,150,255,100
        objBtn.filters.Light.AddAmbient 255,255,255,20
        objBtn.filters.Light.Enabled = true
        objBtn.style.borderStyle = "outset"
    Else
        objBtn.filters.Light.Enabled = false
        objBtn.style.borderStyle = "solid"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            HTAKeyDown()
' *** ------------------------------------------------------------------------------
' *** Purpose:        This subroutine is executed whenever tool specific key is pressed
' *** ------------------------------------------------------------------------------
' ***
Sub HTAKeyDown()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ButtonOver()
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub ButtonOver()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    If Window.event.srcElement.className = "down" Then Exit Sub
    If Window.event.srcElement.className = "text" Then Exit Sub
    window.event.srcElement.style.borderStyle = "inset"
    window.event.srcElement.style.borderColor = "lightblue"
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ButtonLeave()
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub ButtonLeave()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    window.event.srcElement.style.borderStyle = "solid"
    window.event.srcElement.style.borderColor = "royalblue"
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ButtonClick()
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub ButtonClick(oNext, oDown, bScroll)
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim iOffsetTop, iClientHeight, i

    If oNext.style.display = "none" Then
        oNext.style.display = "block"
        oDown.style.display = "none"

        If bScroll Then
            ' ~~~ If necessary, scroll the screen to ensure the selected step is viewable
            iClientHeight = oBody.offsetHeight
            iOffsetTop = oNext.nextSibling.offsetTop - oBody.scrollTop

            If (iOffsetTop > iClientHeight) Then
                For i = 1 to iOffsetTop - iClientHeight Step 5
                    window.scrollBy 0, 5
                Next
                window.scrollBy 0, 20
            End If
        End If
    Else
        oNext.style.display = "none"
        oDown.style.display = "inline"
    End If
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            ExpandAll
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub ExpandAll
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    bProcessing = True

    bExpand = Not bExpand

    If bExpand Then
        expand.innerHTML = ResText("resCollapse")
        Step1Text.style.display = "none"
        Step2Text.style.display = "none"
        Step3Text.style.display = "none"
        Step4Text.style.display = "none"
        Step5Text.style.display = "none"
        Step6Text.style.display = "none"
        Step7Text.style.display = "none"
        Step8Text.style.display = "none"
        If srpAdmin.style.display <> "none" Then
            srpAdmin2.style.display = "none"
            ButtonClick srpAdmin2, dsrpAdmin, False
        End If
    Else
        expand.innerHTML = ResText("resExpand")
        Step1Text.style.display = "block"
        Step2Text.style.display = "block"
        Step3Text.style.display = "block"
        Step4Text.style.display = "block"
        Step5Text.style.display = "block"
        Step6Text.style.display = "block"
        Step7Text.style.display = "block"
        Step8Text.style.display = "block"
        If srpAdmin.style.display <> "none" Then
            srpAdmin2.style.display = "block"
            ButtonClick srpAdmin2, dsrpAdmin, False
        End If
    End If

    ButtonClick Step8Text, dStep8, False
    ButtonClick Step7Text, dStep7, False
    ButtonClick Step6Text, dStep6, False
    ButtonClick Step5Text, dStep5, False
    ButtonClick Step4Text, dStep4, False
    ButtonClick Step3Text, dStep3, False
    ButtonClick Step2Text, dStep2, False
    ButtonClick Step1Text, dStep1, False

    window.scrollTo 0, 0

    bProcessing = False
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            PrintPage
' *** ------------------------------------------------------------------------------
' *** Purpose:        Expand all steps, print the page, then put the steps back
' *** ------------------------------------------------------------------------------
' ***
Sub PrintPage
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
    bProcessing = True

    ' ~~~ Capture the current state of each step and warning
    s1 = Step1Text.style.display
    s2 = Step2Text.style.display
    s3 = Step3Text.style.display
    s4 = Step4Text.style.display
    s5 = Step5Text.style.display
    s6 = Step6Text.style.display
    s7 = Step7Text.style.display
    s8 = Step8Text.style.display
    srp = srpAdmin2.style.display

    ' ~~~ Expand all of the states
    Step1Text.style.display = "block"
    Step2Text.style.display = "block"
    Step3Text.style.display = "block"
    Step4Text.style.display = "block"
    Step5Text.style.display = "block"
    Step6Text.style.display = "block"
    Step7Text.style.display = "block"
    Step8Text.style.display = "block"
    If srpAdmin.style.display <> "none" Then srpAdmin2.style.display = "block"

    Window.print

    ' ~~~ Put the states back to where they began
    Step1Text.style.display = s1
    Step2Text.style.display = s2
    Step3Text.style.display = s3
    Step4Text.style.display = s4
    Step5Text.style.display = s5
    Step6Text.style.display = s6
    Step7Text.style.display = s7
    Step8Text.style.display = s8
    If srpAdmin.style.display <> "none" Then srpAdmin2.style.display = srp

    bProcessing = False
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            Run(sRun)
' *** ------------------------------------------------------------------------------
' *** Purpose:
' *** ------------------------------------------------------------------------------
' ***
Sub Run(sRun)
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    bProcessing = True

    Select Case sRun
        Case "ProfileMgr"        Call oShell.Run(Chr(34) & sAppDir & "\ProfileMgr.hta" & Chr(34),    1, False)
        Case "Restrict"            Call oShell.Run(Chr(34) & sAppDir & "\Restrict.hta" & Chr(34),        1, False)
        Case "DiskProtect"
            ' ~~~ Need to ensure our wdPQuery has finished before allowing DiskProtect.hta to open
            If wdpQuery.style.display = "none" Then
                        Call oShell.Run(Chr(34) & sAppDir & "\DiskProtect.hta" & Chr(34),    1, False)
            End If
        Case "Accessibility"        Call oShell.Run(Chr(34) & sAppDir & "\Accessibility.hta" & Chr(34),    1, False)
         Case "Logoff"            Call oShell.Run("Logoff.exe",                        7, False)
        Case "DiskMgmt"            Call oShell.Run("Diskmgmt.msc",                        1, False)
        Case "PassTest"                PassChecks
        Case "Help"                ShowHelp
        Case "Cmd"                Call oShell.Run(Chr(34) & sAppDir & "\Scripts\Command-line Here.cmd" & Chr(34) & " " & Chr(34) & sAppDir & "\Scripts" & Chr(34), 1, False)
        Case "User"
            If Not bDomainMember Then
                Call oShell.Run("CONTROL NUSRMGR.CPL", 1, False)
            Else
                Call oShell.Run("LUSRMGR.MSC", 1, False)
            End If
        Case "Handbook"
            On Error Resume Next
            Err.Clear
            Call oShell.Run(Chr(34) & sAppDir & "\Shared Computer Toolkit Handbook.pdf" & Chr(34), 1, False)
            If Err.number <> 0 Then
                If MsgBox(ResText("resNoPDF"), vbYesNo + vbCritical, ResText("resNoPDFTitle")) = vbYes Then
                    Call oShell.Run(ResText("resPDFwebsite"), 1, False)
                End If
            End If
    End Select

    bProcessing = False
End Sub

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            GetAdminName()
' *** ------------------------------------------------------------------------------
' *** Purpose:        Returns the localized name of the administrator
' ***            by using the SID
' *** ------------------------------------------------------------------------------
' ***
Function GetAdminName()
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim colItems, objItem

    Set colItems = oWMIService.ExecQuery _
        ("Select * from Win32_UserAccount Where LocalAccount = True")

    For Each objItem in colItems
        If (Right(objItem.SID,4) = "-500") Then
            GetAdminName = objItem.Name
            Exit For
        End If
    Next

    Set colItems = Nothing

End Function

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            RemoveAce(sDriveID)
' *** ------------------------------------------------------------------------------
' *** Purpose:        Removes the ACL from C:
' *** ------------------------------------------------------------------------------
' ***
Function RemoveAce(sDriveID)
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
    Dim sec, sd, Dacl, ace, oGroup,bAceExists

    ' ~~~ Flags: Specifies Inheritance
    Const ADS_ACEFLAG_INHERIT_ACE = &h2
    ' ~~~ Permission Type: Allow
    Const ADS_ACETYPE_ACCESS_ALLOWED = &h0

    bAceExists = 0

    Set sec = CreateObject("ADsSecurityUtility")
    Set sd = sec.GetSecurityDescriptor(sDriveID,1,1)
    Set Dacl = sd.DiscretionaryAcl
    For Each ace in Dacl
        If (Mid(ace.Trustee,InStrRev(ace.Trustee,"\")+1) = sGroupName) Then
            If(ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED )Then
                ace.accessmask = (ace.accessmask OR 6)
                bAceExists = 1
                Exit For
            End If
        End If
    Next

    If NOT bAceExists Then
        ' ~~~ Add a new ACE so Users group does not have create file/folder permission
        Set ace = CreateObject ("AccessControlEntry")
        ace.Trustee = "S-1-5-32-545"
        ace.AccessMask = &h6
        ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED
        ace.AceFlags = ADS_ACEFLAG_INHERIT_ACE
        dacl.addAce ace
    End If

    sd.DiscretionaryAcl = dacl
    sec.SetSecurityDescriptor sDriveID,1,sd,1

    Set ace  = Nothing
    Set sec  = Nothing
    Set sd   = Nothing
    Set Dacl = Nothing

End Function

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            AddAce(sDriveID)
' *** ------------------------------------------------------------------------------
' *** Purpose:        Add's an ACL to C: for denying create file/folder access
' *** ------------------------------------------------------------------------------
' ***
Function AddAce(sDriveID)
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim sec, sd, Dacl, ace,aceTemp,colGroups, oGroup

    ' ~~~ Permission Type: Allow
    Const ADS_ACETYPE_ACCESS_ALLOWED = &h0

    Set sec = CreateObject("ADsSecurityUtility")
    Set sd = sec.GetSecurityDescriptor(sDriveID,1,1)
    Set Dacl = sd.DiscretionaryAcl

    Set colGroups = Nothing

    For Each ace in Dacl
        If (Mid(ace.Trustee,InStrRev(ace.Trustee,"\")+1) = sGroupName) Then
            If(ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED )Then
                If (ace.accessmask AND 6) <> 0 then
                    set aceTemp = ace
                    aceTemp.accessmask = ace.accessmask AND 16777209
                    dacl.removeAce ace
                    sd.DiscretionaryAcl = dacl
                    sec.SetSecurityDescriptor sDriveID,1,sd,1
                    If (aceTemp.accessmask AND 1048575) <> 0 Then
                        dacl.AddAce aceTemp
                        sd.DiscretionaryAcl = dacl
                        sec.SetSecurityDescriptor sDriveID,1,sd,1
                    End If
                End If
            End if
        End if
    Next

    Set ace  = Nothing
    Set sec  = Nothing
    Set sd   = Nothing
    Set Dacl = Nothing

End Function

' ***
' *** ------------------------------------------------------------------------------
' *** Name:            GetAceStatus(sDriveID)
' *** ------------------------------------------------------------------------------
' *** Purpose:            Returns 1 If ACL is set for C: else returns 0
' *** ------------------------------------------------------------------------------
' ***
Function GetAceStatus(sDriveID)
    If NOT DEBUG Then On Error Resume Next Else On Error Goto 0

    Dim sec,sd, Dacl, ace,colGroups, oGroup, objSID
    Dim bCreateFolder,bCreateFile
    GetAceStatus = 0
    bCreateFile = False
    bCreateFolder = False

    ' ~~~ Permission Type: Allow
    Const ADS_ACETYPE_ACCESS_ALLOWED = &h0

    Set sec = CreateObject("ADsSecurityUtility")
    Set sd = sec.GetSecurityDescriptor(sDriveID,1,1)
    Set Dacl = sd.DiscretionaryAcl

    Set objSID = oWMIService.Get("Win32_SID='" & "S-1-5-32-545" & "'")
    sGroupName = objSID.AccountName
    Set objSID = Nothing

    For Each ace in Dacl
        If (Mid(ace.Trustee,InStrRev(ace.Trustee,"\")+1) = sGroupName) Then
            If(ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED )Then
                If ((ace.accessmask AND 2) = 2 ) Then bCreateFile = True
                  If ((ace.accessmask AND 4) = 4 ) Then bCreateFolder = True
            End if
        End if
    Next

    If (bCreateFile = False) and (bCreateFolder = False) then
        GetAceStatus = 1
    End if
    Set ace  = Nothing
    Set sec  = Nothing
    Set sd   = Nothing
    Set Dacl = Nothing

End Function