Submitted By: Rob Haupt

Reports any changes to the Uninstall Key in the Registry. If a Program is added or Removed. The script exports the Uninstall key and then waits for a change. Once a change occurs it compares the values in exported key to the values in the new key.

Visual Basic
Edit|Remove
'Sets up needed resources/variables/constants
Set wmiServices = GetObject("winmgmts:root/default")
Set wmiSink = WScript.CreateObject("WbemScripting.SWbemSink", "SINK_")
Set objFSO = CreateObject("Scripting.FileSystemObject")
StrFileName = "C:\Uninstall.log"
StrCompareFile = "C:\Uninstall.cmp"
Const ForWriting = 2, ForReading = 1
Const HKEY_LOCAL_MACHINE = &H80000002

'Creates a sink on the Uninstall Log
wmiServices.ExecNotificationQueryAsync wmiSink,_
    "SELECT * FROM RegistryTreeChangeEvent WHERE Hive= 'HKEY_LOCAL_MACHINE' AND RootPath='SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall'"
 
'Will create a log of the registry if it doesn't exist
if Not objFSO.FileExists(StrFileName) Then
  Set objTextFile = objFSO.CreateTextFile(StrFileName)
  Set objTextFile = Nothing
  Set objTextFile = objFSO.OpenTextFile(StrFileName,ForWriting)
  OutToFile(objTextFile)
  objTextFile.Close
 End If
 
'continuous loop
While(1)
    WScript.Sleep 1000
Wend
 
'Responds if registry changes
Sub SINK_OnObjectReady(wmiObject, wmiAsyncContext)
 WScript.Echo "Received Event"
 Set objTextFile = objFSO.CreateTextFile (StrCompareFile)
 Set objTextFile = Nothing
 Set objTextFile = objFSO.OpenTextFile(StrCompareFile,ForWriting)
 OutToFile(objTextFile)
 objTextFile.Close
 CompareFiles()
 objFSO.DeleteFile(StrFileName)
 objFSO.MoveFile StrCompareFile, StrFileName
End Sub


'Sub routine that outputs the registry
Sub OutToFile(objTxt)

 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
 strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
 oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes
 
 For i=0 To UBound(arrValueNames)
     StrText = arrValueNames(i)    
     oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "DisplayName",strName
     oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "DisplayVersion",strVersion
     StrText = arrValueNames(i) & ";" & StrName & ";" & StrVersion
     objTxt.WriteLine(StrText)
 Next
End Sub

'Compares the two files for differences
Sub CompareFiles()
 Set objTextFile = objFSO.OpenTextFile(StrFileName,ForReading)
 Set objTextFile2 = objFSO.OpenTextFile(StrCompareFile, ForReading)
 redim List(1), List2(1)
 j=0
 k=0
 Do Until objTextFile.AtEndOfStream
  ReDim Preserve List(j)
  List(j) = objTextFile.ReadLine
  j=j+1
 Loop
 
 Do Until objTextFile2.AtEndOfStream
  ReDim Preserve List2(k)
  List2(k) = objTextFile2.ReadLine
  k=k+1
 Loop
 objTextFile.Close
 objTextFile2.Close
 For i = 0 to j-1
  For L = 0 to k-1
   if List(i) = List2(L) Then
    List2(L) = "FOUND"
    List(i) = "FOUND"
   End If
  Next
 Next
 StrReport = ""
 For i = 0 to j-1
  if List(i) <> "FOUND" Then
   arrText = Split(List(i), ";")
   StrReport = StrReport & "Key Missing: " & arrText(0) & vbCrLf
   StrReport = StrReport & "      -Name: " & arrText(1) & vbCrLf
   StrReport = StrReport & "   -Version: " & arrText(2) & vbCrLf
  End If
 Next
 For i = 0 to k-1
  if List2(i) <> "FOUND" Then
   arrText = Split(List2(i), ";")
   StrReport = StrReport & "Key Added: " & arrText(0) & vbCrLf
   StrReport = StrReport & "    -Name: " & arrText(1) & vbCrLf
   StrReport = StrReport & " -Version: " & arrText(2) & vbCrLf
  End If
 Next
 
 'Modify code between asterisks to report
 '****
     WScript.Echo StrReport
 '****
End Sub