Option Explicit

const HKCU = &H80000001
const FWF_SINGLESEL = &H00000040

dim objReg

msgbox "Close all Explorer windows before continuing."

Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

FixBags

FixDefaults

msgbox "Done!  Logoff and Logon before opening any Explorer windows."


'===================================================================================================
Sub FixBags

const BagsPath = "Software\Classes\Local Settings\Software\Microsoft\Windows\Shell\Bags"

dim iFFlags
dim strBag, strShellPath, strFolderID, strKeyPath
dim arrBags, arrFolderIDs

objReg.EnumKey HKCU, BagsPath, arrBags

For Each strBag in arrBags
    strShellPath = BagsPath & "\" & strBag & "\Shell"
    If RegKeyExists(strShellPath) Then
         If objReg.EnumKey(HKCU, strShellPath, arrFolderIDs) = 0 Then
              If Not IsNull(arrFolderIDs) Then
                  For each strFolderID in arrFolderIDs
                      strKeyPath = strShellPath & "\" & strFolderID
                      If objReg.GetDWORDValue(HKCU, strKeyPath, "FFlags", iFFlags) = 0 Then
                          If (iFFlags AND FWF_SINGLESEL) <> 0 Then
                              iFFlags = (iFFlags AND (NOT(FWF_SINGLESEL)))
                              If objReg.SetDWORDValue(HKCU, strKeyPath, "FFlags", iFFlags) <> 0 Then
                                  Msgbox "SetDWORDValue Failed"
                              End If
                          End If
                      End If
                  Next
              End If
         End If
    End If
Next

End Sub
'===================================================================================================

'===================================================================================================

Sub FixDefaults

const StreamsPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\Streams\Defaults"

dim bytTemp, bytFFlags
dim iByteIndex
dim strFolderID, strViewSettings, strSearch
dim arrFolderIDs, arrRegTypes, arrViewSettings


If (objReg.EnumValues(HKCU, StreamsPath, arrFolderIDs, arrRegTypes) <> 0) Or IsNull(arrFolderIDs) Then
    Exit Sub
End If

For Each strFolderID in arrFolderIDs

    If objReg.GetBinaryValue(HKCU, StreamsPath, strFolderID, arrViewSettings) = 0 Then

        '--- Convert Byte array to string to facilitate searching ---

        strViewSettings = ""
        For each bytTemp in arrViewSettings
           strViewSettings = strViewSettings & chr(bytTemp)
        Next

        strSearch = "F" & chr(0) & "F" & chr(0) & "l" & chr(0) & "a" & chr(0) & "g" & chr(0) & "s"

        iByteIndex = instr(strViewSettings, strSearch) + 17

        bytFFlags = arrViewSettings(iByteIndex)
        If (bytFFlags AND FWF_SINGLESEL) <> 0 Then
           arrViewSettings(iByteIndex) = (bytFFlags AND NOT(FWF_SINGLESEL))
           If objReg.SetBinaryValue(HKCU, StreamsPath, strFolderID, arrViewSettings) <> 0 Then
               msgbox "SetBinaryValue Failed"
           End If
        End If


    End If
Next

End Sub


'===================================================================================================

Function RegKeyExists(sRegKey)

dim aValueNames, aValueTypes

sRegKey = Trim(sRegKey)

If objReg.EnumValues(HKCU, sRegKey, aValueNames, aValueTypes) = 0 Then
    RegKeyExists = True
Else
    RegKeyExists = False
End If

End Function