Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- On Error Resume Next
- ' Declare contstants.
- Const HKLM = &H80000002
- ' Declare variables.
- strComputer = "."
- strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
- strLogPath = "C:\output.log"
- ' Set objects
- Set oDic = CreateObject("Scripting.Dictionary")
- 'Rem out the next 2 lines below
- 'Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
- ' strComputer & "\root\default:StdRegProv")
- 'Add the next 7 lines below for 64bit registry
- Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
- Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
- ' Set the registry provider to the 64-bit registry provider
- objCtx.Add "__ProviderArchitecture", 64
- Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
- Set oReg = objServices.Get("StdRegProv")
- 'MsgBox "Enumerating the subkeys of " & strKeyPath & " in the 64-bit registry..."
- ' Enumerate subkeys into an array.
- oReg.EnumKey HKLM, strKeyPath, arrSubKeys
- ' Get data from each subkey.
- For Each subkey In arrSubKeys
- subKeyPath = strKeyPath & "\" & subkey
- oReg.GetStringValue HKLM,subKeyPath,"DisplayName",strValue
- oReg.GetStringValue HKLM,subKeyPath,"UninstallString",strValue2
- ' Test for non-blank values: we want only non-blank values.
- If strValue <> "" Then
- If strValue2 <> "" Then
- ' Add data to dictionary.
- strValue2 = Replace(strValue2,"msiexec.exe /i","msiexec.exe /x")
- oDic.Add strValue, strValue2
- End If
- End If
- Next
- ' Sort dictionary by key name (the program name).
- Set oDic = SortDictionary(oDic, 1)
- ' Convert dictionary into arrays for processing.
- ItemsArray = oDic.Items
- KeysArray = oDic.Keys
- ' Create Log File
- Set myFSO = CreateObject("Scripting.FileSystemObject")
- Set LogOutput = myFSO.OpenTextFile(strLogPath, 8, True)
- ' Size the array and step through each element.
- intCount = oDic.Count
- For i = 0 To intCount
- LogOutput.WriteLine("Program: " & KeysArray(i))
- LogOutput.WriteLine("Uninstall: " & ItemsArray(i))
- LogOutput.WriteLine(" ")
- Next
- LogOutput.Close
- ' Declare function to sort dictionary.
- Function SortDictionary(objDict, intSort)
- ' Description:
- ' Sorts a dictionary by either key or item
- ' Parameters:
- ' objDict - the dictionary to sort
- ' intSort - the field to sort (1=key, 2=item)
- ' Returns:
- ' A dictionary sorted by intSort
- ' declare constants
- Const dictKey = 1
- Const dictItem = 2
- ' declare our variables
- Dim strDict()
- Dim objKey
- Dim strKey,strItem
- Dim X,Y,Z
- ' get the dictionary count
- Z = objDict.Count
- ' we need more than one item to warrant sorting
- If Z > 1 Then
- ' create an array to store dictionary information
- ReDim strDict(Z,2)
- X = 0
- ' populate the string array
- For Each objKey In objDict
- strDict(X,dictKey) = CStr(objKey)
- strDict(X,dictItem) = CStr(objDict(objKey))
- X = X + 1
- Next
- ' perform a a shell sort of the string array
- For X = 0 To (Z - 2)
- For Y = X To (Z - 1)
- If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
- strKey = strDict(X,dictKey)
- strItem = strDict(X,dictItem)
- strDict(X,dictKey) = strDict(Y,dictKey)
- strDict(X,dictItem) = strDict(Y,dictItem)
- strDict(Y,dictKey) = strKey
- strDict(Y,dictItem) = strItem
- End If
- Next
- Next
- ' erase the contents of the dictionary object
- objDict.RemoveAll
- ' repopulate the dictionary with the sorted information
- For X = 0 To (Z - 1)
- objDict.Add strDict(X,dictKey), strDict(X,dictItem)
- Next
- End If
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement