Scripting

I haven't tested this but have you tried "*" without quotes? - dugullett 10 years ago

You need to recurse through the files. Here's something you will be able to adapt by editing the 'StartProcessing' function:

(Note to Bob: this forum sooooooooooooooooooooo needs a 'CODE' tag!!!)
'// Run RegSvr32 against a folder and its sub-folders containing DLLs and OCXs
'// Programming obfuscation a speciality

Option Explicit

Dim blnResult
Dim blnIsCustomAction
Dim intIndex
Dim strMsg
Dim objFSO
Dim objWSHShell
Dim objRegistry
Dim objWMIService
Dim objEventSink
Dim lngProcessID
Dim strScriptFullName
Dim dicFiles
Dim dicArguments
Dim blnFailed
Dim objFailure
Dim dicFailures
Dim strOut
Dim blnProcessTerminated

Const intFSOForReading = 1
Const intFSOForWriting = 2
Const intFSOForAppending = 8
Const intFSOTristateFalse = 0
Const strNameSeparator = "|"
Const strBrowseForFolderTitle = "Select a folder to process"

strScriptFullName = WScript.ScriptFullName

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("Shell.Application")
Set dicArguments = CreateObject("Scripting.Dictionary")
Set dicFiles = CreateObject("Scripting.Dictionary")
Set dicFailures = CreateObject("Scripting.Dictionary")
Set objRegistry = New clsRegistry
Set objWMIService = GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!\\.\ROOT\CIMV2")

dicArguments.CompareMode = vbTextcompare '// Ignore case in command-line arguments

Call Main

Set objWMIService = Nothing
Set objFSO = Nothing
Set objWSHShell = Nothing
Set dicArguments = Nothing
Set dicFiles = Nothing
Set dicFailures = Nothing
Set objRegistry = Nothing

Sub Main
Dim objFolder
Dim strFolder
Dim strDest
Dim objFailure
Dim strFailureList

'//------------------------------------------------------------------------------------------------------------//
'// Force use of CScript
'//------------------------------------------------------------------------------------------------------------//
Call ForceCScriptExecution(True)

blnIsCustomAction = False

On Error Resume Next
If IsObject(Session) Then
'// We may have arrived here because error-trapping is off
If Err.Number = 0 Then
blnIsCustomAction = True
End If
End If

If Not IsObject(objRegistry) Then
Exit Sub
End If

On Error Goto 0

'// Get the folder you want to process and the target folder
Select Case WScript.Arguments.Count
Case 0
strFolder = BrowseForFolder(strBrowseForFolderTitle)
If Len(strFolder) = 0 Then
Exit Sub
End If

Case 1
strFolder = WScript.Arguments(0)

Case Else
strFolder = WScript.Arguments(0)

End Select

If Len(strFolder) = 0 Then
Exit Sub
End If

blnFailed = False

'// Create the Event Notification sink
Set objEventSink = CreateObject("WbemScripting.SWbemSink")

WScript.ConnectObject objEventSink,"EVENTSINK_"

blnProcessTerminated = False

Call ProcessFiles(".DLL", strFolder)
Call ProcessFiles(".OCX", strFolder)

If blnFailed Then
strMsg = "Failed to register the following files:" & vbCRLF
For Each objFailure In dicFailures
strFailureList = ""
strFailureList = strFailureList & dicFailures.Item(objFailure) & vbCRLF
Next

Call Say(strMsg & strFailureList, blnIsCustomAction)
End If

End Sub

Sub ProcessFiles(ByVal strExt, ByVal strSourceFolder)
Dim arrDictItems
Dim arrDictKeys
Dim strKey
Dim strItem

'// Don't even bother to start if the source of destination folders don't exist.
If Not objFSO.FolderExists(strSourceFolder) Then
strMsg = "The source folder '" & strSourceFolder & "' does not exist."
Call Say(strMsg, blnIsCustomAction)
Exit Sub
End If

'// Empty the dictionary
On Error Resume Next
dicFiles.RemoveAll
On Error Goto 0

strOut = ""
Call RecurseExtensions(objFSO.GetFolder(strSourceFolder), strExt)
'Call RecurseFiles(objFSO.GetFolder(strSourceFolder))

If IsEmpty(dicFiles) Then
Exit Sub
End If

'// Now that we have a dictionary, we can process the items in it
With dicFiles
arrDictKeys = .Keys
arrDictItems = .Items

For intIndex = 0 To .Count - 1
strKey = arrDictKeys(intIndex)
strItem = .Item(arrDictKeys(intIndex))

'WScript.Echo "Key = " & strKey & " Item = " & strItem
'// The data looks like this:
'// Path_to_file, Name_of_file, Size, File type
'// separator (see strNameSeparator)
'// Path_to_file, Name_of_file, Size, File type
'// etc

'// This next call is what makes this script reasonably generic:
'// just pass the data to a function which does what you want it to do

blnResult = StartProcessing(strItem)
Next
End With
End Sub

Sub RecurseExtensions(ByVal objFolderName, ByVal strExt)
Dim objSubFolders
Dim objSubFolder
Dim objFolder
Dim objFile
Dim strDetails
Dim intElement
Dim strFolderName
Dim strExtension

strFolderName = objFolderName.Path
Set objFolder = objWSHShell.Namespace(strFolderName)
If Err.Number <> 0 Then
Exit Sub
End If

'// Write the actual data elements for each file
For Each objFile in objFolder.Items
With dicFiles
If InStr(objFile.Name, ".") Then
strExtension = UCase(Mid(objFile.Name, InStrRev(objFile.Name, "." ) ) )
If UCase(strExt) = UCase(strExtension) Then
Call Say("Adding " & objFolder.GetDetailsOf(objFile, 0) & " for processing", blnIsCustomAction)
If strOut <> "" Then
strOut = strOut & strNameSeparator
End If

