'KNOWN ISSUE: If Application name conatins '-' symbol then e-mail alert containing software list will be sent all on one line instead of each packet on a single line
variable=InstalledApplications(".")
'WScript.Echo strConvert(variable,"Windows-1251","cp866")
Const ForReading = 1
zabbix_dir="C:\zabbix\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Create old file if does not exist
If objFSO.FileExists(zabbix_dir&"uDiffPrograms_old.txt")=0 Then
Set objFile4 = objFSO.CreateTextFile(zabbix_dir&"uDiffPrograms_old.txt")
objFile4.WriteLine variable
objFile4.Close
Call ConvertCharsetFile("0x0")
WScript.Quit
End if
'Create 'new' file
Set objFile3 = objFSO.CreateTextFile(zabbix_dir&"uDiffPrograms_new.txt")
objFile3.WriteLine variable
objFile3.Close
'Compare old and new files
Set objArgs = Wscript.Arguments
Set objFile5= objFSO.GetFile(zabbix_dir&"uDiffPrograms_new.txt")
Set objFile6 = objFSO.GetFile(zabbix_dir&"uDiffPrograms_old.txt")

If objFile5.Size <> objFile6.Size Then
' Wscript.Echo "The file is different."
Else
'Wscript.Echo "They are the same."

objFSO.DeleteFile zabbix_dir&"uDiffPrograms_new.txt"
Call ConvertCharsetFile("0x0")
WScript.Quit

End If
'Search for removed applications
Set objFile2 = objFSO.OpenTextFile(zabbix_dir&"uDiffPrograms_old.txt", ForReading)

Do Until objFile2.AtEndOfStream
strAddress2 = objFile2.ReadLine
If InStr(variable, strAddress2&vbCrLf) = 0 Then
strNotCurrent2 = strNotCurrent2 & strAddress2 & vbCrLf
End If
Loop
objFile2.Close

'Search for installed applications
Set objFile1 = objFSO.OpenTextFile(zabbix_dir&"uDiffPrograms_old.txt", ForReading)

oldvar = objFile1.ReadAll

objFile1.Close
objFSO.DeleteFile zabbix_dir&"uDiffPrograms_old.txt"
Set objFile2 = objFSO.OpenTextFile(zabbix_dir&"uDiffPrograms_new.txt", ForReading)

Do Until objFile2.AtEndOfStream
strAddress = objFile2.ReadLine
If InStr(oldvar, strAddress&vbCrLf) = 0 Then
strNotCurrent = strNotCurrent & strAddress & vbCrLf
End If
Loop
objFile2.Close
'Rename C:\zabbix\uDiffPrograms_new.txt to C:\zabbix\uDiffPrograms_old.txt
objFSO.MoveFile zabbix_dir&"uDiffPrograms_new.txt" , zabbix_dir&"uDiffPrograms_old.txt"
'Output
if strNotCurrent <> "" and strNotCurrent2 <> "" then
Call ConvertCharsetFile("Новые программы были установлены:" & vbCrLf & strNotCurrent & vbCrLf & "Следующие программы были удалены:" & vbCrLf & strNotCurrent2)
Wscript.Quit
End if
if strNotCurrent <> "" then
Call ConvertCharsetFile("Новые программы были установлены:" & vbCrLf & strNotCurrent)
End if
if strNotCurrent2 <> "" then
Call ConvertCharsetFile("Следующие программы были удалены:" & vbCrLf & strNotCurrent2)
End If

Function InstalledApplications(node)
'''with Versions
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Set oRegistry = GetObject("winmgmts://" _
& node & "/root/default:StdRegProv")
sBaseKey = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)

For Each sKey In arSubKeys

iRC = oRegistry.GetStringValue( _
HKLM, sBaseKey & sKey, "DisplayName", sValue)

If iRC <> 0 Then
oRegistry.GetStringValue _
HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
End If

If sValue <> "" and instr(sValue, "KB")=0 Then
'instr(sValue, "KB")=0 - to exlude KB-indexed Microsoft Patches
If instr(InstalledApplications, sValue&vbCrLf)=0 then
'and instr(InstalledApplications, sValue&vbCrLf)=0 - to exlude possible dublicates
InstalledApplications = _
InstalledApplications & sValue & vbCrLf
End If
End If
Next

End Function

Function ConvertCharsetFile(input)
Const adTypeBinary = 1
Const adTypeText = 2
Const bOverwrite = True
Const bAsASCII = False

'Write to temp file
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists( zabbix_dir&"uDiffPrograms_temp.txt" ) Then objFSO.DeleteFile zabbix_dir&"uDiffPrograms_temp.txt"
Set objFile3 = objFSO.CreateTextFile(zabbix_dir&"uDiffPrograms_temp.txt")
objFile3.WriteLine input
objFile3.Close

Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )

Dim sFFSpec : sFFSpec = oFS.GetAbsolutePathName( zabbix_dir&"uDiffPrograms_temp.txt" )

Dim oFrom : Set oFrom = CreateObject( "ADODB.Stream" )
Dim sFrom : sFrom = "windows-1251"
Dim oTo : Set oTo = CreateObject( "ADODB.Stream" )
Dim sTo : sTo = "utf-8"

oFrom.Type = adTypeText
oFrom.Charset = sFrom
oFrom.Open
oFrom.LoadFromFile sFFSpec

oTo.Type = adTypeText
oTo.Charset = sTo
oTo.Open
oTo.WriteText oFrom.ReadText
oFrom.Close
If oFS.FileExists( sFFSpec ) Then oFS.DeleteFile sFFSpec
oTo.SaveToFile sFFSpec
oTo.Close
End Function
'=============================================================================

' List 32-bit installed software on 64-bit OS
' set parameters section
sLogFile = "c:\zabbix\swinv64.txt"
strComputer = "abekmurzaev"
Const HKLM = &h80000002
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oLogFile = oFSO.OpenTextFile(sLogFile, 8, True)
Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
objCtx.Add "__ProviderArchitecture", 32
objCtx.Add "__RequiredArchitecture", TRUE
Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
Set objStdRegProv = objServices.Get("StdRegProv")

' Get Applications Section
set Inparams = objStdRegProv.Methods_("Enumkey").Inparameters
Inparams.Hdefkey = HKLM
Inparams.Ssubkeyname = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"
set Outparams = objStdRegProv.ExecMethod_("EnumKey", Inparams,,objCtx)

For Each strSubKey in Outparams.snames

Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters
Inparams.Hdefkey = HKLM
Inparams.Ssubkeyname = "Software\Microsoft\Windows\CurrentVersion\Uninstall\" & strSubKey
Inparams.Svaluename = "DisplayName"
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)

if Outparams.SValue <> "" then
 oLogFile.WriteLine OutParams.SValue
end if

Next