Получить список установленного софта через vbs

Этим скриптом ежедневно машины сдают свой программный конфиг на сервер:

em BEGIN

const HKLM = &H80000002
on Error resume nextoutCon=right(LCase(wScript.FullName),11)="cscript.exe"

outFile=""
out_all=0

FMT=1
' 0 - Text
' 1 - CSV
' 2 - HTM

strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

Set objReg = GetObject("winmgmts://./root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys

S=""
T=""
T=out(T,"INSTDATE",11,FMT<>3)
T=out(T,"VER",8,FMT<>3)
T=out(T,"NAME",0,FMT<>3)
outstr(T)

for each strSubkey in arrSubkeys
  T=""
  AppName=""
  InstDate=""
  verMajor=""
  verMinor=""
  ver=""
  Siz=""

  if objReg.GetStringValue(HKLM, strKey & strSubkey, "DisplayName", AppName) <> 0 then
     objReg.GetStringValue HKLM, strKey & strSubkey, "QuietDisplayName", AppName
  end if

  if len(AppName)>0 then
     objReg.GetStringValue HKLM, strKey & strSubkey, "InstallDate", InstDate
     objReg.GetDWORDValue HKLM, strKey & strSubkey, "VersionMajor", verMajor
     objReg.GetDWORDValue HKLM, strKey & strSubkey, "VersionMinor", verMinor
     objReg.GetDWORDValue HKLM, strKey & strSubkey, "EstimatedSize", Siz

     ver=verMajor & "." & verMinor
     if ver="." then ver=""

     T=out(T,InstDate,11,FMT<>3)
     T=out(T,ver,10,FMT<>3)
     T=out(T,AppName,0,FMT<>3)
     outstr(T)
  end if
next
outEnd()

function out(Ret, T, N, Q)
  if IsNull(T) then T=""
  if Q then
     select case FMT
       case 0
         if N>0 then
            if N>len(T) then Ret=Ret & T & space(N-len(T))
            if N0 then Ret=Ret & ","
         Ret=Ret & qw(T)
       case 2
         if len(T)=0 then T=" "
         Ret=Ret & "
" & T & "

" & vbCrLf
     end select
  end if
  out=Ret
end function

sub outstr(text)
  if FMT=2 then
     text="
" & vbCrLf & text & "  

"
     if len(S)=0 then
        text="" & vbCrLf & "
" & vbCrLf & text
     end if
  end if

  if outCon then
     if len(outFile)=0 then
        wScript.echo text
     end if
  end if
  S=S & text & vbCrLf
end sub

sub outEnd
  T="


" & vbCrLf & "" & vbCrLf
  if FMT=2 then S=S & T

  if not outCon then
     if len(outFile)=0 then WScript.echo(S)
  else
     if FMT=2 then
        if len(outFile)=0 then WScript.echo T
     end if
  end if

  if len(outFile)>0 then
     set fso=CreateObject("Scripting.FileSystemObject")
     set file=fso.OpenTextFile(outFile, 2, true)
     file.write(S)
     file.close
  end if
end sub

function qw(T)
  qw=chr(34) & T & chr(34)
end function

(источник — с форума sysadmins.ru)