strOut = strOut & strFolderName

'// We're not interested in the rest of this junk
'For intElement = 0 to 37
For intElement = 0 To 2
If strOut <> "" Then
strOut = strOut & ","
End If
strOut = strOut & Replace(objFolder.GetDetailsOf(objFile, intElement), ",", "")
Next

If Not .Exists(strExtension) Then
.Add strExtension, strOut
Else
.Item(strExtension) = strOut
End If
End If
End If
End With
Next

'// Check for any sub-folders and recursively process them
Set objSubFolders = objFolderName.SubFolders
For Each objSubFolder In objSubFolders
If LCase(objSubFolder.Name) <> "recycled" Then
Call RecurseExtensions(objSubFolder, strExt)
End If
Next

'// Just cosmetic padding for output
Call Say(String(2, vbCRLF), blnIsCustomAction)

Set objFile = Nothing
Set objFolder = Nothing
End Sub

Function StartProcessing(ByVal strData)
Dim arrData
Dim strItem
Dim strPath
Dim strName
Dim strSize
Dim strType
Dim objFile
Dim strSourceFile
Dim strTextToSearch
Dim objTextStream
Dim blnCanBeRegistered
Dim blnRanRegSvr32

Const strTextToFind = "DllRegisterServer"

StartProcessing = False

arrData = Split(strData, strNameSeparator)

For intIndex = 0 To UBound(arrData)
strItem = arrData(intIndex)

'WScript.Echo strItem
'Call Say("Processing " & strItem, blnIsCustomAction)

'// Split the data into an array
strPath = Split(strItem, ",")(0)
strName = Split(strItem, ",")(1)
strSize = Split(strItem, ",")(2)
strType = Split(strItem, ",")(3)

strSourceFile = strPath & "\" & strName

With objFSO
Set objFile = .GetFile(strSourceFile)
Set objTextStream = objFile.OpenAsTextStream(intFSOForReading, intFSOTristateFalse)

Call Say(vbTAB & "Checking for 'DLLRegisterServer' entry point in " & strName, blnIsCustomAction)
strTextToSearch = objTextStream.Read(objFile.Size)

blnCanBeRegistered = False
If InStr(strTextToSearch, strTextToFind) > 0 Then
blnCanBeRegistered = True
Call Say(String(2, vbTAB) & "'DLLRegisterServer' entry point found, registering file", blnIsCustomAction)
blnRanRegSvr32 = RunRegSvr32(strSourceFile)
If Not blnRanRegSvr32 Then
If blnRanRegSvr32 = -99 Then
Exit Function
Else
blnFailed = True
dicFailures.Add strSourceFile, strSourceFile
End If
End If
End If

Set objTextStream = Nothing
Set objFile = Nothing
End With
Next

StartProcessing = True

End Function

Function RunRegSvr32(ByVal strSource)
Dim blnLocateWise
Dim strPath
Dim strName
Dim strArguments
Dim intSepPos
Dim blnProcessCreated

RunRegSvr32 = False

'// Add quote marks to paths if necessary
If InStr(strSource, Chr(32)) > 0 Then
strSource = Chr(34) & strSource & Chr(34)
End If

