' this script:
' finds temp directory
' reads registry via wmi to enumerate installed software
' produces a report in .tab format in %temp% in unicode (some software have non ascii characters).
' offers choice to open it in excel.
' dialogs are time limited boxes and close automatically
Set WshShell = CreateObject( "WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' -------- Popup and MsgBox Constants ------
CONST POPUPOk = 0
CONST POPUPOkCancel = 1
CONST POPUPAbortIngnoreRetry = 2
CONST POPUPYesNoCancel = 3
CONST POPUPYesNo = 4
CONST POPUPRetryCancel = 5
CONST POPUPICONCritical = 16
CONST POPUPICONQuestion = 32
CONST POPUPICONExclamation = 48
CONST POPUPICONInformation = 64
CONST POPUPKEYTimedOut = -1
CONST POPUPKEYOk = 1
CONST POPUPKEYCancel = 2
CONST POPUPKEYAbort = 3
CONST POPUPKEYRetry = 4
CONST POPUPKEYIgnore = 5
CONST POPUPKEYYes = 6
CONST POPUPKEYNo = 7
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
' get temp for report
TEMPDir = WshShell.ExpandEnvironmentStrings("%TEMP%")
if instr(TempDir,"%") then
TEMPDir=windir & "\TEMP\"
end if
if right(TEMPDir,1)="\" then
else
TEMPDir=TEMPDir & "\"
end if
Set WshNetwork = WScript.CreateObject("WScript.Network")
Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
strUserName = objNetwork.UserName
outputname="C:\" & WshNetwork.ComputerName &".xls"
' open report file in unicode as some software has non-ascii characters.
set output = oFSO.OpenTextFile(outputname,ForWriting,true,-1)
output.writeline "Name InstallDate Version UninstallCMD"
output.writeline ""
output.writeline strUserName & " " & GetAdminName
output.writeline WshNetwork.ComputerName
output.writeline ""
' enumerate the uninstall values into an array
strComputer = "."
appcount=0
sAppsList=""
returncode=0
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
oReg.EnumKey HKLM, strKeyPath, arrSubKeys
if err.number <> 0 then
DisplayATimeLimitedMsg "Can't read registry key" & err.number & " " & err.description,"ERROR",5
wscript.quit(err.number)
end if
For Each subkey In arrSubKeys
displayname=""
DisplayVersion = ""
InstallDate = ""
UninstallString = ""
'wscript.echo subkey
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" & "\" & subkey
strValueName = "DisplayName"
oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
DisplayName = strValue
strValueName = "DisplayVersion"
oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
DisplayVersion = strValue
strValueName = "InstallDate"
oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
InstallDate = strValue
strValueName = "UninstallString"
oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
UninstallString = strValue
If DisplayName <> "" Then
output.writeline DisplayName & " " & InstallDate & " " & DisplayVersion & " " & UninstallString
End If
appcount=appcount+1
Next
if appcount=0 then
DisplayATimeLimitedMsg "ERROR: no apps found." & err.number & " " & err.description,"ERROR",5
wscript.quit(1)
end if
if err.number<>0 then
DisplayATimeLimitedMsg stringline & " " & err.number &" " & err.description, "Error", 10 ' 10 = seconds to display on screen before disappears….
returncode=err.number
wscript.quit(returncode)
end if
output.close
' open the thingy in notepad
'if OfferUserTimeLimitedYesNoChoice("Do you want to view " & outputname &"?","Display Report", 15) then
' COMMAND="excel.exe " & outputname
' WshShell.Run command,1,true
'else
'end if
' cleanup
set oFSO=nothing
set Wshshell=nothing
wscript.quit(returncode)
' ---------------------------------------------
' ------------ FUNCTIONS ----------------------
' ---------------------------------------------
Function DisplayATimeLimitedMsg( strMessageToDisplay, strTitle, intHowLongToWait)
WshShell.popup strMessageToDisplay, intHowLongToWait, strTitle, POPUPICONInformation
End Function
' ---------------------------
Function OfferUserTimeLimitedYesNoChoice( strMessageToDisplay, strTitle, intHowLongToWait)
Dim flgPopupResponse, flgReturnTrueOrFalse
flgPopupResponse = WshShell.popup( strMessageToDisplay, intHowLongToWait, strTitle, (POPUPYesNo + POPUPICONQuestion))
SELECT Case flgPopupResponse
CASE POPUPKEYYes
flgReturnTrueOrFalse = True
CASE POPUPKEYNo
flgReturnTrueOrFalse = False
END SELECT
OfferUserTimeLimitedYesNoChoice = flgReturnTrueOrFalse
End Function
Function GetAdminName
'This function was written using information from Table J.1 from the Windows XP resource Kit
'http://www.microsoft.com/resources/documentation/Windows/XP/all/reskit/en-us/Default.asp?url=/resources/documentation/Windows/XP/all/reskit/en-us/prnc_sid_cids.asp
Set objNetwork = CreateObject("Wscript.Network") 'get the current computer name
objComputerName = objNetwork.ComputerName
Set objwmi = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & objComputerName)
qry = "SELECT * FROM Win32_Account where Domain = '" & cstr(objComputerName) & "'" 'set query, making sure to only look at local computer
For Each Admin in objwmi.ExecQuery(qry)
if (left(admin.sid, 6) = "S-1-5-" and right(admin.sid,4) = "-500") then 'look for admin sid
GetAdminName = admin.name
end if
next
end Function
