Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys

For Each subkey In arrSubKeys
    EnumerateValues (strKeyPath & "\" & subkey)
Next

Sub EnumerateValues(strSubKey)
    Dim DisplayName, UninstallString
    oReg.EnumValues HKEY_LOCAL_MACHINE, strSubKey, arrValueNames, arrValueTypes
On Error Resume Next
    For Each strValueName In arrValueNames
        oReg.GetStringValue HKEY_LOCAL_MACHINE, strSubKey, strValueName, strValue
        If UCase(strValueName) = "DISPLAYNAME" Then DisplayName = strValue
        If UCase(strValueName) = "UNINSTALLSTRING" Then UninstallString = strValue
    Next
    If DisplayName <> "" Then
    WScript.Echo (DisplayName & vbNewLine & ">  " & UninstallString)
    End If
End Sub