intSepPos = InStrRev(strSource, "\")
If intSepPos = 0 Then
strMsg = "There is a problem with the definition of the source folder (no backslash in path)." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// Call RegSvr32
strPath = "C:\Windows\System32"
strName = "RegSvr32.EXE"
strArguments = "/S" & strSource

blnProcessCreated = ProcessLaunch(strPath & "\" & strName & " " & strArguments, strPath)
If Not blnProcessCreated Then
Exit Function
End If

Call Say(String(3, vbTAB) & strSource & " registered" & vbCRLF, blnIsCustomAction)

RunRegSvr32 = True
End Function

Function LocateWise(ByRef strWisePath)

Dim strHive
Dim strKey
Dim strSubKey
Dim strValue
Dim blnResult_Wise
Dim strLocation
Dim strLocationCheck
Dim blnLocationsMatch
Dim intEXEPos

'// Naturally, being a DeepNet script, we search one location then check against another.
'// Never, EVER assume...

LocateWise = False

blnResult_Wise = objRegistry.Connect(".")
If blnResult_Wise Then
With objRegistry

'// No good - only returns one folder up from what we want to know
'strHive = "HKCU"
'strKey = "Software\Wise Solutions\Install"
'strSubKey = "Wise Package Studio 7"
'strValue = "WPSDir"

strHive = "HKCU"
strKey = "Software\Classes\Msi.Package\shell\EditWPS"
strSubKey = "command"
strValue = ""

blnResult_Wise = .ExistKey(strHive, strKey, strSubKey)
If Not blnResult_Wise Then
'// Too serious for us to get involved. Flag an error and exit
strMsg = "Registry key '" & strHive & "\" & strKey & "\" & strSubKey & " does not exist." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'//
'// Serious bug!
'// The WMI EnumValues method returns Null if the only value which exists in a key is the default one
'// i.e. the one which RegEdit displays as "(Default)"

'// blnResult_Wise = .ExistValue(strHive, strKey & "\" & strSubKey, strValue)
'// If Not blnResult_Wise Then
'// '// Too serious for us to get involved. Flag an error and exit
'// strMsg = "Registry value '" & strHive & "\" & strKey & "\" & strSubKey & "\" & strValue & " does not exist." & vbCRLF
'// strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
'// Call Say(strMsg, blnIsCustomAction)
'// Exit Function
'// End If

'//
'// It's been that way since Win2K (apparently) and, at the time of writing (July 2007), is present in Vista.
'// See http://www.eggheadcafe.com/software/aspnet/30166439/default-value-bug-in-stdr.aspx
'// Superb...
'//

'// Now read the actual data and store it in strLocation
blnResult_Wise = .ReadValue(strHive, strKey & "\" & strSubKey, strValue)
If blnResult_Wise Then
strLocation = .get_RegResult
Else
strMsg = "Failed to read value '" & strHive & "\" & strKey & "\" & strSubKey & "\" & strValue & "." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// Before we can use strLocation, we need to throw away the executable name at the end
intEXEPos = InStr(UCase(strLocation), "WFWI.EXE")
If intEXEPos = 0 Then
strMsg = "Unable to extract path to Wise executables from registry data." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// We subtract only one, to retain the trailing backslash
strLocation = Left(strLocation, (intEXEPos - 1))

'// Throw away any leading quote marks
If Left(strlocation, 1) = Chr(34) Then
strlocation = Right(strlocation, Len(strlocation) - 1)
End If

'// Now get the registry stuff we can double-check against (Paranoid? Moi?
strHive = "HKCR"
strKey = "Applications\WfWI.exe\shell\EditWPS"
strSubKey = "command"
strValue = ""

blnResult_Wise = .ExistKey(strHive, strKey, strSubKey)
If Not blnResult_Wise Then
'// Too serious for us to get involved. Flag an error and exit
strMsg = "Registry key '" & strHive & "\" & strKey & "\" & strSubKey & " does not exist." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If


'//
'// Serious bug!
'// The WMI EnumValues method returns Null if the only value which exists in a key is the default one
'// i.e. the one which RegEdit displays as "(Default)"

'// blnResult_Wise = .ExistValue(strHive, strKey & "\" & strSubKey, strValue)
'// If Not blnResult_Wise Then
'// '// Too serious for us to get involved. Flag an error and exit
'// strMsg = "Registry value '" & strHive & "\" & strKey & "\" & strSubKey & "\" & strValue & " does not exist." & vbCRLF
'// strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
'// Call Say(strMsg, blnIsCustomAction)
'// Exit Function
'// End If

'//
'// Been that way since Win2K (apparently) and, at the time of writing (July 2007), is present in Vista.
'// See http://www.eggheadcafe.com/software/aspnet/30166439/default-value-bug-in-stdr.aspx
'// Superb...
'//

'// Now read the actual data and store it in strLocationCheck
blnResult_Wise = .ReadValue(strHive, strKey & "\" & strSubKey, strValue)
If blnResult_Wise Then
strLocationCheck = .get_RegResult
Else
strMsg = "Failed to read value '" & strHive & "\" & strKey & "\" & strSubKey & "\" & strValue & "." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// Before we can use strLocationCheck, we need to throw away the executable name at the end
intEXEPos = InStr(UCase(strLocationCheck), "WFWI.EXE")
If intEXEPos = 0 Then
strMsg = "Unable to extract path to Wise executables from registry data." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// We subtract only one, because strLocation will have a trailing backslash so we want to leave this one intact
strLocationCheck = Left(strLocationCheck, (intEXEPos - 1))

'// Throw away any leading quote marks
If Left(strlocationCheck, 1) = Chr(34) Then
strlocationCheck = Right(strlocationCheck, Len(strlocationCheck) - 1)
End If

'// The key and values all exist so now we need to check that they're the same.
blnResult_Wise = StringMatch(strLocation, strLocationCheck, blnLocationsMatch)
If Not blnLocationsMatch Then
strMsg = "Unable to match locations for Wise executables." & vbCRLF
strMsg = strMsg & "This is a serious configuration error. Contact the Helpdesk." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// If we get here, everything should be set up OK so use the first location as Wise path
LocateWise = True
strWisePath = strLocation
End With
End If
End Function

Sub RecurseFiles(ByVal objFolderName)
Dim objSubFolders
Dim objSubFolder
Dim objFolder
Dim objFile
Dim strOut
Dim intElement
Dim strFolderName

strFolderName = objFolderName.Path
Set objFolder = objWSHShell.Namespace(strFolderName)
If Err.Number <> 0 Then
Exit Sub
End If

'// Write the actual data elements for each file
For Each objFile in objFolder.Items
Call Say("Processing " & objFolder.GetDetailsOf(objFile, 0), blnIsCustomAction)
If strOut <> "" Then
strOut = strOut & vbCrLf
End If

strOut = strOut & strFolderName

'// We're not interested in the rest of this junk
'For intElement = 0 to 37
For intElement = 0 To 2
If strOut <> "" Then
strOut = strOut & ","
End If
strOut = strOut & Replace(objFolder.GetDetailsOf(objFile, intElement), ",", "")
Next

Call AddLineToDictionary(strOut)
strOut = ""
Next

'// Check for any sub-folders and recursively process them
Set objSubFolders = objFolderName.SubFolders
For each objSubFolder in objSubFolders
If LCase(objSubFolder.Name) <> "recycled" Then
Call RecurseFiles(objSubFolder)
End If
Next
End Sub

'//=========================================================================================================
'// Name: StringMatch
'// Purpose: Checks if two strings match
'// Why not use 'If strFirst = strSecond', you're asking?
'// Well, the 'Equals' operator :
'// - is not very fast (at string comparison)!
'// - compares strings left to right and is smart enough to stop comparing when it spots the first difference, but
'// - is too dumb to first do the most obvious test: comparing the lengths of the strings!
'// Input: strFirst - the first string
'// strSecond - the second string
'// blnMatch - a Boolean indicating whether or not the strings matched
'// Output: None
'// Returns: True/False
'//
'//=========================================================================================================
Function StringMatch(ByVal strFirst, ByVal strSecond, ByRef blnMatch)

StringMatch = True

blnMatch = False

If LenB(strFirst) = LenB(strSecond) Then
blnMatch = (InStrB(1, strFirst, strSecond, vbBinaryCompare) <> 0)
End If

End Function

Function BrowseForFolder(ByVal strPrompt)
'// Uses "Shell.Application" (only present in Win98 and newer)
'// to bring up a file/folder selection window. Falls back to an
'// ugly input box under Win95.

'Shell32.Shell SpecialFolder constants
Const ssfPERSONAL = 5 '// My Documents
Const ssfDRIVES = 17 '// My Computer
Const ssfWINDOWS = 36 '// Windows
Const SFVVO_SHOWALLOBJECTS = 1
Const SFVVO_SHOWEXTENSIONS = 2

Const BIF_RETURNONLYFSDIRS = &H0001
Const BIF_EDITBOX = &H0010
Const BIF_VALIDATE = &H0020
Const BIF_NEWDIALOGSTYLE = &H0040

Dim objFolder
Dim lngView
Dim strPath

If Instr(TypeName(objWSHShell), "Shell") = 0 Then
BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(strScriptFullName))
Exit Function
End If

lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
lngView = lngView + BIF_NEWDIALOGSTYLE + BIF_VALIDATE + BIF_EDITBOX + BIF_RETURNONLYFSDIRS

strPath = ""

Set objFolder = objWSHShell.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
Err.Clear

On Error Resume Next
strPath = objFolder.ParentFolder.ParseName(objFolder.Title).Path

'// An error occurs if the user selects a drive instead of a folder
'// so handle it here
Select Case Err.Number
Case 0
BrowseForFolder = strPath
Case 424
'// User probably selected a drive. Let's see.
'// First, have a fall-back option
BrowseForFolder = objFolder.Title

strPath = objFolder.Title
If Len(strPath) > 0 Then
intIndex = InStr(strPath, ":")
If intIndex > 0 Then
strPath = Mid(strPath, intIndex - 1, 2) & "\"
End If
End If
Case Else
End Select

'// If the user *types (or pastes) in* an incorrect path, no error is raised
'// so handle it here
If Len(strPath) > 0 Then
'// Only process if something was entered/selected.
'// However, ignore '.' (use current folder) or '..' (use parent folder)
If strPath = "." Or strPath = ".." Then

BrowseForFolder = strPath
Exit Function
End If

If objFSO.FolderExists(strPath) Then
BrowseForFolder = strPath
Exit Function
End If

strMsg = "The folder '" & strPath & "' does not exist."
Call Say(strMsg, blnIsCustomAction)
BrowseForFolder = ""
End If
On Error Goto 0
End Function

Sub Say(ByVal strMsgText, ByVal blnCustomAction)

If blnCustomAction Then
Dim objMSIRecord
Const msiMessageTypeFatalExit = &H00000000 '// Premature termination, possibly fatal out of memory.
Const msiMessageTypeError = &H01000000 '// Formatted error message, [1] is message number in Error table.
Const msiMessageTypeWarning = &H02000000 '// Formatted warning message, [1] is message number in Error table.
Const msiMessageTypeUser = &H03000000 '// User request message, [1] is message number in Error table.
Const msiMessageTypeInfo = &H04000000 '// Informative message for log, not to be displayed.
Const msiMessageTypeFilesInUse = &H05000000 '// List of files in use that need to be replaced.
Const msiMessageTypeResolveSource = &H06000000 '// Request to determine a valid source location.
Const msiMessageTypeOutOfDiskSpace = &H07000000 '// Insufficient disk space message.
Const msiMessageTypeActionStart = &H08000000 '// Start of action,
'// [1] action name,
'// [2] description,
'// [3] template for ACTIONDATA messages.
Const msiMessageTypeActionData = &H09000000 '// Action data. Record fields correspond to the template of ACTIONSTART message.
Const msiMessageTypeProgress = &H0A000000 '// Progress bar information. See the description of record fields below.
Const msiMessageTypeCommonData = &H0B000000 '// To enable the Cancel button set [1] to 2 and [2] to 1.
'// To disable the Cancel button set [1] to 2 and [2] to 0

Set objMSIRecord = Session.Installer.CreateRecord(0)
objMSIRecord.StringData(0) = strMsgText
Session.Message msiMessageTypeError, objMSIRecord
Set objMSIRecord = Nothing
Else
WScript.Echo strMsgText
End If
End Sub

Sub AddLineToDictionary(ByVal strText)
Dim strPath
Dim strName
Dim strType
Dim strSize

strPath = Split(strText, ",")(0)
strName = Split(strText, ",")(1)
strSize = Split(strText, ",")(2)
strType = Split(strText, ",")(3)

'// Include the path to make the key unique. Without it, subsequent keys wouldn't get added
'// because the key would already exist. I leave the path in the item because I can use
'// Split to get at it, rather than string manipulation of the key
dicFiles.Add strPath & "\" & strName, strSize & strNameSeparator & strType & strNameSeparator & strPath

End Sub

Function FileNameLikeMine(ByVal strFileExtension)
'// Returns a file name the same as the script name
'// except for the file extension.
Dim strExtension

strExtension = strFileExtension
If Len(strExtension) < 1 Then
strExtension = "txt"
End If

If strExtension = "." Then
strExtension = "txt"
End If

If Left(strExtension,1) = "." Then
strExtension = Mid(strExtension, 2)
End If

FileNameLikeMine = Left(strScriptFullName, InstrRev(strScriptFullName, ".")) & strExtension
End Function

Sub ForceCScriptExecution(ByVal blnQuoteArguments)
Dim objShellRun
Dim strArgument
Dim strArguments
Dim strCmdLine
Dim intIndex

'// If running in CScript, do nothing
If UCase(Right(WScript.FullName, 11)) = "CSCRIPT.EXE" Then
Exit Sub
End If

If WScript.Arguments.Count > 0 Then
strArguments = ""
'For Each strArgument In WScript.Arguments
' If Len(strArguments) = 0 Then
' strArguments = strArgument
' Else
' strArguments = strArguments & " " & strArgument
' End If
'Next

For intIndex = 0 To (WScript.Arguments.Count - 1)
If Len(strArguments) = 0 Then
strArguments = WScript.Arguments(intIndex)
Else
strArguments = strArguments & " " & WScript.Arguments(intIndex)
End If
Next

If blnQuoteArguments Then
strArguments = Chr(34) & strArguments & Chr(34)
End If
End If

'// If running in WScript, execute the script using CScript
'// and then quit this script
If UCase(Right(WScript.FullName, 11)) = "WSCRIPT.EXE" Then
Set objShellRun = CreateObject("WScript.Shell")
'objShellRun.Run "CSCRIPT.EXE """ & WScript.ScriptFullName & """", 1, False

strCmdLine = "CSCRIPT.EXE "

If InStr(WScript.ScriptFullName, " ") > 0 Then
strCmdLine = strCmdLine & Chr(34)
End If

strCmdLine = strCmdLine & WScript.ScriptFullName

If InStr(WScript.ScriptFullName, " ") > 0 Then
strCmdLine = strCmdLine & Chr(34)
End If

If Len(strArguments) > 0 Then
strCmdLine = strCmdLine & " "
strCmdLine = strCmdLine & strArguments
End If

objShellRun.Run strCmdLine, 1, False

Set objShellRun = Nothing
WScript.Quit
End If

'// If script engine is anything else, quit with an error
WScript.Echo "Unknown scripting engine."
WScript.Quit
End Sub

'/////////////////////////////////////////////////////////////////////
'//
'// Name: ParseArgs
'// Purpose: Parse the arguments using Split function and return as a dictionary object
'// Allows simple existence and value checks throughout the rest of the script.
'// The order that the switches are used on the command line does not matter.
'//
'// Syntax: You can use switches formatted in the following ways:
'// SWITCH=<VALUE>
'// SWITCH="<value with spaces>"
'// /SWITCH=<VALUE>
'// /SWITCH
'// SWITCH=value1;value2;value3
'//
'// Usage and notes: If a switch is present more than once, the *last* value is used
'//
'// Limitations: You cannot use "/switch value" syntax: "=" is required
'//
'/////////////////////////////////////////////////////////////////////
Sub ParseArgs
Dim arrArgument
Dim strArgument

On Error Resume Next
For Each strArgument In WScript.Arguments
If InStr(strArgument, "=") > 0 Then
arrArgument = Split(strArgument, "=", 2)

'/ If value is specified multiple times, last one wins
If dicArguments.Exists(Trim(arrArgument(0))) Then
dicArguments.Remove(Trim(arrArgument(0)))
End If

If UBound(arrArgument) >= 1 Then
dicArguments.Add Trim(arrArgument(0)), Trim(arrArgument(1))
Else
dicArguments.Add Trim(arrArgument(0)),""
End If
Else
dicArguments.Add strArgument
End If
Next
On Error Goto 0
End Sub

Function ProcessLaunch(ByVal strProcessName, ByVal strProcessPath)
Dim objProcess
Dim objStartup
Dim objConfig
Dim lngReturn

Const intSW_HIDE = 0 '// Hides the window and activates another window.
Const intSW_NORMAL = 1 '// Activates and displays a window.
'// If the window is minimised or maximised, the system restores it to the original size and position.
'// An application specifies this flag when displaying the window for the first time.
Const intSW_SHOWMINIMIZED = 2 '// Activates the window, and displays it as a minimised window.
Const intSW_SHOWMAXIMIZED = 3 '// Activates the window, and displays it as a maximised window.
Const intSW_SHOWNOACTIVATE = 4 '// Displays a window in its most recent size and position.
'// This value is similar to SW_SHOWNORMAL, except that the window is not activated.
Const intSW_SHOW = 5 '// Activates the window, and displays it at the current size and position.
Const intSW_MINIMIZE = 6 '// Minimises the specified window, and activates the next top level window in the Z order.
Const intSW_SHOWMINNOACTIVE = 7 '// Displays the window as a minimised window. This value is similar to SW_SHOWMINIMZED,
'// except that the window is not activated.
Const intSW_SHOWNA = 8 '// Displays the window at the current size and position. This value is similar to SW_SHOW,
'// except that the window is not activated.
Const intSW_RESTORE = 9 '// Activates and displays the window. If the window is minimised or maximised, the system
'// restores it to the=original size and position. An application specifies this flag when
'// restoring a minimised window.
Const intSW_SHOWDEFAULT = 10 '// Sets the show state based on the SW_ value that is specified in the STARTUPINFO structure
'// passed to the CreateProcess function by the program that starts the application.
Const intSW_FORCEMINIMIZE = 11 '// Windows Server 2003, Windows 2000, and Windows XP:
'// Minimises a window, even when the thread that owns the window is hung.
'// Only use this flag when minimising windows from a different thread.

ProcessLaunch = False

Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = intSW_NORMAL

Set objProcess = objWMIService.Get("Win32_Process")

'Err.Clear
lngReturn = objProcess.Create(strProcessName, strProcessPath, objConfig, lngProcessID)

If lngReturn = 0 Then
strMsg = strProcessName & " PID:" & lngProcessID & " created." & vbCRLF
Call Say(strMsg, blnIsCustomAction)
Else
strMsg = "Failed to launch " & strProcessName & vbCRLF
strMsg = strMsg & "Error " & lngReturn & ":"
Select Case lngReturn
Case 2
strMsg = strMsg & "Access denied."
Case 3
strMsg = strMsg & "Insufficient privilege."
Case 8
strMsg = strMsg & "Unknown failure."
Case 9
strMsg = strMsg & "Path not found."
Case 21
strMsg = strMsg & "Invalid parameter."
End Select

Call Say(strMsg, blnIsCustomAction)
Exit Function
End If

'// For this project, we don't need to watch the process
'Call WatchProcess(lngProcessID)
ProcessLaunch = True
End Function

'**************************************************************
Sub KillProcess(ByVal lngProcessID)

Dim strQuery
Dim objProcess
Dim colProcess

strQuery = "Select * from Win32_Process where ProcessID=" & lngProcessID

Set colProcess = objWMIService.ExecQuery(strQuery)
If colProcess.Count <> 0 Then
For Each objProcess In colProcess
objProcess.Terminate()

strMsg = "Process " & lngProcessID & " timed out " & Now() & vbCRLF
Call Say(strMsg, blnIsCustomAction)
objEventSink.Cancel()
blnProcessTerminated =True
Next
End If
End Sub

'**************************************************************
Sub WatchProcess(ByVal lngProcessID)

Dim strQuery

strQuery = "SELECT * FROM __InstanceOperationEvent " & "WITHIN 1 WHERE TargetInstance ISA 'Win32_Process' AND TargetInstance.ProcessID='" & lngProcessID & "'"

objWMIService.ExecNotificationQueryAsync objEventSink, strQuery
End Sub

'**************************************************************
Sub EVENTSINK_OnObjectReady(ByVal objInstance, ByVal objAsyncContext)

If objInstance.Path_.Class = "__InstanceDeletionEvent" Then
strMsg = "Process " & objInstance.TargetInstance.ProcessID & " terminated at " & Now() & vbCRLF
Call Say(strMsg, blnIsCustomAction)

objEventSink.Cancel()
blnProcessTerminated = True
WScript.Quit
End If

End Sub

Sub EVENTSINK_OnCompleted(ByVal objInstance, ByVal objAsyncContext)

strMsg = "ExecQueryAsync completed"
Call Say(strMsg, blnIsCustomAction)
blnProcessTerminated = True

End Sub

Class clsRegistry

'// This class makes it simple to manipulate the registry on the local or a remote computer.
'// Internally it uses the WMI StdRegProv class methods.
'//
'// It provides a simpler set of methods than the StdRegProv methods:
'//
'// * Rather than numeric values, this object's methods use string input: For example, "HKLM" instead of 0x80000002.
'//
'// * Rather than separate Get...Value() methods for each data type, it provides a single ReadValue() method.
'// The get_RegResult property will contain the registry value's data, and the get_RegValueType property
'// will contain the registry value's data type as a string (e.g. "REG_SZ").
'//
'// * Rather than separate Set...Value() methods for each data type, it provides a single WriteValue() method
'// that lets you specify the data type as a string parameter.
'//
'// * The DeleteKey() method provides a DeleteSubKeys parameter. If True, then it will attempt to delete all subkeys
'// of the specified subkey.
'//
'// * The ExistKey() and ExistValue() methods return True if the specified key or value exists in a specified subkey,
'// or False otherwise.
'//
'// This class also implements the EnumValues(), EnumValuesAndData(), and EnumKey() methods:
'//
'// * The array outputs of these methods are accessible from the EnumResult property, which returns a reference to a
'// Scripting.Dictionary object.
'//
'// * After calling the EnumValues() method, the EnumResult dictionary will contain the value names and types.
'// The types will be stored as strings (e.g. "REG_SZ").
'//
'// * After calling the EnumValuesAndData() method, the EnumDict dictionary will contain the value names and contents
'// of each value. If a value contains a REG_BINARY, the contents will be a string containing a series of the hex bytes
'// in the data (like the registry editor). If a value contains a REG_MULTI_SZ, the multiple strings will be separated
'// by a "|" character. This method exists mainly as a quick way for a program to output all of the values in a registry subkey.
'//
'// * After calling the EnumKey() method, the EnumResult dictionary will contain the names of the subkeys.
'// The "value" parts of the dictionary will be empty strings.
'//
'// * For JScript, the dictToJSArray() method converts a dictionary to a JScript array.

Dim REG_SZ
Dim REG_EXPAND_SZ
Dim REG_BINARY
Dim REG_DWORD
Dim REG_MULTI_SZ
Dim ERR_INVALID_DATA
Dim strSeparatorCharacter

Dim g_RegTypes
Dim g_EnumDict
Dim g_RegProv
Dim g_RegResult
Dim g_RegValueType

Private Sub Class_Initialize()

REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_MULTI_SZ = 7
ERR_INVALID_DATA = 13
strSeparatorCharacter = "|"

' Contains constants and some numbers for quick lookup.
Set g_RegTypes = CreateObject("Scripting.Dictionary")

' Dictionary object for EnumKey() and EnumValues().
Set g_EnumDict = CreateObject("Scripting.Dictionary")

' Case-insensitive key comparisons.
g_RegTypes.CompareMode = vbTextCompare
g_EnumDict.CompareMode = vbTextCompare

' Populate the dictionary with needed data.
With g_RegTypes
.Add "HKCR", &H80000000
.Add "HKEY_CLASSES_ROOT", &H80000000
.Add "HKCU", &H80000001
.Add "HKEY_CURRENT_USER", &H80000001
.Add "HKLM", &H80000002
.Add "HKEY_LOCAL_MACHINE", &H80000002
.Add "HKEY_USERS", &H80000003
.Add "HKEY_CURRENT_CONFIG", &H80000005
.Add "REG_SZ", REG_SZ
.Add REG_SZ, "REG_SZ"
.Add "REG_EXPAND_SZ", REG_EXPAND_SZ
.Add REG_EXPAND_SZ, "REG_EXPAND_SZ"
.Add "REG_BINARY", REG_BINARY
.Add REG_BINARY, "REG_BINARY"
.Add "REG_DWORD", REG_DWORD
.Add REG_DWORD, "REG_DWORD"
.Add "REG_MULTI_SZ", REG_MULTI_SZ
.Add REG_MULTI_SZ, "REG_MULTI_SZ"
End With

' No valid data yet
g_RegResult = Null
g_RegValueType = Null

End Sub

Private Sub Class_Terminate()
Set g_EnumDict = Nothing
Set g_RegTypes = Nothing
End Sub

' PROPERTY get_RegResult()
' Returns the result data from a registry operation.
Function get_RegResult()
get_RegResult = g_RegResult
End Function

' PROPERTY get_RegValueType()
' Returns the result data's data type.
Function get_RegValueType()
get_RegValueType = g_RegValueType
End Function

' PROPERTY get_EnumDict()
' Returns a reference to the dictionary populated by the Enum...() methods.
Function get_EnumDict()
Set get_EnumDict = g_EnumDict
End Function

' METHOD Connect()
' Connects to the specified computer using WMI; returns True for success,
' or the WMI error code if it fails. If the computer is already connected,
' it will not attempt to connect again and will return True.
Function Connect(ByVal ComputerName)
Dim Result

Connect = False

ComputerName = UCase(Trim(ComputerName))
If Left(ComputerName, 2) = "\\" Then
ComputerName = Mid(ComputerName, 3)
End If

On Error Resume Next

Set g_RegProv = GetObject("winmgmts:{impersonationlevel=impersonate}!//" & ComputerName & "/root/default:StdRegProv")
Result = Err.Number
On Error GoTo 0

If Err.Number <> 0 Then
Exit Function
End If

Connect = True
End Function

' If Condition is True, return TrueValue; otherwise, return FalseValue.
Function IIf(ByVal Condition, ByVal TrueValue, ByVal FalseValue)
If Condition Then
IIf = TrueValue
Else
IIf = FalseValue
End If
End Function

' METHOD CheckAccess()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' Required is a numeric value representing the desired access level.
' If the WMI CheckAccess method succeeded, update g_RegResult.
Function CheckAccess(ByVal HiveName, ByVal SubKeyName, ByVal Required)
Dim Result
Dim bGranted

CheckAccess = False

Result = g_RegProv.CheckAccess(g_RegTypes(HiveName), SubKeyName, Required, bGranted)

g_RegResult = IIf(Result = 0, bGranted, Null)
g_RegValueType = Null

If Result <> 0 Then
Exit Function
End If

CheckAccess = True
End Function

' METHOD CreateKey()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
Function CreateKey(ByVal HiveName, ByVal SubKeyName)
Dim Result

CreateKey = False

Result = g_RegProv.CreateKey(g_RegTypes(HiveName), SubKeyName)

If Result <> 0 Then
Exit Function
End If

CreateKey = True
End Function

' METHOD DeleteKey()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' If DeleteSubKeys is True, then the method will attempt to delete all
' subkeys of the specified subkey before deleting the specified subkey.
' If DeleteSubKeys is True and the method encounters an error deleting
' a subkey under the specified subkey, it will abort.
Function DeleteKey(ByVal HiveName, ByVal SubKeyName, ByVal DeleteSubKeys)
Dim Result
Dim strRegSubKey
Dim strRegKey
Dim Names
Dim I

DeleteKey = False

'// If the key isn't present, then DeleteKey will be True!

'// In order to use ExistKey, we have to split SubKeyName
'// at the final '\'. This is imposed on us by the way
'// that the WMI registry object works.

'// If there's no backslash in SubKeyName, we have to fail
I = InStrRev(SubKeyName, "\")
If I = 0 Then
Exit Function
End If

strRegSubKey = Left(SubKeyName, I - 1)
strRegKey = Right(SubKeyName, Len(SubKeyName) - I)

If Not ExistKey(HiveName, strRegSubKey, strRegKey) Then
DeleteKey = True
Exit Function
End If

If DeleteSubKeys Then
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
DeleteKey = DeleteKey(HiveName, _
SubKeyName & "\" & Names(I), DeleteSubKeys)
If DeleteKey <> 0 Then
Exit Function
End if
Next
End If
End If

Result = g_RegProv.DeleteKey(g_RegTypes(HiveName), SubKeyName)

If Result <> 0 Then
Exit Function
End If

DeleteKey = True
End Function

' METHOD WriteValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' ValueType is a string representing the value's type (e.g. "REG_SZ").
' If you specify "REG_BINARY" or "REG_MULTI_SZ" for the value type,
' RegData must contain a safearray (VB array) of data. If you are using
' JScript, you can use the toVBarray() method to convert the JScript
' array to a safearray, but keep in mind that it must be a zero-based
' array with contiguous elements.
Function WriteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName, ByVal ValueType, ByVal RegData)
Dim Result

WriteValue = False
If ValueName = "" Then
Result = g_RegProv.SetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Else
Select Case UCase(ValueType)
Case "REG_SZ"
Result = g_RegProv.SetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_EXPAND_SZ"
Result = g_RegProv.SetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_BINARY"
Result = g_RegProv.SetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_DWORD"
Result = g_RegProv.SetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_MULTI_SZ"
Result = g_RegProv.SetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case Else
Result = ERR_INVALID_DATA
End Select
End If

If Result <> 0 Then
Exit Function
End If

WriteValue = True
End Function

' METHOD ExistValue()
' Returns True if the specified value exists, or False if not.
Function ExistValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Exists
Dim Result
Dim Names
Dim Types
Dim I

Exists = False

Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)

If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Exists = UCase(Names(I)) = UCase(ValueName)
If Exists Then
Exit For
End If
Next
End If

ExistValue = Exists
End Function

' METHOD ReadValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' If the WMI method succeeds, the Result property will contain the
' registry data and the ValueType property will contain a string
' representing the data type (e.g. "REG_SZ").
Function ReadValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Result
Dim Names
Dim Types
Dim I
Dim RegData

ReadValue = False
' If ValueName is blank, retrieve the key's (Default) value (REG_SZ)
If ValueName = "" Then
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), SubKeyName, ValueName, RegData)
If Result = 0 Then
g_RegResult = RegData: g_RegValueType = "REG_SZ"
Else
g_RegResult = Null: g_RegValueType = Null
End If
Else
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
If UCase(Names(I)) = UCase(ValueName) Then
Select Case Types(I)
Case REG_SZ
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_SZ), Null)
Exit For
Case REG_EXPAND_SZ
Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_EXPAND_SZ), Null)
Exit For
Case REG_BINARY
Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_BINARY), Null)
Exit For
Case REG_DWORD
Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_DWORD), Null)
Exit For
Case REG_MULTI_SZ
Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_MULTI_SZ), Null)
Exit For
Case Else
Result = ERR_INVALID_DATA
g_RegResult = Null
g_RegValueType = Null
Exit For
End Select
End If
Next
g_RegResult = IIf(Result = 0, RegData, Null)
End If
End If

