Query Installed Apps a Different Way

For whatever reason, in some environments, a WMI query of Win32_Product is God-awful slow.  I've seen this on Windows 7 and Windows 7 SP1 clients, as well as on Windows Server 2008 and 2008 R2.  The symptom can be seen from WIM script, WBEM, and using WMIC from a command console with very similar results:  The query hangs for 20-25 seconds and then begins executing in spurts.  Other Win32 classes work fine, from what I've seen, it's just Win32_Product for some reason.  One workaround is to dump a registry output file, and scrub it to make a "clean" output file.  You can port this to PowerShell or KiXtart if you want (or whatever you prefer, I really don't care as long as you're happy and that makes me happy so we're all happy. yay!)

'****************************************************************
' Filename..: installedApps.vbs
' Author....: David M. Stein aka Scriptzilla aka dipshit
' Date......: 10/20/2011
' Purpose...: save query of installed applications to local file
'****************************************************************

Const strInputFile  = "c:\regoutput.txt"
Const strOutputFile = "c:\installedApps.txt"

Const ForReading = 1
Const ForWriting = 2
Const adVarChar = 200

cmd = "reg query hklm\software\microsoft\windows\currentversion\uninstall /s >" & strInputFile

On Error Resume Next

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

wscript.echo "info: executing shell command to create temp file..."

objShell.Run "cmd /c " & cmd, 7, True

wscript.echo "info: getting temp file for input..."

If objFSO.FileExists(strInputFile) Then
 wscript.echo "info: reading temp file..."
 Set objFile = objFSO.OpenTextFile(strInputFile, ForReading)
 Set objFile2 = objFSO.CreateTextFile(strOutputFile, True)

 Set rs = CreateObject("ADODB.RecordSet")

 rs.CursorLocation = adUseClient
 rs.Fields.Append "productname", adVarChar, 255
 rs.Open

 Do Until objFile.AtEndOfStream
     strLine = objFile.Readline
     If Left(strLine, 25) = "    DisplayName    REG_SZ" Then
      strOutput = Trim(Mid(strLine, 30))
   rs.AddNew
   rs.Fields("productname").value = strOutput
   rs.Update
     End If
 Loop
 
 rs.Sort = "productname"
 
 Do Until rs.EOF
     objFile2.WriteLine(rs.Fields("productname").value)
  rs.MoveNext
 Loop
 rs.CLose
 Set rs = Nothing
 
 objFile.Close
 objFile2.Close
 wscript.echo "info: finished scrubbing input to new output file"
Else
 wscript.echo "fail: temp file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing
'----------------------------------------------------------------

wscript.echo "info: processing complete!"