If Result <> 0 Then
Exit Function
End If

ReadValue = True
End Function

' METHOD DeleteValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
Function DeleteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Result

DeleteValue = False

'// If the value isn't present, then DeleteValue will be True!

If Not ExistValue(HiveName, SubKeyName, ValueName) Then
DeleteValue = True
Exit Function
End If

Result = g_RegProv.DeleteValue(g_RegTypes(HiveName), SubKeyName, ValueName)

If Result <> 0 Then
Exit Function
End If

DeleteValue = True
End Function

' METHOD ExistKey()
' Returns True if the specified subkey exists, or False if not.
Function ExistKey(ByVal HiveName, ByVal SubKeyName, ByVal KeyName)
Dim Exists
Dim Result
Dim Names
Dim I

Exists = False

Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)

If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Exists = UCase(KeyName) = UCase(Names(I))
If Exists Then
Exit For
End If
Next
End If

ExistKey = Exists
End Function

' METHOD EnumKey()
' Returns True for success, False for failure.
' Populates the EnumDict dictionary's key names with the subkeys in the
' specified subkey. The dictionary's value names will be blank strings.
Function EnumKey(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim I

EnumKey = False

Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)

g_EnumDict.RemoveAll

If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
g_EnumDict.Add Names(I), ""
Next
End If

'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumKey = True
End If

End Function

' METHOD EnumValues()
' Returns True for success, False for failure.
' Populates the EnumDict property's key/value pairs with
' the value entries and their corresponding data types.
Function EnumValues(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim Types
Dim I

EnumValues = False

Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)

g_EnumDict.RemoveAll

If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
g_EnumDict.Add Names(I), g_RegTypes(Types(I))
Next
End If

'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumValues = True
End If

End Function

' Returns the byte N in hexadecimal notation with a leading zero.
Function ToHex(ByVal N)
ToHex = IIf(N < &H10, "0" & Hex(N), Hex(N))
End Function

' METHOD EnumValuesAndData()
' Returns True for success, False for failure.
' Populates the EnumDict property's key/value pairs with
' the value entries and their contents. For REG_BINARY and REG_MULTI_SZ
' values, they will be represented as strings with | strSeparatorCharacters.
Function EnumValuesAndData(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim Types
Dim I
Dim RegData
Dim J
Dim S

EnumValuesAndData = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)

g_EnumDict.RemoveAll

If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Select Case Types(I)
Case REG_SZ
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_EXPAND_SZ
Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_BINARY
Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
S = ""
For J = 0 To UBound(RegData)
S = IIf(S <> "", S & " " & ToHex(RegData(J)), ToHex(RegData(J)))
Next
g_EnumDict.Add Names(I), S
End If
Case REG_DWORD
Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_MULTI_SZ
Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
S = ""
For J = 0 To UBound(RegData)
S = IIf(S <> "", S & strSeparatorCharacter & RegData(J), RegData(J))
Next
g_EnumDict.Add Names(I), S
End If
Case Else
Result = ERR_INVALID_DATA
End Select
Next
End If

'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumValuesAndData = True
End If

End Function

End Class - anonymous_9363 10 years ago