Skip to content

Instantly share code, notes, and snippets.

@joerodgers

joerodgers/ROIScan.vbs

Created July 19, 2019 15:33
Show Gist options
  • Save joerodgers/b1c6ec34801917d4ec4a700491f8ace3 to your computer and use it in GitHub Desktop.
Save joerodgers/b1c6ec34801917d4ec4a700491f8ace3 to your computer and use it in GitHub Desktop.
Download ZIP
ROIScan.vbs
Raw
ROIScan.vbs
' Name: Robust Office Inventory Scan - Version 1.9.1
' Author: Microsoft Customer Support Services
' Copyright (c) Microsoft Corporation. All rights reserved.
' Script to create an inventory scan of installed Office applications
' Supported Office Families: 2000, 2002, 2003, 2007
' 2010, 2013, 2016, O365
Option Explicit
On Error Resume Next
Const SCRIPTBUILD = "1.9.1"
Dim sPathOutputFolder : sPathOutputFolder = ""
Dim fQuiet : fQuiet = False
Dim fLogFeatures : fLogFeatures = False
Dim fLogFull : fLogFull = False
dim fBasicMode : fBasicMode = False
Dim fLogChainedDetails : fLogChainedDetails = False
Dim fLogVerbose : fLogVerbose = False
Dim fListNonOfficeProducts : fListNonOfficeProducts = False
Dim fFileInventory : fFileInventory = False
Dim fFeatureTree : fFeatureTree = False
Dim fDisallowCScript : fDisallowCScript = False
'=======================================================================================================
'[INI] Section for script behavior customizations
'Directory for Log output.
'Example: "\\<server>\<share>\"
'Default: sPathOutputFolder = vbNullString -> %temp% directory is used
sPathOutputFolder = ""
'Quiet switch.
'Default: False -> Open inventory log when done
fQuiet = False
'Basic Mode
'Generates a basic list of installed Office products with licensing information only
'Disables all other extended analysis options
'Default: False -> Allow extended analysis options
fBasicMode = False
'Log full (verbose) details. This enables all possible scans for Office products.
'Default: False -> Only list standard details
fLogFull = False
'Enables additional logging details
'like the "FeatureTree" display and
'the additional individual listing of the chained Office SKU's
'Default: False -> Do not log additional details
fLogVerbose = False
'Starting with Office 2007 a SKU can contain several .msi packages
'The default does not list the details for each chained package
'This option allows to show the full details for each chained package
'Default: Comprehensive view - do not show details for chained packages
fLogChainedDetails = False
'The script filters for products of the Microsoft Office family.
'Set this option to 'True' to get a list of all Windows Installer products in the inventory log
'Default: False -> Don't list other products in the log
fListNonOfficeProducts = False
'File level inventory of installed Office products
'Depending on the number of installed products this can be an extremely time consuming task!
'Default: False -> Don't create a file level inventory
fFileInventory = False
'Detect all features of a product and include a feature tree in the log
'Default: False -> Don't include the feature detection
fFeatureTree = False
'DO NOT CUSTOMIZE BELOW THIS LINE!
'=======================================================================================================
'Measure total scan runtime
Dim tStart, tEnd
tStart = Time()
'Call the command line parser
ParseCmdLine
'Definition of non customizable settings
'Strings
Dim sComputerName, sTemp, sCurUserSid, sDebugErr, sError, sErrBpa, sProductCodes_C2R
Dim sStack, sCacheLog, sLogFile, sInstalledProducts, sSystemType, sLogFormat
Dim sPackageGuid, sUserName, sDomain
'Arrays
Dim arrAllProducts(), arrMProducts(), arrUUProducts(), arrUMProducts(), arrMaster(), arrArpProducts()
Dim arrVirtProducts(), arrVirt2Products(), arrVirt3Products(), arrPatch(), arrAipPatch, arrMspFiles
Dim arrLog(4), arrLogFormat(), arrUUSids(), arrUMSids(), arrMVProducts(), arrIS(), arrFeature()
Dim arrProdVer09(), arrProdVer10(), arrProdVer11(), arrProdVer12(), arrProdVer14(), arrProdVer15()
Dim arrProdVer16(), arrFiles(), arrLicenese()
'Booleans
Dim fIsAdmin, fIsElevated, fIsCriticalError, fGuidCaseWarningOnly, f64, fPatchesOk, fPatchesExOk
Dim fCScript, bOsppInit, fZipError, fInitArrProdVer, fv2SxS
'Integers
Dim iWiVersionMajor, iVersionNt, iPCount, iPatchesExError, iVMVirtOverride
'Dictionaries
Dim dicFolders, dicAssembly, dicMspIndex, dicProducts, dicArp, dicMissingChild
Dim dicPatchLevel, dicScenario, dicKeyComponents
Dim dicPolHKCU, dicPolHKLM
Dim dicProductCodeC2R, dicActiveC2RVersions, dicMapArpToConfigID
Dim dicKeyComponentsV2, dicScenarioV2, dicC2RPropV2, dicVirt2Cultures
Dim dicKeyComponentsV3, dicScenarioV3, dicC2RPropV3, dicVirt3Cultures
'Other
Dim oMsi, oShell, oFso, oReg, oWsh, oWMILocal
Dim TextStream, ShellApp, AppFolder, Ospp, Spp
'Identifier for product family
Const OFFICE_ALL = "78E1-11D2-B60F-006097C998E7}.0001-11D2-92F2-00104BC947F0}.6000-11D3-8CFE-0050048383C9}.6000-11D3-8CFE-0150048383C9}.7000-11D3-8CFE-0150048383C9}.BE5F-4ED1-A0F7-759D40C7622E}.BDCA-11D1-B7AE-00C04FB92F3D}.6D54-11D4-BEE3-00C04F990354}.CFDA-404E-8992-6AF153ED1719}.{9AC08E99-230B-47e8-9721-4577B7F124EA}"
'Office 2000 -> KB230848; Office XP -> KB302663; Office 2003 -> KB832672
Const OFFICE_2000 = "78E1-11D2-B60F-006097C998E7}"
Const ORK_2000 = "0001-11D2-92F2-00104BC947F0}"
Const PRJ_2000 = "BDCA-11D1-B7AE-00C04FB92F3D}"
Const VIS_2002 = "6D54-11D4-BEE3-00C04F990354}"
Const OFFICE_2002 = "6000-11D3-8CFE-0050048383C9}"
Const OFFICE_2003 = "6000-11D3-8CFE-0150048383C9}"
Const WSS_2 = "7000-11D3-8CFE-0150048383C9}"
Const SPS_2003 = "BE5F-4ED1-A0F7-759D40C7622E}"
Const PPS_2007 = "CFDA-404E-8992-6AF153ED1719}" 'Project Portfolio Server 2007
Const POWERPIVOT_2010 = "{72F8ECCE-DAB0-4C23-A471-625FEDABE323}, {A37E1318-29CA-4A9F-9CCA-D9BFDD61D17B}" 'UpgradeCode!
Const O15_C2R = "{9AC08E99-230B-47e8-9721-4577B7F124EA}"
Const OFFICEID = "000-0000000FF1CE}" 'cover O12, O14 with 32 & 64 bit
Const OREGREFC2R15 = "Microsoft Office 15"
'SPP AppId
Const OFFICE14APPID = "59a52881-a989-479d-af46-f275c6370663"
Const OFFICEAPPID = "0ff1ce15-a989-479d-af46-f275c6370663"
Const PRODLEN = 13
Const FOR_READING = 1
Const FOR_WRITING = 2
Const FOR_APPENDING = 8
Const TRISTATE_USEDEFAULT = -2 'Opens the file using the system default.
Const TRISTATE_TRUE = -1 'Opens the file as Unicode.
Const TRISTATE_FALSE = 0 'Opens the file as ASCII.
Const USERSID_EVERYONE = "s-1-1-0"
Const MACHINESID = ""
Const PRODUCTCODE_EMPTY = ""
Const MSIOPENDATABASEMODE_READONLY = 0
Const MSIOPENDATABASEMODE_PATCHFILE = 32
Const MSICOLUMNINFONAMES = 0
Const MSICOLUMNINFOTYPES = 1
'Summary Information fields
Const PID_TITLE = 2 'Type of installer package. E.g. "Installation Database" or "Transform" or "Patch"
Const PID_SUBJECT = 3 'Displayname
Const PID_TEMPLATE = 7 'compatible platform and language versions for .msi / PatchTargets for .msp
Const PID_REVNUMBER = 9 'PackageCode
Const PID_WORDCOUNT = 15'InstallSource type
Const MSIPATCHSTATE_UNKNOWN = -1 'Patch is in an unknown state to this product instance.
Const MSIPATCHSTATE_APPLIED = 1 'Patch is applied to this product instance.
Const MSIPATCHSTATE_SUPERSEDED = 2 'Patch is applied to this product instance but is superseded.
Const MSIPATCHSTATE_OBSOLETED = 4 'Patch is applied in this product instance but obsolete.
Const MSIPATCHSTATE_REGISTERED = 8 'The enumeration includes patches that are registered but not yet applied.
Const MSIPATCHSTATE_ALL = 15
Const MSIINSTALLCONTEXT_USERMANAGED = 1
Const MSIINSTALLCONTEXT_USERUNMANAGED = 2
Const MSIINSTALLCONTEXT_MACHINE = 4
Const MSIINSTALLCONTEXT_ALL = 7
Const MSIINSTALLCONTEXT_C2RV2 = 8 'C2r V2 virtualized context
Const MSIINSTALLCONTEXT_C2RV3 = 15 'C2r V3 virtualized context
Const MSIINSTALLMODE_DEFAULT = 0 'Provide the component and perform any installation necessary to provide the component.
Const MSIINSTALLMODE_EXISTING = -1 'Provide the component only if the feature exists. This option will verify that the assembly exists.
Const MSIINSTALLMODE_NODETECTION = -2 'Provide the component only if the feature exists. This option does not verify that the assembly exists.
Const MSIINSTALLMODE_NOSOURCERESOLUTION = -3 'Provides the assembly only if the assembly is installed local.
Const MSIPROVIDEASSEMBLY_NET = 0 'A .NET assembly.
Const MSIPROVIDEASSMBLY_WIN32 = 1 'A Win32 side-by-side assembly.
Const MSITRANSFORMERROR_ALL = 319
'Installstates for products, features, components
Const INSTALLSTATE_NOTUSED = -7 ' component disabled
Const INSTALLSTATE_BADCONFIG = -6 ' configuration data corrupt
Const INSTALLSTATE_INCOMPLETE = -5 ' installation suspended or in progress
Const INSTALLSTATE_SOURCEABSENT = -4 ' run from source, source is unavailable
Const INSTALLSTATE_MOREDATA = -3 ' return buffer overflow
Const INSTALLSTATE_INVALIDARG = -2 ' invalid function argument. The product/feature is neither advertised or installed.
Const INSTALLSTATE_UNKNOWN = -1 ' unrecognized product or feature
Const INSTALLSTATE_BROKEN = 0 ' broken
Const INSTALLSTATE_ADVERTISED = 1 ' The product/feature is advertised but not installed.
Const INSTALLSTATE_REMOVED = 1 ' The component is being removed (action state, not settable)
Const INSTALLSTATE_ABSENT = 2 ' The product/feature is not installed.
Const INSTALLSTATE_LOCAL = 3 ' The product/feature/component is installed.
Const INSTALLSTATE_SOURCE = 4 ' The product or feature is installed to run from source, CD, or network.
Const INSTALLSTATE_DEFAULT = 5 ' The product or feature will be installed to use the default location: local or source.
Const INSTALLSTATE_VIRTUALIZED = 8 ' The product is virtualized (C2R).
Const VERSIONCOMPARE_LOWER = -1 ' Left hand file version is lower than right hand
Const VERSIONCOMPARE_MATCH = 0 ' File versions are identical
Const VERSIONCOMPARE_HIGHER = 1 ' Left hand file versin is higher than right hand
Const VERSIONCOMPARE_INVALID = 2 ' Cannot compare. Invalid compare attempt.
Const COPY_OVERWRITE = &H10&
Const COPY_SUPPRESSERROR = &H400&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKCR = &H80000000
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKU = &H80000003
Const KEY_QUERY_VALUE = &H0001
Const KEY_SET_VALUE = &H0002
Const KEY_CREATE_SUB_KEY = &H0004
Const DELETE = &H00010000
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const REG_QWORD = 11
Const REG_GLOBALCONFIG = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\"
Const REG_CONTEXTMACHINE = "Installer\"
Const REG_CONTEXTUSER = "Software\Microsoft\Installer\"
Const REG_CONTEXTUSERMANAGED = "Software\Microsoft\Windows\CurrentVersion\Installer\Managed\"
Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
Const REG_OFFICE = "SOFTWARE\Microsoft\Office\"
Const REG_C2RVIRT_HKLM = "\ClickToRun\REGISTRY\MACHINE\"
Const STR_NOTCONFIGURED = "<Not Configured>"
Const STR_NOTCONFIGUREDXML = "NotConfigured"
Const STR_PACKAGEGUID = "PackageGUID"
Const STR_REGPACKAGEGUID = "RegPackageGUID"
Const STR_BUILDNUMBER = "BuildNumber"
Const STR_VERSIONTOREPORT = "BuildVersionToReport"
Const STR_VERSION = "Version"
Const STR_PLATFORM = "Platform"
Const STR_OFFICEMGMTCOM = "OfficeMgmtCom"
Const STR_CDNBASEURL = "CDNBaseUrl"
Const STR_LASTUSEDBASEURL = "Last used InstallSource"
Const STR_UPDATELOCATION = "Custom UpdateLocation"
Const STR_USEDUPDATELOCATION = "Winning UpdateLocation"
Const STR_UPDATESENABLED = "UpdatesEnabled"
Const STR_UPDATECHANNEL = "UpdateChannel"
Const STR_UPDATETOVERSION = "UpdateToVersion"
Const STR_UPDATETHROTTLE = "UpdatesThrottleValue"
Const STR_POLUPDATESENABLED = "Policy UpdatesEnabled"
Const STR_POLUPGRADEENABLED = "Policy EnableAutomaticUpgrade"
Const STR_POLUPDATECHANNEL = "Policy UpdateChannel"
Const STR_POLUPDATELOCATION = "Policy UpdateLocation"
Const STR_POLUPDATETOVERSION = "Policy UpdateToVersion"
Const STR_POLUPDATEDEADLINE = "Policy UpdateDeadline"
Const STR_POLUPDATENOTIFICATIONS = "Policy UpdateHideNotifications"
Const STR_POLHIDEUPDATECFGOPT = "Policy HideUpdateConfigOptions"
Const STR_SCA = "Shared Computer Licensing"
Const STR_POLSCACACHEOVERRIDE = "Policy SCLCacheOverride"
Const STR_POLSCACACHEOVERRIDEDIR = "Policy SCLCacheOverrideDirectory"
Const STR_POLOFFICEMGMTCOM = "Policy OfficeMgmtCom"
Const GUID_UNCOMPRESSED = 0
Const GUID_COMPRESSED = 1
Const GUID_SQUISHED = 2
Const LOGPOS_COMPUTER = 0 ' ArrLogPosition 0: "Computer"
Const LOGPOS_REVITEM = 1 ' ArrLogPosition 1: "Review Items"
Const LOGPOS_PRODUCT = 2 ' ArrLogPosition 2: "Products Inventory"
Const LOGPOS_RAW = 3 ' ArrLogPosition 3: "Raw Data"
Const LOGHEADING_NONE = 0 ' Not a heading
Const LOGHEADING_H1 = 1 ' Heading 1 '='
Const LOGHEADING_H2 = 2 ' Heading 2 '-'
Const LOGHEADING_H3 = 3 ' Heading 3 ' '
Const TEXTINDENT = " "
Const CATEGORY = 1
Const TAG = 2
'Global_Access_Core - msaccess.exe
Const CID_ACC16_64 = "{27C919A6-3FA5-47F9-A3EC-BC7FF2AAD452}"
Const CID_ACC16_32 = "{E34AA7C4-8845-4BD7-BAC6-26554B60823B}"
Const CID_ACC15_64 = "{3CE2B4B3-DA38-4113-8DB2-965847CDE94F}"
Const CID_ACC15_32 = "{A3E12EF0-7C3B-4493-99A3-F92FCD0AA512}"
Const CID_ACC14_64 = "{02F5CBEC-E7B5-4FC1-BD72-6043152BD1D4}"
Const CID_ACC14_32 = "{AE393348-E564-4894-B8C5-EBBC5E72EFC6}"
Const CID_ACC12 = "{0638C49D-BB8B-4CD1-B191-054E8F325736}"
Const CID_ACC11 = "{F2D782F8-6B14-4FA4-8FBA-565CDDB9B2A8}"
'Global_Excel_Core - excel.exe
Const CID_XL16_64 = "{C4ACE6DB-AA99-401F-8BE6-8784BD09F003}"
Const CID_XL16_32 = "{C845E028-E091-442E-8202-21F596C559A0}"
Const CID_XL15_64 = "{58A9998B-6103-436F-85A1-52720802CA0A}"
Const CID_XL15_32 = "{107E1A9A-03AE-4F2B-ACF7-0CC519E60E7B}"
Const CID_XL14_64 = "{8B1BF0B4-A1CA-4656-AA46-D11C50BC55A4}"
Const CID_XL14_32 = "{538F6C89-2AD5-4006-8154-C6670774E980}"
Const CID_XL12 = "{0638C49D-BB8B-4CD1-B191-052E8F325736}"
Const CID_XL11 = "{A2B280D4-20FB-4720-99F7-40C09FBCE10A}"
'WAC_CoreSPD - spdesign.exe (frontpage.exe)
Const CID_SPD16_64 = "{2FB768AF-8F57-424A-BBDA-81611CFF3ED2}"
Const CID_SPD16_32 = "{C3F352B2-A43B-4948-AE54-12E265647697}"
Const CID_SPD15_64 = "{25B4430E-E7D6-406F-8468-D9B65BC240F3}"
Const CID_SPD15_32 = "{0F0A451D-CB3C-44BE-B8A4-E72C2B89C4A2}"
Const CID_SPD14_64 = "{6E4D3AA2-2AD9-4DD2-8C2D-8C55B656A5C9}"
Const CID_SPD14_32 = "{E5344AC3-915E-4655-AF0D-98BC878805DC}"
Const CID_SPD12 = "{0638C49D-BB8B-4CD1-B191-056E8F325736}"
Const CID_SPD11 = "{81E9830C-5A6B-436A-BEC9-4FB759282DE3}" ' FrontPage
'Groove_Core - groove.exe
Const CID_GRV16_64 = "{EEE31981-E2D9-45AE-B134-FD9276C19588}"
Const CID_GRV16_32 = "{6C26357C-A2D8-4C68-8BC6-A8091BECDA02}"
Const CID_GRV15_64 = "{AD8AD7F2-98CB-4257-BE7A-05CBCA1354B4}"
Const CID_GRV15_32 = "{87E86C36-1368-4841-9152-766F31BC46E8}"
Const CID_GRV14_64 = "{61CD70FF-C6B7-4F6A-8491-5B8B9B0040F8}"
Const CID_GRV14_32 = "{EFE67578-E52B-410E-9178-9911443DBF5A}"
Const CID_GRV12 = "{0A048D77-2DE9-4672-ACF7-12429662397D}"
'Lync_Corelync - lync.exe
Const CID_LYN16_64 = "{3CFF5AB2-9B16-4A31-BC3F-FAD761D92780}"
Const CID_LYN16_32 = "{E1AFBCD9-12F0-4FC0-9177-BFD3148AEC74}"
Const CID_LYN15_64 = "{D5B16A67-9FA6-4B77-AE2A-3B1F49CE9D3B}"
Const CID_LYN15_32 = "{F8D36F1C-6196-4FFA-94AA-736644D458E3}"
'Global_OneNote_Core - onenote.exe
Const CID_ONE16_64 = "{8265A5EF-46C7-4D46-812C-076F2A28F7CB}"
Const CID_ONE16_32 = "{2A8FA8D7-B728-4792-AC02-463FD7A423BD}"
Const CID_ONE15_64 = "{74F233A9-A17A-477C-905F-853F5FCDAD40}"
Const CID_ONE15_32 = "{DACE5A15-C57C-44DE-9AFF-89B4412485AF}"
Const CID_ONE14_64 = "{9542A6E5-2FAF-4191-B525-6ED00F2D0127}"
Const CID_ONE14_32 = "{62F8C897-D359-4D8F-9659-CF1E9E3E6B74}"
Const CID_ONE12 = "{0638C49D-BB8B-4CD1-B191-057E8F325736}"
Const CID_ONE11 = "{D2C0E18B-C463-4E90-92AC-CA94EBEC26CE}"
'Global_Office_Core - mso.dll
Const CID_MSO16_64 = "{625F5772-C1B3-497E-8ABE-7254EDB00506}"
Const CID_MSO16_32 = "{68477CB0-662A-48FB-AF2E-9573C92869F7}"
Const CID_MSO15_64 = "{D01398A1-F26F-4545-A441-567F097A57D7}"
Const CID_MSO15_32 = "{9CC2CF5E-9A2E-41AC-AF95-432890A9659A}"
Const CID_MSO14_64 = "{E6AC97ED-6651-4C00-A8FE-790DB0485859}"
Const CID_MSO14_32 = "{398E906A-826B-48DD-9791-549C649CACE5}"
Const CID_MSO12 = "{0638C49D-BB8B-4CD1-B191-050E8F325736}"
Const CID_MSO11 = "{A2B280D4-20FB-4720-99F7-10C09FBCE10A}"
'Global_Outlook_Core - outlook.exe
Const CID_OL16_64 = "{7C6D92EF-7B45-46E5-8670-819663220E4E}"
Const CID_OL16_32 = "{2C6C511D-4542-4E0C-95D0-05D4406032F2}"
Const CID_OL15_64 = "{3A5F96E7-F51D-4942-98DB-3CD037FB39E5}"
Const CID_OL15_32 = "{E9E5CFFC-AFFE-4F83-A695-7734FA4775B9}"
Const CID_OL14_64 = "{ECCC8A38-7855-46CA-88FB-3BAA7CD95E56}"
Const CID_OL14_32 = "{CFF13DD8-6EF2-49EB-B265-E3BFC6501C1D}"
Const CID_OL12 = "{0638C49D-BB8B-4CD1-B191-055E8F325736}"
Const CID_OL11 = "{3CE26368-6322-4ABF-B11B-458F5C450D0F}"
'Global_PowerPoint_Core - powerpnt.exe
Const CID_PPT16_64 = "{E0A76492-0FD5-4EC2-8570-AE1BAA61DC88}"
Const CID_PPT16_32 = "{9E73CEA4-29D0-4D16-8FB9-5AB17387C960}"
Const CID_PPT15_64 = "{8C1B8825-A280-4657-A7B8-8172C553A4C4}"
Const CID_PPT15_32 = "{258D5292-6DDA-4B39-B301-58405FA16638}"
Const CID_PPT14_64 = "{EE8D8E0A-D905-401D-9BC3-0D20156D5E30}"
Const CID_PPT14_32 = "{E72E0D20-0D63-438B-BC71-92AB9F9E8B54}"
Const CID_PPT12 = "{0638C49D-BB8B-4CD1-B191-053E8F325736}"
Const CID_PPT11 = "{C86C0B92-63C0-4E35-8605-281275C21F97}"
'Global_Project_ClientCore - winproj.exe
Const CID_PRJ16_64 = "{107BCD9A-F1DC-4004-A444-33706FC10058}"
Const CID_PRJ16_32 = "{0B6EDA1D-4A15-4F88-8B20-EA6528978E4E}"
Const CID_PRJ15_64 = "{760CE47D-9512-40D9-8C6D-CF232851B4BB}"
Const CID_PRJ15_32 = "{5296AE31-2F7D-480C-BFDC-CE0797426395}"
Const CID_PRJ14_64 = "{64A809BD-6EE9-475C-B4E8-95B0D7FF3B97}"
Const CID_PRJ14_32 = "{51894540-193D-40AE-83F9-D3FC5DB24D91}"
Const CID_PRJ12 = "{43C3CF66-AA31-476D-B029-6D274E46F86C}"
Const CID_PRJ11 = "{C33FFB81-6E54-4541-AFF4-D84DC60460F7}"
'Global_Publisher_Core - mspub.exe
Const CID_PUB16_64 = "{7ECBF2AA-14AA-4F89-B9A5-C064274CFA83}"
Const CID_PUB16_32 = "{81DD86EC-5F1C-4DDE-9211-98AF184EAD47}"
Const CID_PUB15_64 = "{22299AFF-DC4C-45A8-9A8F-651FB6467057}"
Const CID_PUB15_32 = "{C9C0167D-3FE0-4078-B47E-83272A4B8B04}"
Const CID_PUB14_64 = "{A716400F-5D5D-45CF-94B4-05B17A98B901}"
Const CID_PUB14_32 = "{CD0D7B29-89E7-49C5-8EE1-5D858EFF2593}"
Const CID_PUB12 = "{CD0D7B29-89E7-49C5-8EE1-5D858EFF2593}"
Const CID_PUB11 = "{0638C49D-BB8B-4CD1-B191-05CE8F325736}"
'Global_XDocs_Core - infopath.exe
Const CID_IP16_64 = "{2774AAC0-1433-46BE-993F-8088018C3B09}"
Const CID_IP15_64 = "{19AF7201-09A2-4C73-AB50-FCEF94CB2BA9}"
Const CID_IP15_32 = "{3741355B-72CF-4CEE-948E-CC9FBDBB8E7A}"
Const CID_IP14_64 = "{28B2FBA8-B95F-47CB-8F8F-0885ACDAC69B}"
Const CID_IP14_32 = "{E3898C62-6EC3-4491-8194-9C88AD716468}"
Const CID_IP12 = "{0638C49D-BB8B-4CD1-B191-058E8F325736}"
Const CID_IP11 = "{1A66B512-C4BE-4347-9F0C-8638F8D1E6E4}"
'Global_Visio_visioexe - visio.exe
Const CID_VIS16_64 = "{2D4540EC-2C88-4C28-AE88-2614B5460648}"
Const CID_VIS16_32 = "{A4C55BC1-B94C-4058-B15C-B9D4AE540AD1}"
Const CID_VIS15_64 = "{7069FF90-1D63-4F85-A2AB-6F0D01C78D83}"
Const CID_VIS15_32 = "{5D502092-1543-4D9B-89FE-7B4364417CC6}"
Const CID_VIS14_64 = "{DB2B19E4-F894-47B1-A6F1-9B391A4AE0A8}"
Const CID_VIS14_32 = "{4371C2B1-3F27-41F5-A849-9987AB91D990}"
Const CID_VIS12 = "{0638C49D-BB8B-4CD1-B191-05DE8F325736}"
Const CID_VIS11 = "{7E5F9F34-8EA7-4EA2-ABFB-CA4E742EFFA1}"
'Global_Word_Core - winword.exe
Const CID_WD16_64 = "{DC5CCACD-A7AC-4FD3-9F70-9454B5DE5161}"
Const CID_WD16_32 = "{30CAC893-3CA4-494C-A5E9-A99141352216}"
Const CID_WD15_64 = "{6FF09BDF-B087-4E23-A9B9-272DBFD64099}"
Const CID_WD15_32 = "{09D07EFC-505F-4D9C-BFD5-ACE3217F6654}"
Const CID_WD14_64 = "{C0AC079D-A84B-4CBD-8DBA-F1BB44146899}"
Const CID_WD14_32 = "{019C826E-445A-4649-A5B0-0BF08FCC4EEE}"
Const CID_WD12 = "{0638C49D-BB8B-4CD1-B191-051E8F325736}"
Const CID_WD11 = "{1EBDE4BC-9A51-4630-B541-2561FA45CCC5}"
'Arrays
Const UBOUND_LOGARRAYS = 12
Const UBOUND_LOGCOLUMNS = 34 ' Controlled by array with the most columns
Redim arrLogFormat(UBOUND_LOGARRAYS, UBOUND_LOGCOLUMNS)
Const ARRAY_MASTER = 0 'Master data array id
Const UBOUND_MASTER = 34
Const COL_PRODUCTCODE = 0
Const COL_PRODUCTNAME = 1 ' Msi ProductName
Const COL_USERSID = 2
Const COL_CONTEXTSTRING = 3 ' ProductContext
Const COL_STATESTRING = 4 ' ProductState
Const COL_CONTEXT = 5 ' ProductContext
Const COL_STATE = 6 ' ProductState
Const COL_SYSTEMCOMPONENT = 7 ' Arp SystemComponent
Const COL_ARPPARENTCOUNT = 8
Const COL_ARPPARENTS = 9
Const COL_ARPPRODUCTNAME = 10
Const COL_PRODUCTVERSION = 11
Const COL_SPLEVEL = 12 ' ServicePack Level
Const COL_INSTALLDATE = 13
Const COL_CACHEDMSI = 14
Const COL_ORIGINALMSI = 15 ' Original .msi name
Const COL_ORIGIN = 16 ' Build/Origin Property
Const COL_PRODUCTID = 17 ' ProductID Property
Const COL_PACKAGECODE = 18
Const COL_TRANSFORMS = 19
Const COL_ARCHITECTURE = 20
Const COL_ERROR = 21
Const COL_NOTES = 22
Const COL_METADATASTATE = 23
Const COL_ISOFFICEPRODUCT = 24
Const COL_PATCHFAMILY = 25
Const COL_OSPPLICENSE = 26
Const COL_OSPPLICENSEXML = 27
Const COL_ACIDLIST = 28
Const COL_LICENSELIST = 29
Const COL_UPGRADECODE = 30
Const COL_VIRTUALIZED = 31
Const COL_INSTALLTYPE = 32
Const COL_KEYCOMPONENTS = 33
Const COL_PRIMARYPRODUCTID = 34
arrLogFormat(ARRAY_MASTER, COL_PRODUCTCODE) = "ProductCode"
arrLogFormat(ARRAY_MASTER, COL_PRODUCTNAME) = "Msi ProductName"
arrLogFormat(ARRAY_MASTER, COL_USERSID) = "UserSid"
arrLogFormat(ARRAY_MASTER, COL_CONTEXTSTRING) = "ProductContext"
arrLogFormat(ARRAY_MASTER, COL_STATESTRING) = "ProductState"
arrLogFormat(ARRAY_MASTER, COL_CONTEXT) = "ProductContext"
arrLogFormat(ARRAY_MASTER, COL_STATE) = "ProductState"
arrLogFormat(ARRAY_MASTER, COL_SYSTEMCOMPONENT) = "Arp SystemComponent"
arrLogFormat(ARRAY_MASTER, COL_ARPPARENTCOUNT) = "Arp ParentCount"
arrLogFormat(ARRAY_MASTER, COL_ARPPARENTS) = "Configuration SKU"
arrLogFormat(ARRAY_MASTER, COL_ARPPRODUCTNAME) = "ARP ProductName"
arrLogFormat(ARRAY_MASTER, COL_PRODUCTVERSION) = "ProductVersion"
arrLogFormat(ARRAY_MASTER, COL_SPLEVEL) = "ServicePack Level"
arrLogFormat(ARRAY_MASTER, COL_INSTALLDATE) = "InstallDate"
arrLogFormat(ARRAY_MASTER, COL_CACHEDMSI) = "Cached .msi Package"
arrLogFormat(ARRAY_MASTER, COL_ORIGINALMSI) = "Original .msi Name"
arrLogFormat(ARRAY_MASTER, COL_ORIGIN) = "Build/Origin"
arrLogFormat(ARRAY_MASTER, COL_PRODUCTID) = "ProductID (MSI)"
arrLogFormat(ARRAY_MASTER, COL_PACKAGECODE) = "Package Code"
arrLogFormat(ARRAY_MASTER, COL_TRANSFORMS) = "Transforms"
arrLogFormat(ARRAY_MASTER, COL_ARCHITECTURE) = "Architecture"
arrLogFormat(ARRAY_MASTER, COL_ERROR) = "Errors"
arrLogFormat(ARRAY_MASTER, COL_NOTES) = "Notes"
arrLogFormat(ARRAY_MASTER, COL_METADATASTATE) = "MetadataState"
arrLogFormat(ARRAY_MASTER, COL_ISOFFICEPRODUCT) = "IsOfficeProduct"
arrLogFormat(ARRAY_MASTER, COL_PATCHFAMILY) = "PatchFamily"
arrLogFormat(ARRAY_MASTER, COL_OSPPLICENSE) = "OSPP License"
arrLogFormat(ARRAY_MASTER, COL_OSPPLICENSEXML) = "OSPP License XML"
arrLogFormat(ARRAY_MASTER, COL_ACIDLIST) = "ACIDList"
arrLogFormat(ARRAY_MASTER, COL_LICENSELIST) = "Possible Licenses"
arrLogFormat(ARRAY_MASTER, COL_UPGRADECODE) = "UpgradeCode"
arrLogFormat(ARRAY_MASTER, COL_VIRTUALIZED) = "Virtualized"
arrLogFormat(ARRAY_MASTER, COL_INSTALLTYPE) = "InstallType"
arrLogFormat(ARRAY_MASTER, COL_KEYCOMPONENTS) = "KeyComponents"
arrLogFormat(ARRAY_MASTER, COL_PRIMARYPRODUCTID) = "Primary Product Id"
Const ARRAY_PATCH = 1 'Patch data array id
Const PATCH_COLUMNCOUNT = 14
Const PATCH_LOGSTART = 1
Const PATCH_LOGCHAINEDMAX = 8
Const PATCH_LOGMAX = 11
Const PATCH_PRODUCT = 0
Const PATCH_KB = 1
Const PATCH_PACKAGE = 3 ' PackageName
Const PATCH_PATCHSTATE = 2
Const PATCH_SEQUENCE = 4
Const PATCH_UNINSTALLABLE = 5
Const PATCH_INSTALLDATE = 6
Const PATCH_PATCHCODE = 7
Const PATCH_LOCALPACKAGE = 8
Const PATCH_TRANSFORM = 9
Const PATCH_DISPLAYNAME = 10
Const PATCH_MOREINFOURL = 11
Const PATCH_CSP = 12 ' Client side patch or patched AIP
Const PATCH_CPOK = 13 ' Local .msp package OK/available
arrLogFormat(ARRAY_PATCH, PATCH_PRODUCT) = "Patched Product: "
arrLogFormat(ARRAY_PATCH, PATCH_KB) = "KB: "
arrLogFormat(ARRAY_PATCH, PATCH_PACKAGE) = "Package: "
arrLogFormat(ARRAY_PATCH, PATCH_PATCHSTATE) = "State: "
arrLogFormat(ARRAY_PATCH, PATCH_SEQUENCE) = "Sequence: "
arrLogFormat(ARRAY_PATCH, PATCH_UNINSTALLABLE) = "Uninstallable: "
arrLogFormat(ARRAY_PATCH, PATCH_INSTALLDATE) = "InstallDate: "
arrLogFormat(ARRAY_PATCH, PATCH_PATCHCODE) = "PatchCode: "
arrLogFormat(ARRAY_PATCH, PATCH_LOCALPACKAGE) = "LocalPackage: "
arrLogFormat(ARRAY_PATCH, PATCH_TRANSFORM) = "PatchTransform: "
arrLogFormat(ARRAY_PATCH, PATCH_DISPLAYNAME) = "DisplayName: "
arrLogFormat(ARRAY_PATCH, PATCH_MOREINFOURL) = "MoreInfoUrl: "
arrLogFormat(ARRAY_PATCH, PATCH_CSP) = "ClientSidePatch: "
arrLogFormat(ARRAY_PATCH, PATCH_CPOK) = "CachedMspOK: "
' arrMsp(MSPDEFAULT, MSP_COLUMNCOUNT)
Const ARRAY_MSPFILES = 10
Const MSPFILES_COLUMNCOUNT = 18
Const MSPFILES_LOGMAX = 9
Const MSPFILES_TARGETS = 0 ' Product Targets
Const MSPFILES_KB = 1
Const MSPFILES_PACKAGE = 2 ' PackageName
Const MSPFILES_FAMILY = 3
Const MSPFILES_SEQUENCE = 4
Const MSPFILES_PATCHSTATE = 5
Const MSPFILES_UNINSTALLABLE = 6
Const MSPFILES_INSTALLDATE = 7
Const MSPFILES_DISPLAYNAME = 8
Const MSPFILES_MOREINFOURL = 9
Const MSPFILES_PATCHCODE = 10
Const MSPFILES_LOCALPACKAGE = 11
Const MSPFILES_BUCKET = 12
Const MSPFILES_ATTRIBUTE = 13 ' Attribute msidbPatchSequenceSupersedeEarlier
Const MSPFILES_TRANSFORM = 14 ' PatchTransform
Const MSPFILES_XML = 15 ' PatchXml
Const MSPFILES_TABLES = 16 ' PatchTables
Const MSPFILES_CPOK = 17 ' Local .msp package OK/available
arrLogFormat(ARRAY_MSPFILES, MSPFILES_TARGETS) = "Patch Targets: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_KB) = "KB: "
arrLogFormat(ARRAY_MSPFILES , MSPFILES_PACKAGE) = "Package: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_FAMILY) = "Family: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_SEQUENCE) = "Sequence: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_PATCHSTATE) = "PatchState: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_UNINSTALLABLE) = "Uninstallable: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_INSTALLDATE) = "InstallDate: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_DISPLAYNAME) = "DisplayName: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_MOREINFOURL) = "MoreInfoUrl: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_PATCHCODE) = "PatchCode: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_LOCALPACKAGE) = "LocalPackage: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_BUCKET) = "Bucket: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_ATTRIBUTE) = "msidbPatchSequenceSupersedeEarlier: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_TRANSFORM) = "PatchTransform: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_XML) = "PatchXml: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_TABLES) = "PatchTables: "
arrLogFormat(ARRAY_MSPFILES, MSPFILES_CPOK) = "CachedMspOK: "
Const ARRAY_AIPPATCH = 11
Const AIPPATCH_COLUMNCOUNT = 3
Const AIPPATCH_PRODUCT = 0
Const AIPPATCH_PATCHCODE = 1
Const AIPPATCH_DISPLAYNAME = 3
arrLogFormat(ARRAY_AIPPATCH, AIPPATCH_PRODUCT) = "Patched Product: "
arrLogFormat(ARRAY_AIPPATCH, AIPPATCH_PATCHCODE) = "PatchCode: "
arrLogFormat(ARRAY_AIPPATCH, AIPPATCH_DISPLAYNAME) = "DisplayName: "
Const ARRAY_FEATURE = 2 'Feature data array id
Const FEATURE_COLUMNCOUNT = 1
Const FEATURE_PRODUCTCODE = 0
Const FEATURE_TREE = 1
Const ARRAY_ARP = 4 'Add/remove products data array id
Const ARP_CHILDOFFSET = 6
Const ARP_CONFIGPRODUCTCODE = 0
Const COL_CONFIGNAME = 1
Const ARP_PRODUCTVERSION = 2
Const COL_CONFIGINSTALLTYPE = 3
Const COL_CONFIGPACKAGEID = 4
Const COL_ARPALLPRODUCTS = 5
Const COL_LBOUNDCHAINLIST = 6
arrLogFormat(ARRAY_ARP, ARP_CONFIGPRODUCTCODE) = "Config ProductCode"
arrLogFormat(ARRAY_ARP, COL_CONFIGNAME) = "Config ProductName"
arrLogFormat(ARRAY_ARP, ARP_PRODUCTVERSION) = "ProductVersion"
arrLogFormat(ARRAY_ARP, COL_CONFIGINSTALLTYPE) = "Config InstallType"
arrLogFormat(ARRAY_ARP, COL_CONFIGPACKAGEID) = "Config PackageID"
Const ARRAY_IS = 5 ' MSI InstallSource data array id
Const UBOUND_IS = 6
Const IS_LOG_LBOUND = 2
Const IS_LOG_UBOUND = 6
Const IS_PRODUCTCODE = 0
Const IS_SOURCETYPE = 1
Const IS_SOURCETYPESTRING = 2
Const IS_ORIGINALSOURCE = 3
Const IS_LASTUSEDSOURCE = 4
Const IS_LISRESILIENCY = 5
Const IS_ADDITIONALSOURCES = 6
arrLogFormat(ARRAY_IS, IS_SOURCETYPESTRING) = "InstallSource Type"
arrLogFormat(ARRAY_IS, IS_ORIGINALSOURCE) = "Initially Used Source"
arrLogFormat(ARRAY_IS, IS_LASTUSEDSOURCE) = "Last Used Source"
arrLogFormat(ARRAY_IS, IS_LISRESILIENCY) = "LIS Resiliency Sources"
arrLogFormat(ARRAY_IS, IS_ADDITIONALSOURCES) = "Network Sources"
Const ARRAY_VIRTPROD = 6 ' Non MSI based virtualized products
Const UBOUND_VIRTPROD = 14
Const VIRTPROD_KEYNAME = 2
Const VIRTPROD_CONFIGNAME = 3
Const VIRTPROD_PRODUCTVERSION = 4
Const VIRTPROD_SPLEVEL = 5
Const VIRTPROD_ISPROOFINGTOOLS = 6
Const VIRTPROD_ISLANGUAGEPACK = 7
Const VIRTPROD_OSPPLICENSE = 8
Const VIRTPROD_OSPPLICENSEXML = 9
Const VIRTPROD_ACIDLIST = 10
Const VIRTPROD_LICENSELIST = 11
Const VIRTPROD_CHILDPACKAGES = 12
Const VIRTPROD_KEYCOMPONENTS = 13
Const VIRTPROD_EXCLUDEAPP = 14
arrLogFormat(ARRAY_VIRTPROD, COL_PRODUCTCODE) = "ProductCode"
arrLogFormat(ARRAY_VIRTPROD, COL_PRODUCTNAME) = "ProductName"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_KEYNAME) = "KeyName"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_CONFIGNAME) = "Config ProductName"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_SPLEVEL) = "Version"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_PRODUCTVERSION) = "BuildNumber"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_OSPPLICENSE) = "(O)SPP License"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_OSPPLICENSEXML) = "(O)SPP License XML"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_ACIDLIST) = "ACIDList"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_LICENSELIST) = "Possible Licenses"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_CHILDPACKAGES) = "Child Packages"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_KEYCOMPONENTS) = "KeyComponents"
arrLogFormat(ARRAY_VIRTPROD, VIRTPROD_EXCLUDEAPP) = "Excluded Applications"
'License Data Array
Const ARRAY_LICENSE = 7
Const UBOUND_LICENSE = 10
Const LICENSE_ACID = 0
arrLogFormat(ARRAY_LICENSE, LICENSE_ACID) = "ACID"
Const CSV = ", "
Const DSV = " - "
Const DOT = ". "
Const ERR_CATEGORYNOTE = "Note: "
Const ERR_CATEGORYWARN = "Warning: "
Const ERR_CATEGORYERROR = "Error: "
Const ERR_NONADMIN = "The script appears to run outside administrator context"
Const ERR_NONELEVATED = "The script does not appear to run elevated"
Const ERR_DATAINTEGRITY = "A script internal error occurred. The integrity of the logged data might be affected"
Const ERR_OBJPRODUCTINFO = "Installer.ProductInfo -> "
Const ERR_INITSUMINFO = "Could not connect to summary information stream"
Const ERR_NOARRAY = "Array check failed"
Const ERR_UNKNOWNHANDLER = "Unknown Error Handler: '"
Const ERR_PRODUCTSEXALL = "ProductsEx for MSIINSTALLCONTEXT_ALL failed"
Const ERR_PATCHESEX = "PatchesEx failed to get a list of patches for: "
Const ERR_PATCHES = "Installer.Patches failed to get a list of patches"
Const ERR_MISSINGCHILD = "A chained product is missing which breaks the ability to maintain or uninstall this product. "
Const ERR_ORPHANEDITEM = "Office application without entry point in Add/Remove Programs"
Const ERR_INVALIDPRODUCTCODE = "Critical Windows Installer metadata corruption detected 'Invalid ProductCode'"
Const ERR_INVALIDGUID = "GUID validation failed"
Const ERR_INVALIDGUIDCHAR = "Guid contains invalid character(s)"
Const ERR_INVALIDGUIDLENGTH = "Invalid length for GUID "
Const ERR_GUIDCASE = "Guid contains lower case character(s)"
Const ERR_BADARPMETADATA = "Crititcal ARP metadata corruption detected in key: "
Const ERR_OFFSCRUB_TERMINATED = "Bad ARP metadata. This can be caused by an OffScrub run that was terminated before it could complete:"
Const ERR_ARPENTRYMISSING = "Expected regkey not present for ARP config parent"
Const ERR_REGKEYMISSING = "Regkey does not exist: "
Const ERR_CUSTOMSTACKCORRUPTION = "Custom stack list string corrupted"
Const ERR_BADMSPMETADATA = "Metadata mismatch for patch registration"
Const ERR_BADMSINAMEMETADATA = "Failed to retrieve value for original .msi name"
Const ERR_BADPACKAGEMETADATA = "Failed to retrieve value for cached .msi package"
Const ERR_PACKAGEAPIFAILURE = "API failed to retrieve value for cached .msi package"
Const ERR_BADPACKAGECODEMETADATA = "Failed to retrieve value for Package Code"
Const ERR_PACKAGECODEMISMATCH = "PackageCode mismatch between registered value and cached .msi"
Const ERR_LOCALPACKAGEMISSING = "Local cached .msi appears to be missing"
Const ERR_BADTRANSFORMSMETADATA = "Failed to retrieve value for Transforms"
Const ERR_SICONNECTFAILED = "Failed to connect to SummaryInformation stream"
Const ERR_MSPOPENFAILED = "OpenDatabase failed to open .msp file "
Const ERR_MSIOPENFAILED = "OpenDatabase failed to open .msi file "
Const ERR_BADFILESTATE = " has unexpected file state(s). "
Const ERR_FILEVERSIONLOW = "Review file versions for product "
Const BPA_GUID = "For details on 'GUID' see https://msdn.microsoft.com/en-us/library/Aa368767.aspx"
Const BPA_PACKAGECODE = "For details on 'Package Codes' see https://msdn.microsoft.com/en-us/library/aa370568.aspx"
Const BPA_PRODUCTCODE = "For details on 'Product Codes' see https://msdn.microsoft.com/en-us/library/aa370860.aspx"
Const BPA_PACKAGECODEMISMATCH = "A mismatch of the PackageCode will force the Windows Installer to recache the local .msi from the InstallSource. For details on 'Package Code' see https://msdn.microsoft.com/en-us/library/aa370568.aspx"
'=======================================================================================================
Main
'=======================================================================================================
'Module Main
'=======================================================================================================
Sub Main
Dim fCheckPreReq, FsoLogFile, FsoXmlLogFile
On Error Resume Next
' Check type of scripting host
fCScript = (UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C")
' Ensure all required objects are available. Prerequisite Checks with inline error handling.
fCheckPreReq = CheckPreReq()
If fCheckPreReq = False Then Exit Sub
' Initializations
Initialize
' Get computer specific properties
If fCScript AND NOT fQuiet Then wscript.echo "Stage 1 of 11: ComputerProperties"
ComputerProperties
' Build an array with a list of all Windows Installer based products
' After this point the master array "arrMaster" is instantiated and has the basic product details
If fCScript AND NOT fQuiet Then wscript.echo "Stage 2 of 11: Product detection"
FindAllProducts
' Get additional product properties and add them to the master array
If fCScript AND NOT fQuiet Then wscript.echo "Stage 3 of 11: ProductProperties"
ProductProperties
' Build an array with data on the InstallSource(s)
If fCScript AND NOT fQuiet Then wscript.echo "Stage 4 of 11: InstallSources"
ReadMsiInstallSources
' Build an array with data from Add/Remove Products
' Only Office >= 2007 products that use a multiple .msi structure will be covered here
If fCScript AND NOT fQuiet Then wscript.echo "Stage 5 of 11: Add/Remove Programs analysis"
ARPData
' Add Licensing data
' Only Office >= 2010 products that use OSPP are covered here
If fCScript AND NOT fQuiet Then wscript.echo "Stage 6 of 11: Licensing (OSPP)"
OsppCollect
' Build an array with all patch data.
If fCScript AND NOT fQuiet Then wscript.echo "Stage 7 of 11: Patch detection"
FindAllPatches
If fFeatureTree Then
' Build a tree structure for the Features
If fCScript AND NOT fQuiet Then wscript.echo "Stage 8 of 11: FeatureStates"
FindFeatureStates
Else
If fCScript AND NOT fQuiet Then wscript.echo "Skipping stage 8 of 11: (FeatureStates)"
End If 'fFeatureTree
' Create file inventory XML files
If fFileInventory Then
If fCScript AND NOT fQuiet Then wscript.echo "Stage 9 of 11: FileInventory"
FileInventory
Else
If fCScript AND NOT fQuiet Then wscript.echo "Skipping stage 9 of 11: (FileInventory)"
End If 'fFileInventory
' Prepare the collected data for the output file
If fCScript AND NOT fQuiet Then wscript.echo "Stage 10 of 11: Prepare collected data for output"
PrepareLog sLogFormat
' Write the output file
If fCScript AND NOT fQuiet Then wscript.echo "Stage 11 of 11: Write log"
WriteLog
Set FsoLogFile = oFso.GetFile(sLogFile)
Set FsoXmlLogFile = oFso.GetFile(sPathOutputFolder & sComputerName & "_ROIScan.xml")
If fFileInventory Then
If (oFso.FileExists(sPathOutputFolder & sComputerName & "_ROIScan.zip") AND NOT fZipError) Then
CopyToZip ShellApp.NameSpace(sPathOutputFolder & sComputerName & "_ROIScan.zip"), FsoLogFile
CopyToZip ShellApp.NameSpace(sPathOutputFolder & sComputerName & "_ROIScan.zip"), FsoXmlLogFile
End If
End If
If fCScript AND NOT fQuiet Then wscript.echo "Done!"
' Open the output file
If Not fQuiet Then
Set oShell = CreateObject("WScript.Shell")
If fFileInventory Then
If oFso.FileExists(sPathOutputFolder & sComputerName & "_ROIScan.zip") AND NOT fZipError Then
oShell.Run "explorer /e," & chr(34) & sPathOutputFolder & sComputerName & "_ROIScan.zip" & chr(34)
Else
oShell.Run "explorer /e," & chr(34) & sPathOutputFolder & "ROIScan" & chr(34)
End If
End If 'fFileInventory
oShell.Run chr(34) & sLogFile & chr(34)
Set oShell = Nothing
End If 'fQuiet
' Clear up Objects
CleanUp
End Sub
'=======================================================================================================
'Initialize defaults, setting and collect current user information
Sub Initialize
Dim oApp, Process, Processes
Dim sEnvVar, Argument
Dim iPopup, iInstanceCnt
Dim fPrompt
On Error Resume Next
'Ensure there's only a single instance running of this script
iInstanceCnt = 0
wscript.sleep 500
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
For Each Process in Processes
If LCase(Mid(Process.Name, 2, 6)) = "script" Then
If InStr(LCase(Process.CommandLine), "roiscan") > 0 AND NOT InStr(Process.CommandLine, " UAC") > 0 Then iInstanceCnt = iInstanceCnt + 1
End If
Next 'Process
If iInstanceCnt > 1 Then
If NOT fQuiet Then wscript.echo ERR_CATEGORYERROR & "Another instance of this script is already running."
wscript.quit
End If
'Other defaults
Set dicPatchLevel = CreateObject("Scripting.Dictionary")
Set dicScenario = CreateObject("Scripting.Dictionary")
Set dicC2RPropV2 = CreateObject("Scripting.Dictionary")
Set dicScenarioV2 = CreateObject("Scripting.Dictionary")
Set dicKeyComponentsV2 = CreateObject("Scripting.Dictionary")
Set dicVirt2Cultures = CreateObject("Scripting.Dictionary")
Set dicC2RPropV3 = CreateObject("Scripting.Dictionary")
Set dicScenarioV3 = CreateObject("Scripting.Dictionary")
Set dicKeyComponentsV3 = CreateObject("Scripting.Dictionary")
Set dicVirt3Cultures = CreateObject("Scripting.Dictionary")
Set dicProductCodeC2R = CreateObject("Scripting.Dictionary")
Set dicMapArpToConfigID = CreateObject("Scripting.Dictionary")
Set dicArp = CreateObject("Scripting.Dictionary")
Set dicPolHKCU = CreateObject("Scripting.Dictionary")
Set dicPolHKLM = CreateObject("Scripting.Dictionary")
fZipError = False
fInitArrProdVer = False
' log output folder
If sPathOutputFolder = "" Then sPathOutputFolder = "%TEMP%"
sPathOutputFolder = oShell.ExpandEnvironmentStrings(sPathOutputFolder)
sPathOutputFolder = Replace(sPathOutputFolder, "'","")
If sPathOutputFolder = "." OR Left(sPathOutputFolder, 2) = ".\" Then sPathOutputFolder = GetFullPathFromRelative(sPathOutputFolder)
sPathOutputFolder = oFso.GetAbsolutePathName(sPathOutputFolder)
If Trim(UCase(sPathOutputFolder)) = "DESKTOP" Then
Set oApp = CreateObject ("Shell.Application")
Const DESKTOP = &H10&
sPathOutputFolder = oApp.Namespace(DESKTOP).Self.Path
Set oApp = Nothing
End If
If Not oFso.FolderExists(sPathOutputFolder) Then
' custom log folder location does not exist.
' try to create the folder before falling back to default
oFso.CreateFolder sPathOutputFolder
If NOT Err = 0 Then
sPathOutputFolder = oShell.ExpandEnvironmentStrings("%TEMP%") & "\"
Err.Clear
End If
End If
While Right(sPathOutputFolder, 1) = "\"
sPathOutputFolder = Left(sPathOutputFolder, Len(sPathOutputFolder) - 1)
Wend
If Not Right(sPathOutputFolder, 1) = "\" Then sPathOutputFolder = sPathOutputFolder & "\"
sLogFile = sPathOutputFolder & sComputerName & "_ROIScan.log"
CacheLog LOGPOS_COMPUTER, LOGHEADING_H1, Null, "Computer"
CacheLog LOGPOS_REVITEM, LOGHEADING_H1, Null, "Review Items"
CacheLog LOGPOS_RAW, LOGHEADING_H1, Null, "Raw Data"
iPopup = -1
fPrompt = True
If Wscript.Arguments.Count > 0 Then
For Each Argument in Wscript.Arguments
If Argument = "UAC" Then fPrompt = False
Next 'Argument
End If
'Add warning to log if non-admin was detected
If Not fIsAdmin Then
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, ERR_NONADMIN
If NOT fQuiet AND fPrompt Then RelaunchElevated
End If
If fIsAdmin AND (NOT fIsElevated) Then
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, ERR_NONELEVATED
If NOT fQuiet AND fPrompt Then RelaunchElevated
End If
'Ensure CScript as engine
If (NOT UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C") AND (NOT fDisallowCScript) Then RelaunchAsCScript
'Check on 64 bit OS -> see CheckPreReq
'Init sCurUserSid
GetUserSids("Current")
'Init "arrUUSids"
Redim arrUUSids(-1)
GetUserSids ("UserUnmanaged")
'Init "arrUMSids"
Redim arrUMSids(-1)
GetUserSids("UserManaged")
'Init KeyComponents dictionary
Set dicKeyComponents = CreateObject("Scripting.Dictionary")
InitKeyComponents
iVMVirtOverride = 0
'Set defaults for ProductList arrays
InitPLArrays
Set dicMspIndex = CreateObject("Scripting.Dictionary")
bOsppInit = False
End Sub 'Initialize
'=======================================================================================================
'End Of Main Module
'=======================================================================================================
'Module FileInventory
'=======================================================================================================
'File inventory for installed applications
Sub FileInventory
Dim sProductCode, sQueryFT, sQueryMst, sQueryCompID, sQueryFC, sMst, sFtk, sCmp
Dim sPath, sName, sXmlLine, sAscCheck, sQueryDir, sQueryAssembly, sPatchCode
Dim sCurVer, sSqlCreateTable, sTables, sTargetPath
Dim iPosMaster, iPosPatch, iFoo, iFile, iMst, iCnt, iAsc, iAscCnt, iCmp
Dim iPosArr, iArrMaxCnt, iColCnt, iBaseRefCnt, iIndex
Dim bAsc, bMstApplied, bBaseRefFound, bFtkViewComplete, bFtkInScope, bFtkForceOutOfScope, bNeedKeyPathFallback
Dim bCreate, bDelete, bDrop, bInsert, bFileNameChanged
Dim MsiDb, SessionDb, MspDb, qViewFT, qViewMst, qViewCompID, qViewFC, qViewDir, qViewAssembly, Record, Record2, Record3
Dim qViewMspCompId, qViewMspFC, qViewMsiAssembly, AllOfficeFiles, FileStream
Dim SessionDir, Table, ViewTables, tbl
Dim dicTransforms, dicKeys
Dim arrTables
If fBasicMode Then Exit Sub
On Error Resume Next
Const FILES_FTK = 0 'key field for each file
Const FILES_SOURCE = 1
Const FILES_ISPATCHED = 2
Const FILES_FILESTATUS = 3
Const FILES_FILE = 4
Const FILES_FOLDER = 5
Const FILES_FULLNAME = 6
Const FILES_LANGUAGE = 7
Const FILES_BASEVERSION = 8
Const FILES_PATCHVERSION = 9
Const FILES_CURRENTVERSION = 10
Const FILES_VERSIONSTATUS = 11
Const FILES_PATCHCODE = 12 'key field for patch
Const FILES_PATCHSTATE = 13
Const FILES_PATCHKB = 14
Const FILES_PATCHPACKAGE = 15
Const FILES_PATCHMOREINFO = 16
Const FILES_DIRECTORY = 17
Const FILES_COMPONENTID = 18
Const FILES_COMPONENTNAME = 19
Const FILES_COMPONENTSTATE = 20
Const FILES_KEYPATH = 21
Const FILES_COMPONENTCLIENTS= 22
Const FILES_FEATURENAMES = 23
Const FILES_COLUMNCNT = 23
Const SQL_FILETABLE = "SELECT * FROM `_TransformView` WHERE `Table` = 'File' ORDER BY `Row`"
Const SQL_PATCHTRANSFORMS = "SELECT `Name` FROM `_Storages` ORDER BY `Name`"
Const INSTALLSTATE_ASSEMBLY = 6
Const WAITTIME = 500
' Loop all products
If fCScript AND NOT fQuiet Then wscript.echo vbTab & "File version scan"
For iPosMaster = 0 To UBound(arrMaster)
If (arrMaster(iPosMaster, COL_ISOFFICEPRODUCT)) AND (arrMaster(iPosMaster, COL_CONTEXT) = MSIINSTALLCONTEXT_MACHINE) Then
' Cache ProductCode
sProductCode = "" : sProductCode = arrMaster(iPosMaster, COL_PRODUCTCODE)
If fCScript AND NOT fQuiet Then wscript.echo vbTab & sProductCode
' Reset Files array
iPosArr = -1
iArrMaxCnt = 5000
ReDim arrFiles(FILES_COLUMNCNT, iArrMaxCnt)
iBaseRefCnt = 0
For iFoo = 1 To 1
' Add fields from msi base
' ------------------------
' Connect to the local .msi file for reading
Err.Clear
Set MsiDb = oMsi.OpenDatabase(arrMaster(iPosMaster, COL_CACHEDMSI), MSIOPENDATABASEMODE_READONLY)
If Not Err = 0 Then
Exit For
End If 'Err = 0
' Check which tables exist in the current .msi
sTables = ""
Set ViewTables = MsiDb.OpenView("SELECT `Name` FROM `_Tables` ORDER BY `Name`")
ViewTables.Execute
Do
Set Table = ViewTables.Fetch
If Table Is Nothing then Exit Do
sTables = sTables & Table.StringData(1) & ","
If Not Err = 0 Then Exit Do
Loop
ViewTables.Close
arrTables = Split(RTrimComma(sTables), ",")
' Build an assembly reference dictionary
Set dicAssembly = Nothing
Set dicAssembly = CreateObject("Scripting.Dictionary")
If InStr(sTables, "MsiAssembly,") > 0 Then
sQueryAssembly = "SELECT DISTINCT `Component_` FROM MsiAssembly"
Set qViewAssembly = MsiDb.OpenView(sQueryAssembly)
qViewAssembly.Execute
' If the MsiAssmbly table does not exist it returns an error
If Not Err = 0 Then Err.Clear
Set Record = qViewAssembly.Fetch
' must not enter the loop in case of an error!
If Not Err = 0 Then
Err.Clear
Else
Do Until Record Is Nothing
If Not dicAssembly.Exists(Record.StringData(1)) Then
dicAssembly.Add Record.StringData(1), Record.StringData(1)
End If
Set Record = qViewAssembly.Fetch
Loop
End If 'Not Err = 0
qViewAssembly.Close
End If 'InStr(sTables, "MsiAssembly") > 0
If InStr(sTables, "SxsMsmGenComponents,") > 0 Then
sQueryAssembly = "SELECT DISTINCT `Component_` FROM SxsMsmGenComponents"
Set qViewAssembly = MsiDb.OpenView(sQueryAssembly)
qViewAssembly.Execute
' If the MsiAssmbly table does not exist it returns an error
If Not Err = 0 Then Err.Clear
Set Record = qViewAssembly.Fetch
' must not enter the loop in case of an error!
If Not Err = 0 Then
Err.Clear
Else
Do Until Record Is Nothing
If Not dicAssembly.Exists(Record.StringData(1)) Then
dicAssembly.Add Record.StringData(1), Record.StringData(1)
End If
Set Record = qViewAssembly.Fetch
Loop
End If 'Not Err = 0
qViewAssembly.Close
End If 'InStr(sTables, "MsiAssembly") > 0
' Build directory reference
Set SessionDir = Nothing
oMsi.UILevel = 2 'None
Set SessionDir = oMsi.OpenProduct(sProductCode)
SessionDir.DoAction("CostInitialize")
SessionDir.DoAction("FileCost")
SessionDir.DoAction("CostFinalize")
Set dicFolders = Nothing
Set dicFolders = CreateObject("Scripting.Dictionary")
Err.Clear
Set SessionDb = SessionDir.Database
sQueryDir = "SELECT DISTINCT `Directory` FROM Directory"
Set qViewDir = SessionDb.OpenView(sQueryDir)
qViewDir.Execute
Set Record = qViewDir.Fetch
' must not enter the loop in case of an error!
If Not Err = 0 Then
Err.Clear
Else
Do Until Record Is Nothing
If Not dicFolders.Exists(Record.Stringdata(1)) Then
sTargetPath = "" : sTargetPath = SessionDir.TargetPath(Record.Stringdata(1))
If NOT sTargetPath = "" Then dicFolders.Add Record.Stringdata(1), sTargetPath
End If
Set Record = qViewDir.Fetch
Loop
End If 'Not Err = 0
qViewDir.Close
' .msi file inventory
' -------------------
sQueryFT = "SELECT * FROM File"
Set qViewFT = MsiDb.OpenView(sQueryFT)
qViewFT.Execute
Set Record = qViewFT.Fetch()
Do Until Record Is Nothing
' Next Row in Array
' -----------------
iPosArr = iPosArr + 1
iBaseRefCnt = iPosArr
If iPosArr > iArrMaxCnt Then
' increase array row buffer
iArrMaxCnt = iArrMaxCnt + 1000
ReDim Preserve arrFiles(FILES_COLUMNCNT, iArrMaxCnt)
End If 'iPosArr > iArrMaxCnt
' add FTK name
arrFiles(FILES_FTK, iPosArr) = Record.StringData(1)
' the FilesSource flag allows to filter the data in the report to exclude patch only entries.
arrFiles(FILES_SOURCE, iPosArr) = "Msi"
' default IsPatched field to 'False'
arrFiles(FILES_ISPATCHED, iPosArr) = False
' add the LFN (long filename)
arrFiles(FILES_FILE, iPosArr) = GetLongFileName(Record.StringData(3))
' add ComponentName
arrFiles(FILES_COMPONENTNAME, iPosArr) = Record.StringData(2)
' add ComponentID and Directory reference from Component table
sQueryCompID = "SELECT `Component`, `ComponentId`, `Directory_` FROM Component WHERE `Component` = '" & Record.StringData(2) & "'"
Set qViewCompID = MsiDb.OpenView(sQueryCompID)
qViewCompID.Execute
Set Record2 = qViewCompID.Fetch()
arrFiles(FILES_COMPONENTID, iPosArr) = Record2.StringData(2)
arrFiles(FILES_DIRECTORY, iPosArr) = Record2.StringData(3)
Set Record2 = Nothing
qViewCompID.Close
Set qViewCompID = Nothing
' ComponentState
arrFiles(FILES_COMPONENTSTATE, iPosArr) = GetComponentState(sProductCode, arrFiles(FILES_COMPONENTID, iPosArr), iPosMaster)
' add ComponentClients
arrFiles(FILES_COMPONENTCLIENTS, iPosArr) = GetComponentClients(arrFiles(FILES_COMPONENTID, iPosArr), arrFiles(FILES_COMPONENTSTATE, iPosArr))
' add Features that use the component
sQueryFC = "SELECT * FROM FeatureComponents WHERE `Component_` = '" & Record.StringData(2) & "'"
Set qViewFC = MsiDb.OpenView(sQueryFC)
qViewFC.Execute
Set Record2 = qViewFC.Fetch()
Do Until Record2 Is Nothing
arrFiles(FILES_FEATURENAMES, iPosArr) = arrFiles(FILES_FEATURENAMES, iPosArr) & Record2.StringData(1) & _
"(" & TranslateFeatureState(oMsi.FeatureState(sProductCode, Record2.StringData(1))) & ")" & ","
Set Record2 = qViewFC.Fetch()
Loop
RTrimComma arrFiles(FILES_FEATURENAMES, iPosArr)
' add KeyPath
arrFiles(FILES_KEYPATH, iPosArr) = GetComponentPath(sProductCode, arrFiles(FILES_COMPONENTID, iPosArr), arrFiles(FILES_COMPONENTSTATE, iPosArr))
sPath = "" : sName = ""
' add Componentpath
If dicAssembly.Exists(arrFiles(FILES_COMPONENTNAME, iPosArr)) Then
' Assembly
If arrFiles(FILES_COMPONENTSTATE, iPosArr) = INSTALLSTATE_LOCAL Then
sPath = GetAssemblyPath(arrFiles(FILES_FILE, iPosArr), arrFiles(FILES_KEYPATH, iPosArr), dicFolders.Item(arrFiles(FILES_DIRECTORY, iPosArr)))
arrFiles(FILES_FOLDER, iPosArr) = Left(sPath, InStrRev(sPath, "\"))
Else
arrFiles(FILES_FOLDER, iPosArr) = sPath
End If
Else
' Regular component
arrFiles(FILES_FOLDER, iPosArr) = dicFolders.Item(arrFiles(FILES_DIRECTORY, iPosArr))
If arrFiles(FILES_FOLDER, iPosArr) = "" Then
' failed to obtain the directory from the session object
' try again by direct read from session object
arrFiles(FILES_FOLDER, iPosArr) = SessionDir.TargetPath(arrFiles(FILES_DIRECTORY, iPosArr))
' if still failed, fall back to the keypath by using the assembly logic to resolve the path
If arrFiles(FILES_FOLDER, iPosArr) = "" AND arrFiles(FILES_COMPONENTSTATE, iPosArr) = INSTALLSTATE_LOCAL Then
sPath = GetAssemblyPath(arrFiles(FILES_FILE, iPosArr), arrFiles(FILES_KEYPATH, iPosArr), dicFolders.Item(arrFiles(FILES_DIRECTORY, iPosArr)))
arrFiles(FILES_FOLDER, iPosArr) = Left(sPath, InStrRev(sPath, "\"))
End If
End If
End If
' add file FullName - if sPath contains a string then it's the result of the assembly detection
If sPath = "" Then
arrFiles(FILES_FULLNAME, iPosArr) = GetFileFullName(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FOLDER, iPosArr), arrFiles(FILES_FILE, iPosArr))
Else
arrFiles(FILES_FULLNAME, iPosArr) = sPath
sName = Right(sPath, Len(sPath) -InStrRev(sPath, "\"))
'Update the files field
If Not UCase(sName) = UCase(arrFiles(FILES_FILE, iPosArr)) Then _
arrFiles(FILES_FILE, iPosArr) = sName
End If
' add (msi) BaseVersion
If Not Err = 0 Then Err.Clear
arrFiles(FILES_BASEVERSION, iPosArr) = Record.StringData(5)
' add FileState and FileVersion
arrFiles(FILES_FILESTATUS, iPosArr) = GetFileState(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FULLNAME, iPosArr))
arrFiles(FILES_CURRENTVERSION, iPosArr) = GetFileVersion(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FULLNAME, iPosArr))
' add Language
arrFiles(FILES_LANGUAGE, iPosArr) = Record.StringData(6)
' get next row
Set Record = qViewFT.Fetch()
Loop
Set Record = Nothing
qViewFT.Close
Set qViewFT = Nothing
' --------------
' Add patches '
' --------------
' loop through all patches for the current product
For iPosPatch = 0 to UBound(arrPatch, 3)
If Not (IsEmpty (arrPatch(iPosMaster, PATCH_PATCHCODE, iPosPatch))) AND (arrPatch(iPosMaster, PATCH_CSP, iPosPatch) = True) Then
Err.Clear
sPatchCode = arrPatch(iPosMaster, PATCH_PATCHCODE, iPosPatch)
Set MspDb = oMsi.OpenDatabase(arrPatch(iPosMaster, PATCH_LOCALPACKAGE, iPosPatch), MSIOPENDATABASEMODE_PATCHFILE)
If Err = 0 Then
' create the table structures from .msi schema to allow detailed query of the .msp _TransformView
For Each tbl in arrTables
sSqlCreateTable = "CREATE TABLE `" & tbl & "` (" & GetTableColumnDef(MsiDb, tbl) & " PRIMARY KEY " & GetPrimaryTableKeys(MsiDb, tbl) & ")"
MspDb.OpenView(sSqlCreateTable).Execute
Next 'tbl
' check if a PatchTransform is available
sMst = "" : bMstApplied = False
sMst = arrPatch(iPosMaster, PATCH_TRANSFORM, iPosPatch)
Err.Clear
If InStr(sMst, ";") > 0 Then
bMstApplied = True
sMst = Left(sMst, InStr(sMst, ";") - 1)
' apply the patch transform
' msiTransformErrorAll includes msiTransformErrorViewTransform which creates the "_TransformView" table
MspDb.ApplyTransform sMst, MSITRANSFORMERROR_ALL
End If 'InStr(sMst, ";") > 0
' if no known .mst or failed to apply the .mst we go into generic patch embedded transform detection loop
If (Not bMstApplied) OR (Not Err = 0) Then
Err.Clear
' Dictionary object for the patch transforms
Set dicTransforms = CreateObject("Scripting.Dictionary")
' create the view to retrieve the patch transforms
sQueryMst = SQL_PATCHTRANSFORMS
Set qViewMst = MspDb.OpenView(sQueryMst): qViewMst.Execute
Set Record = qViewMst.Fetch
' loop all transforms and add them to the dictionary
Do Until Record Is Nothing
sMst = Record.StringData(1)
dicTransforms.Add sMst, sMst
Set Record = qViewMst.Fetch
Loop
qViewMst.Close : Set qViewMst = Nothing
Set Record = Nothing
' apply the patch transforms
dicKeys = dicTransforms.Keys
For iMst = 0 To dicTransforms.Count - 1
' get the transform name
sMst = dicKeys(iMst)
' apply the patch transform / staple them all on the table
MspDb.ApplyTransform ":" & sMst, MSITRANSFORMERROR_ALL
If Not Err = 0 Then Err.Clear
Next 'iMst
End If '(Not bMstApplied) OR (Not Err = 0)
' _TransformView loop
' -------------------
' update the MsiAssembly reference dictionary
Err.Clear
If InStr(sTables, "MsiAssembly,") > 0 Then
Set qViewMsiAssembly = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table`='MsiAssembly' ORDER By `Row`")
qViewMsiAssembly.Execute()
Set Record = qViewMsiAssembly.Fetch()
Do
If Record Is Nothing Then Exit Do
If Not Err = 0 Then
Err.Clear
Exit Do
End If
If Record.StringData(2) = "INSERT" Then
If Not dicAssembly.Exists(Record.StringData(3)) Then dicAssembly.Add Record.StringData(3), Record.StringData(3)
End If
Set Record = qViewMsiAssembly.Fetch()
Loop
qViewMsiAssembly.Close
End If
Set Record = Nothing
If InStr(sTables, "SxsMsmGenComponents,") > 0 Then
Set qViewMsiAssembly = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table`='SxsMsmGenComponents' ORDER By `Row`")
qViewMsiAssembly.Execute()
Set Record = qViewMsiAssembly.Fetch()
Do
If Record Is Nothing Then Exit Do
If Not Err = 0 Then
Err.Clear
Exit Do
End If
If Record.StringData(2) = "INSERT" Then
If Not dicAssembly.Exists(Record.StringData(3)) Then dicAssembly.Add Record.StringData(3), Record.StringData(3)
End If
Set Record = qViewMsiAssembly.Fetch()
Loop
qViewMsiAssembly.Close
End If
Set Record = Nothing
' get the files being modified from the "_TransformView" 'File' table
Set qViewMst = MspDb.OpenView(SQL_FILETABLE) : qViewMst.Execute()
' loop all of the entries in the File table from "_TransformView"
Set Record = qViewMst.Fetch()
' initial defaults
sFtk = ""
bFtkViewComplete = True
bFtkInScope = False
Do
' is this the next FTK?
If (Not sFtk = Record.StringData(3)) OR (Record Is Nothing) Then
If Record Is Nothing Then Err.Clear
' yes this is the next FTK or the last time before exit of the loop
' is previous FTK handling complete?
If Not bFtkViewComplete Then
' previous FTK handling is not complete
' is previous FTK in scope?
If bFtkInScope AND NOT bFtkForceOutOfScope Then
'FTK is in scope - reset the scope flag
bFtkInScope = False
If bBaseRefFound Then
' update base entry fields with patch information
' check if the filename got updated
If bFileNameChanged Then
arrFiles(FILES_FILE, iPosArr) = GetLongFileName(arrFiles(FILES_FILE, iPosArr))
' the filename got changed by a patch
' if the patch is in the 'Applied' state -> care about this change
If LCase(arrFiles(FILES_PATCHSTATE, iPosArr)) = "applied" Then
' update the filename in the baseref if this is (NOT Assembly) OR (broken)
If NOT(dicAssembly.Exists(arrFiles(FILES_COMPONENTNAME, iPosArr))) OR (arrFiles(FILES_FILESTATUS, iPosArr) = INSTALLSTATE_BROKEN) Then
' correct the baseref filename field
arrFiles(FILES_FILE, iCnt) = arrFiles(FILES_FILE, iPosArr)
' File FullName
arrFiles(FILES_FULLNAME, iPosArr) = GetFileFullName(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FOLDER, iPosArr), arrFiles(FILES_FILE, iPosArr))
' recheck the filestate
arrFiles(FILES_FILESTATUS, iPosArr) = GetFileState(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FULLNAME, iPosArr))
arrFiles(FILES_FILESTATUS, iCnt) = arrFiles(FILES_FILESTATUS, iPosArr)
' recheck the version
arrFiles(FILES_CURRENTVERSION, iPosArr) = GetFileVersion(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FULLNAME, iPosArr))
arrFiles(FILES_CURRENTVERSION, iCnt) = arrFiles(FILES_CURRENTVERSION, iPosArr)
End If
End If 'applied
End If 'bFileNameChanged
' set IsPatched flag
arrFiles(FILES_ISPATCHED, iCnt) = True
' check if PatchVersion field needs to be updated
iCmp = 2 : sCmp = ""
iCmp = CompareVersion(arrFiles(FILES_PATCHVERSION, iPosArr), arrFiles(FILES_PATCHVERSION, iCnt), True)
Select Case iCmp
Case VERSIONCOMPARE_LOWER ': sCmp= "ERROR_VersionLow"
Case VERSIONCOMPARE_MATCH ': sCmp= "SUCCESS_VersionMatch"
Case VERSIONCOMPARE_HIGHER ': sCmp= "SUCCESS_VersionHigh"
' update the base field
arrFiles(FILES_PATCHVERSION, iCnt) = arrFiles(FILES_PATCHVERSION, iPosArr)
Case VERSIONCOMPARE_INVALID ': sCmp= ""
End Select
' update PatchCode field
arrFiles(FILES_PATCHCODE, iCnt) = arrFiles(FILES_PATCHCODE, iCnt) & sPatchCode & ","
' update PatchKB field
If dicMspIndex.Exists(sPatchCode) Then arrFiles(FILES_PATCHKB, iCnt) = arrFiles(FILES_PATCHKB, iCnt) & arrFiles(FILES_PATCHKB, iPosArr) & ","
' update PatchMoreInfo field
arrFiles(FILES_PATCHMOREINFO, iCnt) = arrFiles(FILES_PATCHMOREINFO, iCnt) & arrPatch(iPosMaster, PATCH_MOREINFOURL, iPosPatch) & ","
Else
' bBaseRefFound is False.
' -----------------------
' this is a new file introduced with the patch. set FileSource flag
arrFiles(FILES_SOURCE, iPosArr) = "Msp"
' define IsPatched field
arrFiles(FILES_ISPATCHED, iPosArr) = False
' add the LFN (long file name)
arrFiles(FILES_FILE, iPosArr) = GetLongFileName(arrFiles(FILES_FILE, iPosArr))
' locate the ComponentId from Component table
sQueryCompID = "SELECT `Component`, `ComponentId`, ´Directory_` FROM Component WHERE `Component` = '" & arrFiles(FILES_COMPONENTNAME, iPosArr) & "'"
Set qViewCompID = MsiDb.OpenView(sQueryCompID)
If Not Err = 0 Then
Err.Clear
Set Record2 = Nothing
Else
qViewCompID.Execute
Set Record2 = qViewCompID.Fetch()
End If
If Not Record2 Is Nothing Then
' found the ComponentId
' this is a new file added to an existing component
arrFiles(FILES_COMPONENTID, iPosArr) = Record2.StringData(2)
' add the Directory_ reference
arrFiles(FILES_DIRECTORY, iPosArr) = Record2.StringData(3)
Set Record2 = Nothing
qViewCompID.Close
Set qViewCompID = Nothing
Else
' did not find the ComponentId in the base .msi
' this is a new file AND a new component -> need to query the .msp for details
Set qViewMspCompId = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table`='Component' ORDER BY `Row`")
qViewMspCompID.Execute
Do
Set Record3 = qViewMspCompId.Fetch()
If Record3 Is Nothing Then Exit Do
If Record3.StringData(3) = arrFiles(FILES_COMPONENTNAME, iPosArr) Then
If Record3.StringData(2) = "ComponentId" Then
arrFiles(FILES_COMPONENTID, iPosArr) = Record3.StringData(4)
ElseIf Record3.StringData(2) = "Directory_" Then
arrFiles(FILES_DIRECTORY, iPosArr) = Record3.StringData(4)
End If
End If
Loop
qViewMspCompID.Close
If arrFiles(FILES_COMPONENTID, iPosArr) = "" Then bFtkForceOutOfScope = True
End If 'Not Record2 Is Nothing
' all other logic is only needed if in scope
If Not bFtkForceOutOfScope Then
' ensure the directory reference exists
If Not dicFolders.Exists(arrFiles(FILES_DIRECTORY, iPosArr)) Then
If SessionDir Is Nothing Then
' try to recover lost SessionDir object
Set SessionDir = oMsi.OpenProduct(sProductCode)
SessionDir.DoAction("CostInitialize")
SessionDir.DoAction("FileCost")
SessionDir.DoAction("CostFinalize")
End If
dicFolders.Add arrFiles(FILES_DIRECTORY, iPosArr), SessionDir.TargetPath(arrFiles(FILES_DIRECTORY, iPosArr))
If Not Err = 0 Then
Err.Clear
' still failed to identify the path - get rid of this entry
bNeedKeyPathFallback = True
End If
End If
' ComponentState
arrFiles(FILES_COMPONENTSTATE, iPosArr) = GetComponentState(sProductCode, arrFiles(FILES_COMPONENTID, iPosArr), iPosMaster)
' add ComponentClients
arrFiles(FILES_COMPONENTCLIENTS, iPosArr) = GetComponentClients(arrFiles(FILES_COMPONENTID, iPosArr), arrFiles(FILES_COMPONENTSTATE, iPosArr))
' add Features that use the component
Set qViewMspFC = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table`='FeatureComponents' ORDER BY `Row`")
qViewMspFC.Execute
Set Record2 = qViewMspFC.Fetch()
Do
Set Record2 = qViewMspFC.Fetch()
If Record2 Is Nothing Then Exit Do
If Record2.StringData(4) = arrFiles(FILES_COMPONENTNAME, iPosArr) Then
If Record2.StringData(2) = "Feature_" Then
arrFiles(FILES_FEATURENAMES, iPosArr) = arrFiles(FILES_FEATURENAMES, iPosArr) & Record2.StringData(3) & _
"(" & TranslateFeatureState(oMsi.FeatureState(sProductCode, Record2.StringData(3))) & ")" & ","
End If
End If
Loop
qViewMspFC.Close
Set Record2 = Nothing
RTrimComma arrFiles(FILES_FEATURENAMES, iPosArr)
' add KeyPath
arrFiles(FILES_KEYPATH, iPosArr) = GetComponentPath(sProductCode, arrFiles(FILES_COMPONENTID, iPosArr), arrFiles(FILES_COMPONENTSTATE, iPosArr))
' add Componentpath
sPath = "" : sName = ""
If dicAssembly.Exists(arrFiles(FILES_COMPONENTNAME, iPosArr)) Then
' Assembly
If arrFiles(FILES_COMPONENTSTATE, iPosArr) = INSTALLSTATE_LOCAL Then
sPath = GetAssemblyPath(arrFiles(FILES_FILE, iPosArr), arrFiles(FILES_KEYPATH, iPosArr), dicFolders.Item(arrFiles(FILES_DIRECTORY, iPosArr)))
arrFiles(FILES_FOLDER, iPosArr) = Left(sPath, InStrRev(sPath, "\"))
sName = Right(sPath, Len(sPath) -InStrRev(sPath, "\"))
' update the files field to ensure the correct value
If Not UCase(sName) = UCase(arrFiles(FILES_FILE, iPosArr)) Then _
arrFiles(FILES_FILE, iPosArr) = sName
Else
arrFiles(FILES_FOLDER, iPosArr) = sPath
End If
Else
' Regular component
If bNeedKeyPathFallback Then
arrFiles(FILES_FOLDER, iPosArr) = Left(arrFiles(FILES_KEYPATH, iPosArr), InStrRev(arrFiles(FILES_KEYPATH, iPosArr), "\"))
Else
arrFiles(FILES_FOLDER, iPosArr) = dicFolders.Item(arrFiles(FILES_DIRECTORY, iPosArr))
End If
End If
' add file FullName
' if sPath contains a string then it's the result of the assembly detection
If sPath = "" Then
arrFiles(FILES_FULLNAME, iPosArr) = GetFileFullName(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FOLDER, iPosArr), arrFiles(FILES_FILE, iPosArr))
Else
arrFiles(FILES_FULLNAME, iPosArr) = arrFiles(FILES_FOLDER, iPosArr) & arrFiles(FILES_FILE, iPosArr)
End If
' add FileState and FileVersion
arrFiles(FILES_FILESTATUS, iPosArr) = GetFileState(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FULLNAME, iPosArr))
arrFiles(FILES_CURRENTVERSION, iPosArr) = GetFileVersion(arrFiles(FILES_COMPONENTSTATE, iPosArr), arrFiles(FILES_FULLNAME, iPosArr))
End If
End If 'bBaseRefFound
Else
' No - FTK not in scope
bFtkForceOutOfScope = False
' delete all row contents
For iColCnt = 0 To FILES_COLUMNCNT
arrFiles(iColCnt, iPosArr) = ""
Next 'iColCnt
' decrease array counter
iPosArr = iPosArr - 1
End If 'bFtkInScope
If bFtkForceOutOfScope Then
' delete all row contents
For iColCnt = 0 To FILES_COLUMNCNT
arrFiles(iColCnt, iPosArr) = ""
Next 'iColCnt
' decrease array counter
iPosArr = iPosArr - 1
End If
End If 'bFtkViewComplete
bFtkViewComplete = True
' Previous FTK handling is now complete
' -------------------------------------
If Record Is Nothing Then Exit Do
' Init new FTK row
' ----------------
' increase array pointer
iPosArr = iPosArr + 1
bFtkViewComplete = False
bFtkInScope = False
bFtkForceOutOfScope = False
bInsert = False
bFileNameChanged = False
If iPosArr > iArrMaxCnt Then
' add more rows to array
iArrMaxCnt = iArrMaxCnt + 1000
ReDim Preserve arrFiles(FILES_COLUMNCNT, iArrMaxCnt)
End If 'iPosArr > iArrMaxCnt
' update current FTK cache reference
sFtk = Record.StringData(3)
' locate the FTK reference from msi base
bBaseRefFound = False
For iCnt = 0 To iBaseRefCnt
If arrFiles(FILES_FTK, iCnt) = sFtk Then
bBaseRefFound = True
' copy known fields from Base version if applicable
If bBaseRefFound Then
For iColCnt = 0 To FILES_COLUMNCNT
arrFiles(iColCnt, iPosArr) = arrFiles(iColCnt, iCnt)
Next 'iColCnt
bFtkInScope = True
End If 'bBaseRefFound
Exit For 'iCnt = 0 To UBound(arrFiles, 2) - 1
End If 'arrFiles(FILES_FTK, iCnt) = sFtk Then
Next 'iCnt
' add initial available data
' correct/ensure FTK name
arrFiles(FILES_FTK, iPosArr) = Record.StringData(3)
' correct IsPatched field
arrFiles(FILES_ISPATCHED, iPosArr) = False
' correct/ensure FileSource
arrFiles(FILES_SOURCE, iPosArr) = "Msp"
' add fields from patch array
arrFiles(FILES_PATCHSTATE, iPosArr) = arrPatch(iPosMaster, PATCH_PATCHSTATE, iPosPatch)
arrFiles(FILES_PATCHCODE, iPosArr) = arrPatch(iPosMaster, PATCH_PATCHCODE, iPosPatch)
arrFiles(FILES_PATCHMOREINFO, iPosArr) = arrPatch(iPosMaster, PATCH_MOREINFOURL, iPosPatch)
' add KB reference
If dicMspIndex.Exists(sPatchCode) Then
iIndex = dicMspIndex.Item(sPatchCode)
arrFiles(FILES_PATCHKB, iPosArr) = arrMspFiles(iIndex, MSPFILES_KB)
arrFiles(FILES_PATCHPACKAGE, iPosArr) = arrMspFiles(iIndex, MSPFILES_PACKAGE)
End If
' new FTK row init complete
End If 'Not sFtk = Record.StringData(3)
' add data from _TransformView
Select Case Record.StringData(2)
Case "File"
Case "FileSize"
Case "Component_"
arrFiles(FILES_COMPONENTNAME, iPosArr) = Record.StringData(4)
Case "CREATE"
Case "DELETE"
Case "DROP"
Case "FileName"
'Add the filename
bFileNameChanged = True
arrFiles(FILES_FILE, iPosArr) = Record.StringData(4)
Case "Version"
' don't allow version field to contain alpha characters
bAsc = True : sAscCheck = "" : sAscCheck = Record.StringData(4)
If Len(sAscCheck) > 0 Then
For iAscCnt = 1 To Len(sAscCheck)
iAsc = Asc(UCase(Mid(sAscCheck, iAscCnt, 1)))
If (iAsc>64) AND (iAsc<91) Then
bAsc = False
Exit For
End If
Next 'iCnt
End If 'Len(sAscCheck) > 0
If bAsc Then arrFiles(FILES_PATCHVERSION, iPosArr) = Record.StringData(4)
Case "Language"
arrFiles(FILES_LANGUAGE, iPosArr) = Record.StringData(4)
Case "Attributes"
Case "Sequence"
Case "INSERT"
' this is a new file added by the pach
bFtkInScope = True
bInsert = True
Case Else
End Select
' get the next record (column) from _TransformView
Set Record = qViewMst.Fetch()
Loop
' _TransformView analysis for this patch complete
' reset views
MspDb.OpenView("ALTER TABLE _TransformView FREE").Execute
MspDb.OpenView("DROP TABLE `File`").Execute
End If 'Err = 0
End If 'IsEmpty
Next 'iPosPatch
Next 'iFoo
' Final field & verb fixups
' -------------------------
For iFile = 0 To iPosArr
' File VersionState translation
iCmp = 2 : sCmp = "" : sCurVer = ""
If arrFiles(FILES_ISPATCHED, iFile) OR (arrFiles(FILES_SOURCE, iFile) = "Msp") Then
' compare actual file version to patch file version
sCurVer = arrFiles(FILES_PATCHVERSION, iFile)
Else
' compare actual file version to base file version
sCurVer = arrFiles(FILES_BASEVERSION, iFile)
End If 'arrFiles(FILES_ISPATCHED, iFile)
iCmp = CompareVersion(arrFiles(FILES_CURRENTVERSION, iFile), sCurVer, False)
Select Case iCmp
Case VERSIONCOMPARE_LOWER
sCmp= "ERROR_VersionLow"
' log error
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, ERR_FILEVERSIONLOW & arrMaster(iPosMaster, COL_PRODUCTCODE) & DSV & _
arrMaster(iPosMaster, COL_PRODUCTNAME)
If Not InStr(arrMaster(iPosMaster, COL_ERROR), arrFiles(FILES_FILE, iFile) & " expected: ") > 0 Then
arrMaster(iPosMaster, COL_ERROR) = arrMaster(iPosMaster, COL_ERROR) & ERR_CATEGORYERROR & arrFiles(FILES_FILE, iFile) & " expected: " & sCurVer & " found: " & arrFiles(FILES_CURRENTVERSION, iFile) & CSV
End If
Case VERSIONCOMPARE_MATCH : sCmp= "SUCCESS_VersionMatch"
Case VERSIONCOMPARE_HIGHER : sCmp= "SUCCESS_VersionHigh"
Case VERSIONCOMPARE_INVALID : sCmp= ""
End Select
arrFiles(FILES_VERSIONSTATUS, iFile) = sCmp
' FileState translation
sCmp = ""
Select Case arrFiles(FILES_FILESTATUS, iFile)
Case INSTALLSTATE_LOCAL : sCmp = "OK_Local"
Case INSTALLSTATE_BROKEN
sCmp = "ERROR_Broken"
' log error
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, "Product " & arrMaster(iPosMaster, COL_PRODUCTCODE) & DSV & _
arrMaster(iPosMaster, COL_PRODUCTNAME) & ": " & ERR_BADFILESTATE
If Not InStr(arrMaster(iPosMaster, COL_ERROR), arrFiles(FILES_FILE, iFile) & " FileState: Broken") > 0 Then
arrMaster(iPosMaster, COL_ERROR) = arrMaster(iPosMaster, COL_ERROR) & ERR_CATEGORYERROR & arrFiles(FILES_FILE, iFile) & " FileState: Broken" & CSV
End If
Case INSTALLSTATE_UNKNOWN
sCmp = "Unknown"
If Not arrFiles(FILES_FEATURENAMES, iFile) = "" Then sCmp=Mid(arrFiles(FILES_FEATURENAMES, iFile), InStrRev(arrFiles(FILES_FEATURENAMES, iFile), "(") + 1, Len(arrFiles(FILES_FEATURENAMES, iFile)) -InStrRev(arrFiles(FILES_FEATURENAMES, iFile), "(") - 1)
Case INSTALLSTATE_NOTUSED : sCmp = "NotUsed"
Case INSTALLSTATE_ASSEMBLY : sCmp = "Assembly"
Case Else
End Select
arrFiles(FILES_FILESTATUS, iFile) = sCmp
' ComponentState translation
sCmp = ""
Select Case arrFiles(FILES_COMPONENTSTATE, iFile)
Case INSTALLSTATE_LOCAL : sCmp = "Local"
Case INSTALLSTATE_BROKEN : sCmp = "Broken"
Case INSTALLSTATE_UNKNOWN : sCmp = "Unknown"
Case INSTALLSTATE_NOTUSED : sCmp = "NotUsed"
Case Else
End Select
arrFiles(FILES_COMPONENTSTATE, iFile) = sCmp
' PatchCode field trim
arrFiles(FILES_PATCHCODE, iFile) = RTrimComma(arrFiles(FILES_PATCHCODE, iFile))
' PatchKB field trim
arrFiles(FILES_PATCHKB, iFile) = RTrimComma(arrFiles(FILES_PATCHKB, iFile))
' PatchInfo field trim
arrFiles(FILES_PATCHMOREINFO, iFile) = RTrimComma(arrFiles(FILES_PATCHMOREINFO, iFile))
Next 'iFile
' dump out the collected data to file
' create the AllOffice file
If IsEmpty(AllOfficeFiles) Then
If NOT oFso.FolderExists(sPathOutputFolder & "ROIScan") Then oFso.CreateFolder(sPathOutputFolder & "ROIScan")
Set AllOfficeFiles = oFso.CreateTextFile(sPathOutputFolder & "ROIScan\" & sComputerName & "_OfficeAll_FileList.xml", True, True)
AllOfficeFiles.WriteLine "<?xml version= ""1.0""?>"
AllOfficeFiles.WriteLine "<FILEDATA>"
End If
' individual products file
If NOT oFso.FolderExists(sPathOutputFolder & "ROIScan") Then oFso.CreateFolder(sPathOutputFolder & "ROIScan")
Set FileStream = oFso.CreateTextFile(sPathOutputFolder & "ROIScan\" & sComputerName & "_" & sProductCode & "_FileList.xml", True, True)
FileStream.WriteLine "<?xml version= ""1.0""?>"
FileStream.WriteLine "<FILEDATA>"
FileStream.WriteLine vbTab & "<PRODUCT ProductCode=""" & sProductCode & """ >"
If arrMaster(iPosMaster, COL_ISOFFICEPRODUCT) Then AllOfficeFiles.WriteLine vbTab & "<PRODUCT ProductCode=""" & sProductCode & """ >"
For iFile = 0 To iPosArr
sXmlLine = ""
sXmlLine = vbTab & vbTab & "<FILE " & _
"FileName=" & chr(34) & arrFiles(FILES_FILE, iFile) & chr(34) & " " & _
"FileState=" & chr(34) & arrFiles(FILES_FILESTATUS, iFile) & chr(34) & " " & _
"VersionStatus=" & chr(34) & arrFiles(FILES_VERSIONSTATUS, iFile) & chr(34) & " " & _
"CurrentVersion=" & chr(34) & arrFiles(FILES_CURRENTVERSION, iFile) & chr(34) & " " & _
"InitialVersion=" & chr(34) & arrFiles(FILES_BASEVERSION, iFile) & chr(34) & " " & _
"PatchVersion=" & chr(34) & arrFiles(FILES_PATCHVERSION, iFile) & chr(34) & " " & _
"FileSource=" & chr(34) & arrFiles(FILES_SOURCE, iFile) & chr(34) & " " & _
"IsPatched=" & chr(34) & arrFiles(FILES_ISPATCHED, iFile) & chr(34) & " " & _
"KB=" & chr(34) & arrFiles(FILES_PATCHKB, iFile) & chr(34) & " " & _
"Package=" & chr(34) & arrFiles(FILES_PATCHPACKAGE, iFile) & chr(34) & " " & _
"PatchState=" & chr(34) & arrFiles(FILES_PATCHSTATE, iFile) & chr(34) & " " & _
"FolderName=" & chr(34) & arrFiles(FILES_FOLDER, iFile) & chr(34) & " " & _
"PatchCode=" & chr(34) & arrFiles(FILES_PATCHCODE, iFile) & chr(34) & " " & _
"PatchInfo=" & chr(34) & arrFiles(FILES_PATCHMOREINFO, iFile) & chr(34) & " " & _
"FtkName=" & chr(34) & arrFiles(FILES_FTK, iFile) & chr(34) & " " & _
"KeyPath=" & chr(34) & arrFiles(FILES_KEYPATH, iFile) & chr(34) & " " & _
"MsiDirectory=" & chr(34) & arrFiles(FILES_DIRECTORY, iFile) & chr(34) & " " & _
"Language=" & chr(34) & arrFiles(FILES_LANGUAGE, iFile) & chr(34) & " " & _
"ComponentState=" & chr(34) & arrFiles(FILES_COMPONENTSTATE, iFile) & chr(34) & " " & _
"ComponentID=" & chr(34) & arrFiles(FILES_COMPONENTID, iFile) & chr(34) & " " & _
"ComponentName=" & chr(34) & arrFiles(FILES_COMPONENTNAME, iFile) & chr(34) & " " & _
"ComponentClients=" & chr(34) & arrFiles(FILES_COMPONENTCLIENTS, iFile) & chr(34) & " " & _
"FeatureReference=" & chr(34) & arrFiles(FILES_FEATURENAMES, iFile) & chr(34) & " " & _
" />"
If InStr(sXmlLine, "& ") > 0 Then sXmlLine = Replace(sXmlLine, "& ","&amp;")
FileStream.WriteLine sXmlLine
If arrMaster(iPosMaster, COL_ISOFFICEPRODUCT) Then AllOfficeFiles.WriteLine sXmlLine
Next 'iFile
FileStream.WriteLine vbTab & "</PRODUCT>"
If arrMaster(iPosMaster, COL_ISOFFICEPRODUCT) Then AllOfficeFiles.WriteLine vbTab & "</PRODUCT>"
FileStream.WriteLine "</FILEDATA>"
FileStream.Close
Set FileStream = Nothing
End If 'arrMaster(iPosMaster, COL_ISOFFICEPRODUCT)
Next 'iPosMaster
' close the AllOffice file
If Not AllOfficeFiles Is Nothing Then
AllOfficeFiles.WriteLine "</FILEDATA>"
AllOfficeFiles.Close
Set AllOfficeFiles = Nothing
End if
' compress the files
Dim i, iWait
Dim FileScanFolder, FileVerScanZip, xmlFile, item, zipfile
Dim sDat, sDatCln
Dim fCopyComplete
If oFso.FileExists(sPathOutputFolder & sComputerName & "_ROIScan.zip") Then
' rename existing .zip container by appending a timestamp to prevent overwrite.
Dim oRegExp
Set oRegExp = CreateObject("Vbscript.RegExp")
Set zipfile = oFso.GetFile(sPathOutputFolder & sComputerName & "_ROIScan.zip")
oRegExp.Global = True
oRegExp.Pattern = "\D"
Err.Clear
zipfile.Name = sComputerName & "_ROIScan_" & oRegExp.Replace(zipfile.DateLastModified, "") & ".zip"
If NOT Err = 0 Then
zipfile.Delete
Err.Clear
End If
End If
Set FileVerScanZip = oFso.OpenTextFile(sPathOutputFolder & sComputerName & "_ROIScan.zip", FOR_WRITING, True)
FileVerScanZip.write "PK" & chr(5) & chr(6) & String(18, chr(0))
FileVerScanZip.close
Set FileScanFolder = oFso.GetFolder(sPathOutputFolder & "ROIScan")
For Each xmlFile in FileScanFolder.Files
If Right(LCase(xmlFile.Name), 4) = ".xml" Then
If NOT fZipError Then CopyToZip ShellApp.NameSpace(sPathOutputFolder & sComputerName & "_ROIScan.zip"), xmlFile
End If
Next 'xmlFile
If fCScript AND NOT fQuiet Then wscript.echo vbTab & "File version scan complete"
End Sub 'FileInventory
'=======================================================================================================
'Identify the InstallState of a component
Function GetComponentState(sProductCode, sComponentId, iPosMaster)
On Error Resume Next
Dim Product
Dim sPath
GetComponentState = INSTALLSTATE_UNKNOWN
If iWiVersionMajor > 2 Then
'WI 3.x or higher
Set Product = oMsi.Product(sProductCode, arrMaster(iPosMaster, COL_USERSID), arrMaster(iPosMaster, COL_CONTEXT))
Err.Clear
GetComponentState = Product.ComponentState(sComponentId)
If Not Err = 0 Then
GetComponentState = INSTALLSTATE_UNKNOWN
Err.Clear
End If ' Err = 0
Else
'WI 2.x
If Not Err = 0 Then Err.Clear
sPath = ""
sPath = oMsi.ComponentPath(sProductCode, sComponentId)
If Not Err = 0 Then
GetComponentState = INSTALLSTATE_UNKNOWN
Err.Clear
Else
If oFso.FileExists(sPath) Then
GetComponentState = INSTALLSTATE_LOCAL
Else
GetComponentState = INSTALLSTATE_NOTUSED
End If 'oFso.FileExists(sPath)
End If 'Not Err = 0
End If 'iWiVersionMajor > 2
End Function 'GetComponentState
'=======================================================================================================
'Get a list of client products that are registered to the component
Function GetComponentClients(sComponentId, iComponentState)
On Error Resume Next
Dim sClients, prod
sClients = ""
GetComponentClients = ""
If Not(iComponentState = INSTALLSTATE_UNKNOWN) Then
For Each prod in oMsi.ComponentClients(sComponentId)
If Not Err = 0 Then
Err.Clear
Exit For
End If 'Not Err = 0
sClients = sClients & prod & ","
Next 'prod
RTrimComma sClients
GetComponentClients = sClients
End If 'Not (arrFiles(FILES_COMPONENTSTATE, ...
End Function 'GetComponentClients
'=======================================================================================================
'Get the keypath value for the component
Function GetComponentPath(sProductCode, sComponentId, iComponentState)
On Error Resume Next
Dim sPath
sPath = ""
If iComponentState = INSTALLSTATE_LOCAL Then
sPath = oMsi.ComponentPath(sProductCode, sComponentId)
End If 'iComponentState = INSTALLSTATE_LOCAL
GetComponentPath = sPath
End Function 'GetComponentPath
'=======================================================================================================
'Use WI ProvideAssembly function to identify the path for an assembly.
'Returns the path to the file if the file exists.
'Returns an empty string if file does not exist
Function GetAssemblyPath(sLfn, sKeyPath, sDir)
On Error Resume Next
Dim sFile, sFolder, sExt, sRoot, sName
Dim arrTmp
'Defaults
GetAssemblyPath= ""
sFile="" : sFolder= "" : sExt= "" : sRoot= "" : sName=""
'The componentpath should already point to the correct folder
'except for components with a registry keypath element.
'In that case tweak the directory folder to match
If Left(sKeyPath, 1) = "0" Then
sFolder = sDir
sFolder = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%") & Mid(sFolder, InStr(LCase(sFolder), "\winsxs\"))
sFile = sLfn
End If 'Left(sKeyPath, 1) = "0"
'Figure out the correct file reference
If sFolder = "" Then sFolder = Left(sKeyPath, InStrRev(sKeyPath, "\"))
sRoot = Left(sFolder, InStrRev(sFolder, "\", Len(sFolder) - 1))
arrTmp = Split(sFolder, "\")
If CheckArray(arrTmp) Then sName = arrTmp(UBound(arrTmp) - 1)
If sFile = "" Then sFile = Right(sKeyPath, Len(sKeyPath) -InStrRev(sKeyPath, "\"))
If oFso.FileExists(sFolder & sLfn) Then
sFile = sLfn
Else
'Handle .cat, .manifest and .policy files
If InStr(sLfn, ".") > 0 Then
sExt = Mid(sLfn, InStrRev(sLfn, "."))
Select Case LCase(sExt)
Case ".cat"
sFile = Left(sFile, InStrRev(sFile, ".")) & "cat"
If Not oFso.FileExists(sFolder & sFile) Then
'Check Manifest folder
If oFso.FileExists(sRoot & "Manifests\" & sName & ".cat") Then
sFolder = sRoot & "Manifests\"
sFile = sName & ".cat"
Else
If oFso.FileExists(sRoot & "Policies\" & sName & ".cat") Then
sFolder = sRoot & "Policies\"
sFile = sName & ".cat"
End If
End If
End If
Case ".manifest"
sFile = Left(sFile, InStrRev(sFile, ".")) & "manifest"
If oFso.FileExists(sRoot & "Manifests\" & sName & ".manifest") Then
sFolder = sRoot & "Manifests\"
sFile = sName & ".manifest"
End If
Case ".policy"
If iVersionNT < 600 Then
sFile = Left(sFile, InStrRev(sFile, ".")) & "policy"
If oFso.FileExists(sRoot & "Policies\" & sName & ".policy") Then
sFolder = sRoot & "Policies\"
sFile = sName & ".policy"
End If
Else
sFile = Left(sFile, InStrRev(sFile, ".")) & "manifest"
If oFso.FileExists(sRoot & "Manifests\" & sName & ".manifest") Then
sFolder = sRoot & "Manifests\"
sFile = sName & ".manifest"
End If
End If
Case Else
End Select
'Check if the file exists
If Not oFso.FileExists(sFolder & sFile) Then
'Ensure the right folder
End If
End If 'InStr(sFile, ".") > 0
End If
GetAssemblyPath = sFolder & sFile
End Function 'GetAssemblyPath
'=======================================================================================================
Function GetFileFullName(iComponentState, sComponentPath, sFileName)
On Error Resume Next
Dim sFileFullName
sFileFullName = ""
If iComponentState = INSTALLSTATE_LOCAL Then
If Len(sComponentPath) > 2 Then sFileFullName = sComponentPath & sFileName
End If 'iComponentState = INSTALLSTATE_LOCAL
GetFileFullName = sFileFullName
End Function 'GetFileFullName
'=======================================================================================================
Function GetLongFileName(sMsiFileName)
On Error Resume Next
Dim sFileTmp
sFileTmp = ""
sFileTmp = sMsiFileName
If InStr(sFileTmp, "|") > 0 Then sFileTmp = Mid(sFileTmp, InStr(sFileTmp, "|") + 1, Len(sFileTmp))
GetLongFileName = sFileTmp
End Function 'GetLongFileName
'=======================================================================================================
Function GetFileState(iComponentState, sFileFullName)
On Error Resume Next
GetFileState = INSTALLSTATE_UNKNOWN
If iComponentState = INSTALLSTATE_LOCAL Then
If oFso.FileExists(sFileFullName) Then
GetFileState = INSTALLSTATE_LOCAL
Else
GetFileState = INSTALLSTATE_BROKEN
End If 'oFso.FileExists(sFileFullName)
Else
If oFso.FileExists(sFileFullName) Then
'This should not happen!
GetFileState = INSTALLSTATE_LOCAL
Else
GetFileState = iComponentState
End If 'oFso.FileExists(sFileFullName)
End If 'iComponentState = INSTALLSTATE_LOCAL
End Function 'GetFileState
'=======================================================================================================
Function GetFileVersion(iComponentState, sFileFullName)
On Error Resume Next
GetFileVersion = ""
If iComponentState = INSTALLSTATE_LOCAL Then
If oFso.FileExists(sFileFullName) Then
GetFileVersion = oFso.GetFileVersion(sFileFullName)
End If 'oFso.FileExists(sFileFullName)
Else
If oFso.FileExists(sFileFullName) Then
'This should not happen!
GetFileVersion = oFso.GetFileVersion(sFileFullName)
End If 'oFso.FileExists(sFileFullName)
End If 'iComponentState = INSTALLSTATE_LOCAL
End Function 'GetFileVersion
'=======================================================================================================
'=======================================================================================================
'Module FeatureStates
'=======================================================================================================
'Builds a FeatureTree indicating the FeatureStates
Sub FindFeatureStates
If fBasicMode Then Exit Sub
On Error Resume Next
Const ADVARCHAR = 200
Const MAXCHARACTERS = 255
Dim Features, oRecordSet, oDicLevel, oDicParent
Dim sProductCode, sFeature, sFTree, sFParent, sLeft, sRight
Dim iFoo, iPosMaster, iMaxNestLevel, iNestLevel, iLevel, iFCnt, iLeft, iStart
Dim arrFName, arrFLevel, arrFParent
'ReDim the global feature array
ReDim arrFeature (UBound (arrMaster), FEATURE_COLUMNCOUNT)
'Outer loop to iterate through all products
For iPosMaster = 0 To UBound (arrFeature)
iFoo = 0
sFTree = ""
'Dummy Loop to allow exit out in case of an error
Do While iFoo = 0
iFoo = 1
'Get the ProductCode for this loop
sProductCode = arrMaster (iPosMaster, COL_PRODUCTCODE)
'Get the Features colection for this product
'oMsi.Features is only valid for installed per-machine or current user products.
'The call will fail for advertised and other user products.
Set Features = oMsi.Features (sProductCode)
If Not Err = 0 Then
Err.Clear
Exit Do
End If 'Not Err = 0
'Create the dictionary objects
Set oDicLevel = CreateObject ("Scripting.Dictionary")
Set oDicParent = CreateObject ("Scripting.Dictionary")
'Prepare a recordset to allow sorting of the root features
Set oRecordSet = CreateObject ("ADOR.Recordset")
oRecordSet.Fields.Append "FeatureName", ADVARCHAR, MAXCHARACTERS
oRecordSet.Open
If Not Err = 0 Then
Err.Clear
Exit Do
End If 'Not Err = 0
iMaxNestLevel = 0
'Inner loop # 1 to identify all features
For Each sFeature in Features
'Reset the nested level counter
iNestLevel = -1
'Check for & cache parent feature
sFParent = oMsi.FeatureParent (sProductCode, sFeature)
If sFParent = "" Then
'Found a root feature.
iNestLevel = 0
'Add to recordset for later sorting
oRecordSet.AddNew
oRecordSet("FeatureName") = TEXTINDENT & sFeature & " (" & TranslateFeatureState (oMsi.FeatureState (sProductCode, sFeature)) & ")"
oRecordSet.Update
Else
'Call the recursive function to get the nest level of the current feature
iNestLevel = GetFeatureNestLevel (sProductCode, sFeature, iNestLevel)
'Add to dictionary arrays
oDicLevel.Add sFeature, iNestLevel
oDicParent.Add sFeature, sFParent
End If 'sFParent= ""
'Max nest level is required for second inner loop
If iNestLevel > iMaxNestLevel Then iMaxNestLevel = iNestLevel
Next 'sFeature
'First inner loop complete. Sort the root features
oRecordSet.Sort = "FeatureName"
oRecordSet.MoveFirst
'Write the sorted root features to the 'treeview' string
Do Until oRecordSet.EOF
sFTree = sFTree & oRecordSet.Fields.Item ("FeatureName") & vbCrLf
oRecordSet.MoveNext
Loop 'oRecordSet.EOF
'Copy dic's to array
arrFName = oDicLevel.Keys
arrFLevel = oDicLevel.Items
arrFParent= oDicParent.Items
'2nd inner loop to add the features to the 'treeview' string
For iLevel = 1 To iMaxNestLevel
For iFCnt = 0 To UBound(arrFName)
If arrFLevel (iFCnt) = iLevel Then
iStart = InStr (sFTree, arrFParent (iFCnt) & " (") + Len (arrFParent (iFCnt))
iLeft = InStr (iStart, sFTree, ")") + 2
sLeft = Left (sFTree, iLeft)
sRight = Right (sFTree, Len (sFTree) - iLeft)
sFTree = sLeft & TEXTINDENT & FeatureIndent (iLevel) & arrFName (iFCnt) & " (" & TranslateFeatureState (oMsi.FeatureState (sProductCode, arrFName (iFCnt))) & ")" & vbCrLf & sRight
End If 'arrFLevel(iFCnt) =i
Next 'iFCnt
Next 'iLevel
'Reset objects for next cycle
Set oRecordSet = Nothing
Set oDicLevel = Nothing
Set oDicParent = Nothing
Loop 'iFoo= 0
arrFeature (iPosMaster, FEATURE_TREE) = vbCrLf & sFTree
Next 'iProdMaster
End Sub 'FindFeatureStates
'=======================================================================================================
'Translate the FeatureState value
Function TranslateFeatureState(iFState)
Select Case iFState
Case INSTALLSTATE_UNKNOWN : TranslateFeatureState="Unknown"
Case INSTALLSTATE_ADVERTISED : TranslateFeatureState="Advertised"
Case INSTALLSTATE_ABSENT : TranslateFeatureState="Absent"
Case INSTALLSTATE_LOCAL : TranslateFeatureState="Local"
Case INSTALLSTATE_SOURCE : TranslateFeatureState="Source"
Case INSTALLSTATE_DEFAULT : TranslateFeatureState="Default"
Case INSTALLSTATE_VIRTUALIZED : TranslateFeatureState="Virtualized"
Case INSTALLSTATE_BADCONFIG : TranslateFeatureState="BadConfig"
Case Else : TranslateFeatureState="Error"
End Select
End Function 'GetFeatureStateString
'=======================================================================================================
Function FeatureIndent(iNestLevel)
Dim iLevel
Dim sIndent
For iLevel = 1 To iNestLevel
sIndent = sIndent & vbTab
Next 'iLevel
FeatureIndent = sIndent
End Function 'FeatureIndent
'=======================================================================================================
Function GetFeatureNestLevel(sProductCode, sFeature, iNestLevel)
Dim sParent : sParent = ""
iNestLevel=iNestLevel+1
sParent=oMsi.FeatureParent(sProductCode, sFeature)
If Not sParent = "" Then iNestLevel=GetFeatureNestLevel(sProductCode, sParent, iNestLevel)
GetFeatureNestLevel = iNestLevel
End Function 'GetFeatureNestLevel
'=======================================================================================================
'=======================================================================================================
'Module Product InstallSource -
'=======================================================================================================
Sub ReadMsiInstallSources ()
If fBasicMode Then Exit Sub
On Error Resume Next
Dim oProduct, oSumInfo
Dim iProdCnt, iSourceCnt
Dim sSource
Dim MsiSources
ReDim arrIS(UBound(arrMaster), UBOUND_IS)
For iProdCnt = 0 To UBound(arrMaster)
arrIS(iProdCnt, IS_SOURCETYPESTRING) = "No Data Available"
arrIS(iProdCnt, IS_ORIGINALSOURCE) = "No Data Available"
'Add the ProductCode to the array
arrIS(iProdCnt, IS_PRODUCTCODE) = arrMaster(iProdCnt, COL_PRODUCTCODE)
If arrMaster(iProdCnt, COL_VIRTUALIZED) = 1 Then
' do nothing
Else
'SourceType
If oFso.FileExists(arrMaster(iProdCnt, COL_CACHEDMSI)) Then
Err.Clear
Set oSumInfo = oMsi.SummaryInformation(arrMaster(iProdCnt, COL_CACHEDMSI), MSIOPENDATABASEMODE_READONLY)
If Err = 0 Then
arrIS(iProdCnt, IS_SOURCETYPE) = oSumInfo.Property(PID_WORDCOUNT)
Select Case arrIS(iProdCnt, IS_SOURCETYPE)
Case 0 : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Original source using long file names"
Case 1 : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Original source using short file names"
Case 2 : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Compressed source files using long file names"
Case 3 : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Compressed source files using short file names"
Case 4 : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Administrative image using long file names"
Case 5 : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Administrative image using short file names"
Case Else : arrIS(iProdCnt, IS_SOURCETYPESTRING) = "Unknown InstallSource Type"
End Select
Else
'ERR_SICONNECTFAILED
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, "Product " & arrMaster(iProdCnt, COL_PRODUCTCODE) & DSV & _
arrMaster(iProdCnt, COL_PRODUCTNAME) & ": " & ERR_SICONNECTFAILED
arrMaster(iProdCnt, COL_ERROR) = arrMaster(iProdCnt, COL_ERROR) & ERR_CATEGORYERROR & ERR_SICONNECTFAILED & CSV
End If 'Err
End If
'Get the original InstallSource
arrIS(iProdCnt, IS_ORIGINALSOURCE) = oMsi.ProductInfo(arrMaster(iProdCnt, COL_PRODUCTCODE), "InstallSource")
If Not Len(arrIS(iProdCnt, IS_ORIGINALSOURCE)) > 0 Then arrIS(iProdCnt, IS_ORIGINALSOURCE) = "Not Registered"
'Get Network InstallSource(s)
'With WI 3.x and later the 'Product' object can be used to gather some data
If iWiVersionMajor > 2 Then
Err.Clear
Set oProduct = oMsi.Product(arrMaster(iProdCnt, COL_PRODUCTCODE), arrMaster(iProdCnt, COL_USERSID), arrMaster(iProdCnt, COL_CONTEXT))
If Err = 0 Then
'Get the last used source
arrIS(iProdCnt, IS_LASTUSEDSOURCE) = oProduct.SourceListInfo("LastUsedSource")
Set MsiSources = oProduct.Sources(1)
For Each sSource in MsiSources
If IsEmpty(arrIS(iProdCnt, IS_ADDITIONALSOURCES)) Then
arrIS(iProdCnt, IS_ADDITIONALSOURCES) =sSource 'MsiSources(iSourceCnt)
Else
arrIS(iProdCnt, IS_ADDITIONALSOURCES) =arrIS(iProdCnt, IS_ADDITIONALSOURCES) & " || " & sSource'MsiSources(iSourceCnt)
End If
Next 'MsiSources
End If 'Err
End If 'iWiVersionMajor
'Get the LIS resiliency source (if applicable)
If GetDeliveryResiliencySource(arrMaster(iProdCnt, COL_PRODUCTCODE), iProdCnt, sSource) Then arrIS(iProdCnt, IS_LISRESILIENCY) =sSource
End If 'Not Virtualized
Next 'iProdCnt
End Sub 'ReadMsiInstallSources
'=======================================================================================================
'Return True/False and the LIS source path as sSource
'Empty string for sProductCode forces to identify the DownloadCode from Setup.xml
Function GetDeliveryResiliencySource (sProductCode, iPosMaster, sSource)
On Error Resume Next
Dim arrSources, arrDownloadCodeKeys
Dim dicDownloadCode
Dim sSubKeyName, sValue, key, sku, sSkuName, sText, sDownloadCode, sTmpDownloadCode, source
Dim arrKeys, arrSku
Dim iVersionMajor, iSrc
Dim fFound
GetDeliveryResiliencySource = False
sSource = Empty
iVersionMajor = GetVersionMajor(sProductCode)
Set dicDownloadCode = CreateObject("Scripting.Dictionary")
If iVersionMajor > 11 Then
'Note: ProductCode doesn't work consistently for this logic
' To locate the Setup.xml requires additional logic so the tweak here is to use the
' original source location to identify the DownloadCode
sText = arrIS(iPosMaster, IS_ORIGINALSOURCE)
If InStr(source, "{") > 0 Then sDownloadCode = Mid(sText, InStr(sText, "{"), 40) Else sDownloadCode = sProductCode
dicDownloadCode.Add sDownloadCode, sProductCode
'Find the additional download locations
'Check if more than one sources are registered
If InStr(arrIS(iPosMaster, IS_ADDITIONALSOURCES), "||") > 0 Then
arrSources = Split(arrIS(iPosMaster, IS_ADDITIONALSOURCES), " || ")
For Each source in arrSources
If InStr(source, "{") > 0 Then
sTmpDownloadCode = Mid(source, InStr(source, "{"), 40)
If Not dicDownloadCode.Exists(sTmpDownloadCode) Then dicDownloadCode.Add sTmpDownloadCode, sProductCode
End If 'InStr
Next'
End If 'InStr
arrDownloadCodeKeys = dicDownloadCode.Keys
For iSrc = 0 To dicDownloadCode.Count- 1
sDownloadCode = UCase(arrDownloadCodeKeys(iSrc))
'Enum HKLM\SOFTWARE\Microsoft\Office\Delivery\SourceEngine\Downloads
sSubKeyName="SOFTWARE\Microsoft\Office\Delivery\SourceEngine\Downloads\"
If RegEnumKey(HKLM, sSubKeyName, arrKeys) Then
For Each key in arrKeys
fFound = False
If Len(key) > 37 Then
fFound = (UCase(Left(key, 38)) = sDownloadCode) OR (UCase(key) = sDownloadCode)
Else
fFound = (UCase(key) = sDownloadCode)
End If 'Len > 37
If fFound Then
'Found the Delivery reference
'Enum the 'Sources' subkey
sSubKeyName = sSubKeyName & key & "\Sources\"
If RegEnumKey(HKLM, sSubKeyName, arrSku) Then
For Each sku in arrSku
If RegReadStringValue(HKLM, sSubKeyName & sku, "Path", sValue) Then
sSkuName = ""
sSkuName = " (" & Left(sku, InStr(sku, "(") - 1) & ")"
If IsEmpty(sSource) Then
sSource = sValue & sSkuName
Else
sSource = sSource & " || " & sValue & sSkuName
End If 'IsEmpty
End If 'RegReadStringValue
Next 'sku
End If 'RegEnumKey
'GUID is unique no need to continue loop once we found a match
Exit For
End If
Next 'key
End If 'RegEnumKey
Next 'iSrc
ElseIf iVersionMajor = 11 Then
'Get the DownloadCode
sSubKeyName = "SOFTWARE\Microsoft\Office\11.0\Delivery\" & sProductCode & "\"
If RegReadStringValue(HKLM, sSubKeyName, "DownloadCode", sDownloadCode) Then
sSubKeyName = "SOFTWARE\Microsoft\Office\Delivery\SourceEngine\Downloads\" & sDownloadCode & "\Sources\" & Mid(sProductCode, 2, 36) & "\"
If RegReadStringValue(HKLM, sSubKeyName, "Path", sValue) Then sSource = sValue
End If
End If 'iVersionMajor
If Not IsEmpty(sSource) Then
GetDeliveryResiliencySource = True
WriteDebug sActiveSub, "Delivery resiliency source for " & sProductCode & " returned 'TRUE': " & sSource
Else
WriteDebug sActiveSub, "Delivery resiliency source for " & sProductCode & " returned 'FALSE'"
End If
End Function 'GetDeliveryResiliencySource
'=======================================================================================================
'=======================================================================================================
'Module Product Properties
'=======================================================================================================
'Gather additional properties for the product
Sub ProductProperties
Dim prod, MsiDb
Dim iPosMaster, iVersionMajor, iContext, iProd
Dim sProductCode, sSpLevel, sCachedMsi, sSid, sComp, sComp2, sPath, sRef, sProdId, n
Dim fVer, fCx
Dim arrCx, arrCxN, arrCxErr, arrKeys, arrTypes, arrNames
On Error Resume Next
If NOT fInitArrProdVer Then InitProdVerArrays
For iPosMaster = 0 to UBound (arrMaster)
' collect properties only for products in state '5' (Default)
If arrMaster(iPosMaster, COL_STATE) = INSTALLSTATE_DEFAULT OR arrMaster(iPosMaster, COL_STATE) = INSTALLSTATE_VIRTUALIZED Then
sProductCode = arrMaster(iPosMaster, COL_PRODUCTCODE)
sSid = arrMaster(iPosMaster, COL_USERSID)
iContext = arrMaster(iPosMaster, COL_CONTEXT)
' ProductID
sProdId = GetProductId(sProductCode, iPosMaster)
If NOT sProdId = "" Then arrMaster(iPosMaster, COL_PRODUCTID) = sProdId
' ProductVersion
arrMaster(iPosMaster, COL_PRODUCTVERSION) = GetProductVersion(sProductCode, iContext, sSid)
If NOT fBasicMode Then
' cached .msi package
Set MsiDb = Nothing
arrMaster(iPosMaster, COL_CACHEDMSI) = GetCachedMsi(sProductCode, iPosMaster)
If (NOT arrMaster(iPosMaster, COL_CACHEDMSI) = "") AND (arrMaster(iPosMaster, COL_VIRTUALIZED) = 0) Then
Set MsiDb = oMsi.OpenDatabase(arrMaster(iPosMaster, COL_CACHEDMSI), MSIOPENDATABASEMODE_READONLY)
arrMaster(iPosMaster, COL_PACKAGECODE) = GetPackageCode(sProductCode, iPosMaster, MsiDb)
arrMaster(iPosMaster, COL_UPGRADECODE) = GetUpgradeCode(MsiDb)
arrMaster(iPosMaster, COL_TRANSFORMS) = GetTransforms(sProductCode, iPosMaster)
' InstallDate
arrMaster(iPosMaster, COL_INSTALLDATE) = GetInstallDate(sProductCode, iContext, sSid, arrMaster(iPosMaster, COL_CACHEDMSI))
arrMaster(iPosMaster, COL_ORIGINALMSI) = GetOriginalMsiName(sProductCode, iPosMaster)
End If 'msi not empty
End If 'fBasicMode
If arrMaster(iPosMaster, COL_ISOFFICEPRODUCT) Then
' SP level
iVersionMajor = GetVersionMajor(sProductCode)
sSpLevel = OVersionToSpLevel(sProductCode, iVersionMajor, arrMaster(iPosMaster, COL_PRODUCTVERSION))
arrMaster(iPosMaster, COL_SPLEVEL) = sSpLevel
' Build/Origin
If NOT fBasicMode Then arrMaster(iPosMaster, COL_ORIGIN) = CheckOrigin(MsiDb)
' Architecture (Bitness)
If Left(arrMaster(iPosMaster, COL_PRODUCTVERSION), 2)>11 Then
If Mid(sProductCode, 21, 1) = "1" Then arrMaster(iPosMaster, COL_ARCHITECTURE) = "x64" Else arrMaster(iPosMaster, COL_ARCHITECTURE) = "x86"
End If
' Key ComponentStates
arrMaster(iPosMaster, COL_KEYCOMPONENTS) = GetKeyComponentStates(sProductCode, False)
If NOT fBasicMode Then
' Cx
fVer = False : fCx = False
Select Case iVersionMajor
Case 11
sComp = "{1EBDE4BC-9A51-4630-B541-2561FA45CCC5}"
sRef = "11.0.8320.0"
Case 12
sComp = "{0638C49D-BB8B-4CD1-B191-051E8F325736}"
sRef = "12.0.6514.5001"
If Mid(sProductCode, 11, 4) = "0020" Then fVer = True
Case 14
If Mid(sProductCode, 21, 1) = "1" Then
sComp = "{C0AC079D-A84B-4CBD-8DBA-F1BB44146899}"
sComp2= "{E6AC97ED-6651-4C00-A8FE-790DB0485859}"
Else
sComp = "{019C826E-445A-4649-A5B0-0BF08FCC4EEE}"
sComp2= "{398E906A-826B-48DD-9791-549C649CACE5}"
End If
sRef = "14.0.5123.5004"
Case Else
sComp = "" : sComp2 = "" : sRef = ""
End Select
' obtain product handle
Err.Clear
If oMsi.Product(sProductCode, sSid, iContext).ComponentState(sComp) = INSTALLSTATE_LOCAL Then
If Err = 0 Then
fCx = True
sPath = oMsi.ComponentPath(sProductCode, sComp)
If oFso.FileExists(sPath) Then
fVer = (CompareVersion(oFso.GetFileVersion(sPath), sRef, True) > -1)
End If
If iVersionMajor = 14 Then
If oMsi.Product(sProductCode, sSid, iContext).ComponentState(sComp2) = INSTALLSTATE_LOCAL Then
sPath = oMsi.ComponentPath(sProductCode, sComp2)
If oFso.FileExists(sPath) Then
fVer = (CompareVersion(oFso.GetFileVersion(sPath), sRef, True) > -1)
End If
End If 'INSTALLSTATE_LOCAL
Err.Clear
End If
Else
Err.Clear
End If 'Err = 0
End If 'INSTALLSTATE_LOCAL
If fVer Then
arrCxN = Array("44","43","58","46")
Select Case iVersionMajor
Case 11
arrCx = Array("53","4F","46","54","57","41","52","45","5C","4D","69","63","72","6F","73","6F","66","74","5C","4F","66","66","69","63","65","5C","31","31","2E","30","5C","57","6F","72","64")
arrCxErr = Array("43","75","73","74","6F","6D","20","58","4D","4C","20","66","65","61","74","75","72","65","20","64","69","73","61","62","6C","65","64","20","62","79","20","4B","42","20","39","37","39","30","34","35")
If RegEnumValues(HKLM, hAtS(arrCx), arrNames, arrTypes) Then
For Each n in arrNames
If UCase(n) = hAtS(arrCxN) Then arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & hAtS(arrCxErr) & CSV
Next 'n
End If
Case 12
arrCx = Array("53","4F","46","54","57","41","52","45","5C","4D","69","63","72","6F","73","6F","66","74","5C","4F","66","66","69","63","65","5C","31","32","2E","30","5C","57","6F","72","64")
arrCxErr = Array("57","6F","72","64","20","43","75","73","74","6F","6D","20","58","4D","4C","20","66","65","61","74","75","72","65","20","64","69","73","61","62","6C","65","64","20","62","79","20","4B","42","20","39","37","34","36","33","31")
If Mid(sProductCode, 11, 4) = "0020" Then
If CompareVersion(sRef, GetMsiProductVersion(arrMaster(iPosMaster, COL_CACHEDMSI)), False) < 1 Then
arrCxErr = Array("57","6F","72","64","20","43","75","73","74","6F","6D","20","58","4D","4C","20","66","65","61","74","75","72","65","20","64","69","73","61","62","6C","65","64","20","62","79","20","43","6F","6D","70","61","74","69","62","69","6C","69","74","79","20","50","61","63","6B")
End If
End If '"0020"
If RegEnumValues(HKLM, hAtS(arrCx), arrNames, arrTypes) Then
For Each n in arrNames
If UCase(n) = hAtS(arrCxN) Then arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & hAtS(arrCxErr) & CSV
Next 'n
End If
Case 14
arrCxErr = Array("43","75","73","74","6F","6D","20","58","4D","4C","20","66","65","61","74","75","72","65","20","65","6E","61","62","6C","65","64","20","62","79","20","57","6F","72","64","20","32","30","31","30","20","4B","42","20","32","34","32","38","36","37","20","61","64","64","2D","69","6E")
For Each prod in arrMaster
If Mid(prod, 11, 4) = "0126" Then arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & hAtS(arrCxErr) & CSV
Next 'prod
Case Else
End Select
Else
If (iVersionMajor = 14) AND fCx Then
arrCxErr = Array("43","75","73","74","6F","6D","20","58","4D","4C","20","66","65","61","74","75","72","65","20","66","6F","72","20","74","68","65","20","62","69","6E","61","72","79","20","2E","64","6F","63","20","66","6F","72","6D","61","74","20","72","65","71","75","69","72","65","73","20","4B","42","20","32","34","31","33","36","35","39")
arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & hAtS(arrCxErr) & CSV
End If '14
End If 'fVer
End If 'fBasicMode
Else
arrMaster(iPosMaster, COL_ORIGIN) = "n/a"
' checks for known add-ins
' POWERPIVOT_2010
If InStr(POWERPIVOT_2010, arrMaster(iPosMaster, COL_UPGRADECODE)) > 0 Then
If CompareVersion(arrMaster(iPosMaster, COL_PRODUCTVERSION), "10.50.1747.0", True) < 1 Then
arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & ERR_CATEGORYWARN & "This is a preview version. Please obtain version 10.50.1747.0 or higher." & CSV
End If
End If 'POWERPIVOT_2010
End If 'IsOfficeProduct
End If 'INSTALLSTATE_DEFAULT
Next 'iPosMaster
End Sub 'ProductProperties
'=======================================================================================================
'The name of the original installation package 'PackageName' is obtained from HKCR.
Function GetOriginalMsiName(sProductCode, iPosMaster)
Dim iPos
Dim sCompGuid, sRegName
Dim fVirtual
On Error Resume Next
fVirtual = (arrMaster(iPosMaster, COL_VIRTUALIZED) = 1)
sRegName = ""
If NOT fVirtual Then sRegName = oMsi.ProductInfo(sProductCode, "PackageName")
'Error Handler
If (Not Err = 0) OR sRegName = "" Then
'This can happen if WI < 3.x or product is installed for other user
Err.Clear
iPos = GetArrayPosition(arrMaster, sProductCode)
sCompGuid = GetCompressedGuid(sProductCode)
sRegName = GetRegOriginalMsiName(sCompGuid, arrMaster(iPos, COL_CONTEXT), arrMaster(iPos, COL_USERSID))
If sRegName = "-" AND NOT fVirtual Then arrMaster(iPos, COL_ERROR) = arrMaster(iPos, COL_ERROR) & ERR_CATEGORYERROR & ERR_BADMSINAMEMETADATA & CSV
End If
GetOriginalMsiName = sRegName
End Function
'=======================================================================================================
'The 'Transforms' property is obtained from HKCR.
Function GetTransforms(sProductCode, iPosMaster)
Dim sTransforms, sCompGuid, sRegTransforms
Dim iPos
On Error Resume Next
GetTransforms = "-" : sTransforms = ""
If arrMaster(iPosMaster, COL_VIRTUALIZED) = 0 Then sTransforms = oMsi.ProductInfo(sProductCode, "Transforms")
'Error Handler
If NOT Err = 0 OR arrMaster(iPosMaster, COL_VIRTUALIZED) = 1 Then
Err.Clear
iPos = GetArrayPosition(arrMaster, sProductCode)
sCompGuid = GetCompressedGuid(sProductCode)
sTransforms = GetRegTransforms(sCompGuid, arrMaster(iPos, COL_CONTEXT), arrMaster(iPos, COL_USERSID))
End If
If Len(sTransforms) > 0 Then GetTransforms = sTransforms
End Function
'=======================================================================================================
'InstallDate is available as part of the ProductInfo.
Function GetInstallDate(sProductCode, iContext, sSid, sCachedMsi)
Dim iPos
Dim hDefKey
Dim sSubKeyName, sName, sValue, sDateLocalized, sDateNormalized, sYY, sMM, sDD
On Error Resume Next
GetInstallDate = ""
hDefKey = HKEY_LOCAL_MACHINE
sSubKeyName = GetRegConfigKey(sProductCode, iContext, sSid, True) & "InstallProperties"
sName = "InstallDate"
GetInstallDate = "-"
If RegReadValue(hDefKey, sSubKeyName, sName, sValue, "REG_EXPAND_SZ") Then GetInstallDate = sValue
'The InstallDate is reset with every patch transaction
'As a workaround the CreateDate of the cached .msi package will be used to obtain the correct date
If oFso.FileExists(sCachedMsi) Then
'GetInstallDate = oFso.GetFile(sCachedMsi).DateCreated
sDateLocalized = oFso.GetFile(sCachedMsi).DateCreated
sYY = Year(sDateLocalized)
sMM = Right("0" & Month(sDateLocalized), 2)
sDD = Right("0" & Day(sDateLocalized), 2)
sDateNormalized = sYY & " " & sMM & " " & sDD & " (yyyy mm dd)"
GetInstallDate = sDateNormalized
End If
End Function 'GetInstallDate
'=======================================================================================================
'The package code associates a .msi file with an application or product
Function GetPackageCode(sProductCode, iPosMaster, MsiDb)
Dim sValidate, sCompGuid, sPackageCode
Dim oSumInfo
On Error Resume Next
sPackageCode = ""
If arrMaster(iPosMaster, COL_VIRTUALIZED) = 0 Then sPackageCode = oMsi.ProductInfo(sProductCode, "PackageCode")
If (Not Err = 0) OR (sPackageCode="") Then
' Error Handler
sCompGuid = GetCompressedGuid(sProductCode)
sPackageCode = GetRegPackageCode(sCompGuid, arrMaster(iPosMaster, COL_CONTEXT), arrMaster(iPosMaster, COL_USERSID))
Exit Function
End If
If Not sPackageCode = "n/a" Then
If Not IsValidGuid(sPackageCode, GUID_UNCOMPRESSED) Then
If fGuidCaseWarningOnly Then
arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & ERR_CATEGORYNOTE & ERR_GUIDCASE & DOT & sErrBpa & CSV
Else
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, "Product " & sProductCode & DSV & arrMaster(iPosMaster, COL_PRODUCTNAME) & _
": " & sError & " for PackageCode '" & sPackageCode & "'" & DOT & sErrBpa
sError = "" : sErrBpa = ""
arrMaster(iPosMaster, COL_ERROR) = arrMaster(iPosMaster, COL_ERROR) & ERR_CATEGORYERROR & sError & DOT & sErrBpa & CSV
End If 'fGuidCaseWarningOnly
End If
End If
' Scan cached .msi
If Not arrMaster(iPosMaster, COL_CACHEDMSI) = "" Then
Set oSumInfo = MsiDb.SummaryInformation(MSIOPENDATABASEMODE_READONLY)
If Not (Err = 0) Then
arrMaster(iPosMaster, COL_NOTES) = arrMaster(iPosMaster, COL_NOTES) & ERR_CATEGORYWARN & ERR_INITSUMINFO & CSV
Exit Function
End If 'Not Err
If Not sPackageCode = oSumInfo.Property(PID_REVNUMBER) Then
arrMaster(iPosMaster, COL_ERROR) = arrMaster(iPosMaster, COL_ERROR) & ERR_CATEGORYERROR & ERR_PACKAGECODEMISMATCH & CSV
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, "Product " & sProductCode & DSV & arrMaster(iPosMaster, COL_PRODUCTNAME) & _
": " & ERR_PACKAGECODEMISMATCH & DOT & BPA_PACKAGECODEMISMATCH
End If
End If 'arrMaster
GetPackageCode = sPackageCode
End Function 'GetPackageCode
'=======================================================================================================
Function GetUpgradeCode (MsiDb)
Dim Record
Dim qView
On Error Resume Next
GetUpgradeCode = ""
If MsiDb Is Nothing Then Exit Function
Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property`='UpgradeCode'")
qView.Execute()
Set Record = qView.Fetch()
If NOT Err = 0 Then Exit Function
GetUpgradeCode = Record.StringData(1)
End Function 'GetPackageCode
'=======================================================================================================
'Read the Build / Origin property from the cached .msi
Function CheckOrigin(MsiDb)
Dim sQuery, sCachedMsi
Dim Record
Dim qView
On Error Resume Next
CheckOrigin = ""
If MsiDb Is Nothing Then Exit Function
' read the 'Build' entry first
sQuery = "SELECT `Value` FROM Property WHERE `Property` = 'BUILD'"
Set qView = MsiDb.OpenView(sQuery)
qView.Execute
Set Record = qView.Fetch()
If Not Record Is Nothing Then
CheckOrigin = Record.StringData(1)
End If 'Is Nothing
sQuery = "SELECT `Value` FROM Property WHERE `Property` = 'ORIGIN'"
Set qView = MsiDb.OpenView(sQuery)
qView.Execute
Set Record = qView.Fetch()
If Not Record Is Nothing Then
CheckOrigin = CheckOrigin & " / " & Record.StringData(1)
End If 'Is Nothing
End Function
'=======================================================================================================
Function GetCachedMsi(sProductCode, iPosMaster)
Dim sCachedMsi
Dim oApp
Dim fVirtual
On Error Resume Next
fVirtual = (arrMaster(iPosMaster, COL_VIRTUALIZED) = 1)
sCachedMsi = ""
If NOT fVirtual Then
If iWiVersionMajor > 2 Then
Set oApp = oMsi.Product(sProductCode, arrMaster(iPosMaster, COL_USERSID), arrMaster(iPosMaster, COL_CONTEXT))
sCachedMsi = oApp.InstallProperty("LocalPackage")
ElseIf (arrMaster(iPosMaster, COL_USERSID) = sCurUserSid) Or (arrMaster(iPosMaster, COL_CONTEXT) = MSIINSTALLCONTEXT_MACHINE) Then
sCachedMsi = oMsi.ProductInfo(sProductCode, "LocalPackage")
Else
' rely on error handling to retain the value from direct registry read
End If 'iWiVersionMajor
End If 'fVirtual
If Not Err = 0 Then
sCachedMsi= ""
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, "Product " & sProductCode & DSV & arrMaster(iPosMaster, COL_PRODUCTNAME) & _
": " & ERR_PACKAGEAPIFAILURE & "."
End If
If sCachedMsi= "" Then
sCachedMsi = GetRegCachedMsi(GetCompressedGuid(sProductCode), iPosMaster)
End If 'sCachedMsi= ""
If sCachedMsi= "" Then
If NOT fVirtual Then arrMaster(iPosMaster, COL_ERROR) = arrMaster(iPosMaster, COL_ERROR) & ERR_CATEGORYERROR & ERR_BADPACKAGEMETADATA & CSV
Else
If Not oFso.FileExists (sCachedMsi) Then
Cachelog LOGPOS_REVITEM, LOGHEADING_NONE, ERR_CATEGORYERROR, "Product " & sProductCode & " - " &_
arrMaster(iPosMaster, COL_PRODUCTNAME) & ": " & ERR_LOCALPACKAGEMISSING & ": " & sCachedMsi
arrMaster(iPosMaster, COL_ERROR) = arrMaster(iPosMaster, COL_ERROR) & ERR_CATEGORYERROR & ERR_LOCALPACKAGEMISSING & CSV
sCachedMsi = ""
End If 'oFso.FileExists
End If
GetCachedMsi = sCachedMsi
End Function 'GetCachedMsi
'=======================================================================================================
Function GetRegCachedMsi (sProductCodeCompressed, iPosMaster)
Dim hDefKey
Dim sSubKeyName, sValue, sSid, sName
Dim iContext
On Error Resume Next
GetRegCachedMsi = ""
'Go global
hDefKey = HKLM
iContext = arrMaster(iPosMaster, COL_CONTEXT)
sSid = arrMaster(iPosMaster, COL_USERSID)
sName = "LocalPackage"
If iContext = MSIINSTALLCONTEXT_USERMANAGED Then
iContext = MSIINSTALLCONTEXT_USERUNMANAGED
sName = "ManagedLocalPackage"
End If
sSubKeyName = GetRegConfigKey(sProductCodeCompressed, iContext, sSid, True) & "InstallProperties\"
If RegReadStringValue(hDefKey, sSubKeyName, sName, sValue) Then GetRegCachedMsi = sValue
End Function
'=======================================================================================================
Function GetProductId(sProductCode, iPosMaster)
Dim sProductId
Dim oApp
On Error Resume Next
GetProductId = ""
If arrMaster(iPosMaster, COL_CONTEXT) = MSIINSTALLCONTEXT_C2RV2 Then
sProductId = GetRegProductId(GetCompressedGuid(sProductCode), iPosMaster)
Exit Function
End If
If arrMaster(iPosMaster, COL_CONTEXT) = MSIINSTALLCONTEXT_C2RV3 Then
sProductId = GetRegProductId(GetCompressedGuid(sProductCode), iPosMaster)
Exit Function
End If
If iWiVersionMajor > 2 Then
Set oApp = oMsi.Product(sProductCode, arrMaster(iPosMaster, COL_USERSID), arrMaster(iPosMaster, COL_CONTEXT))
sProductId = oApp.InstallProperty("ProductID")
ElseIf (arrMaster(iPosMaster, COL_USERSID) = sCurUserSid) Or (arrMaster(iPosMaster, COL_CONTEXT) = MSIINSTALLCONTEXT_MACHINE) Then
sProductId = oMsi.ProductInfo(sProductCode, "ProductID")
Else
'Rely on error handling to retain the value from direct registry read
End If 'iWiVersionMajor
If Not Err = 0 Then
sProductId= ""
End If
If sProductId= "" Then
sProductId = GetRegProductId(GetCompressedGuid(sProductCode), iPosMaster)
End If 'sCachedMsi= ""
GetProductId = sProductId
End Function 'GetProductId
'=======================================================================================================
Function GetRegProductId (sProductCodeCompressed, iPosMaster)
Dim hDefKey
Dim sSubKeyName, sValue, sSid, sName
Dim iContext
On Error Resume Next
GetRegProductId = ""
'Go global
hDefKey = HKLM
iContext = arrMaster(iPosMaster, COL_CONTEXT)
sSid = arrMaster(iPosMaster, COL_USERSID)
sName = "ProductID"
'Tweak managed to unmanaged to avoid link to managed global key
If iContext = MSIINSTALLCONTEXT_USERMANAGED Then
iContext = MSIINSTALLCONTEXT_USERUNMANAGED
sName = "ProductID"
End If
sSubKeyName = GetRegConfigKey(sProductCodeCompressed, iContext, sSid, True) & "InstallProperties\"
If RegReadStringValue(hDefKey, sSubKeyName, sName, sValue) Then GetRegProductId = sValue
End Function 'GetRegProductId
'=======================================================================================================
'Get the ProductVersion string from WI ProductInfo
Function GetProductVersion (sProductCode, iContext, sSid)
Dim sTmp
On Error Resume Next
If iContext = MSIINSTALLCONTEXT_C2RV2 Then
GetProductVersion = GetRegProductVersion(sProductCode, iContext, sSid)
Exit Function
End If
If iContext = MSIINSTALLCONTEXT_C2RV3 Then
GetProductVersion = GetRegProductVersion(sProductCode, iContext, sSid)
Exit Function
End If
sTmp = ""
sTmp = oMsi.ProductInfo (sProductCode, "VersionString")
If (sTmp = "") OR (NOT Err = 0) Then
Err.Clear
sTmp = GetRegProductVersion(sProductCode, iContext, sSid)
End If
GetProductVersion = sTmp
End Function
'=======================================================================================================
'Get the ProductVersion from Registry
Function GetRegProductVersion (sProductCode, iContext, sSid)
Dim hDefKey
Dim sSubKeyName, sValue
Dim iTmpContext
On Error Resume Next
GetRegProductVersion = "Error"
hDefKey = HKEY_LOCAL_MACHINE
If iContext = MSIINSTALLCONTEXT_USERMANAGED Then
iTmpContext = MSIINSTALLCONTEXT_USERUNMANAGED
Else
iTmpContext = iContext
End If 'iContext = MSIINSTALLCONTEXT_USERMANAGED
sSubKeyName = GetRegConfigKey(GetCompressedGuid(sProductCode), iTmpContext, sSid, True) & "InstallProperties\"
If RegReadStringValue(hDefKey, sSubKeyName, "DisplayVersion", sValue) Then GetRegProductVersion = sValue
End Function
'=======================================================================================================
'Translate the Office ProductVersion to the service pack level
Function OVersionToSpLevel (sProductCode, iVersionMajor, sProductVersion)
On Error Resume Next
'SKU identifier constants for SP level detection
Const O16_EXCEPTION = ""
Const O15_EXCEPTION = ""
Const O14_EXCEPTION = "007A, 007B, 007C, 007D, 007F, 2005"
' O12_Server = "1014, 1015, 104B, 104E, 1080, 1088, 10D7, 10D8, 10EB, 10F5, 10F6, 10F7, 10F8, 10FB, 10FC, 10FD, 1103, 1104, 110D, 1105, 1110, 1121, 1122" '#Devonly
Const O12_EXCEPTION = "001C, 001F, 0020, 003F, 0045, 00A4, 00A7, 00B0, 00B1, 00B2, 00B9, 011F, CFDA"
Const O11_EXCEPTION = "14, 15, 16, 17, 18, 19, 1A, 1B, 1C, 24, 32, 3A, 3B, 44, 51, 52, 53, 5E, A1, A4, A9, E0"
Const O10_EXCEPTION = "17, 1D, 25, 27, 30, 36, 3A, 3B, 51, 52, 53, 54"
Const O09_EXCEPTION = "3A, 3B, 3C, 5F"
Dim iSpCnt, iExptnCnt, iLevel, iRetry
Dim sSpLevel, sSku
iLevel = 0 : iRetry = 0
Select Case iVersionMajor
Case 9
'Sku ProductID is 2 digits starting at pos 4
sSku = Mid (sProductCode, 4, 2)
If InStr (O09_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 1 To UBound (arrProdVer09, 1)
If InStr (arrProdVer10 (iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
Else
iExptnCnt = 0
End If 'InStr(O09_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound (arrProdVer09, 2)
If sProductVersion = Left (arrProdVer09 (iExptnCnt, iSpCnt), Len (sProductVersion)) Then
'Special release references are noted within same field with a "," separator
If InStr (arrProdVer09 (iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid (arrProdVer09 (iExptnCnt, iSpCnt), InStr (arrProdVer09 (iExptnCnt, iSpCnt), ",") + 1, Len (arrProdVer09 (iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case 10
'Sku ProductID is 2 digits starting at pos 4
sSku = Mid(sProductCode, 4, 2)
If InStr(O10_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 1 To UBound(arrProdVer10, 1)
If InStr(arrProdVer10(iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
Else
iExptnCnt = 0
End If 'InStr(O10_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound(arrProdVer10, 2)
If sProductVersion = Left(arrProdVer10(iExptnCnt, iSpCnt), Len(sProductVersion)) Then
'Special release references are noted within same field with a "," separator
If InStr(arrProdVer10(iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid(arrProdVer10(iExptnCnt, iSpCnt), InStr(arrProdVer10(iExptnCnt, iSpCnt), ",") + 1, Len(arrProdVer10(iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
Exit For
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case 11
'Sku ProductID is 2 digits starting at pos 4
sSku = Mid(sProductCode, 4, 2)
If InStr(O11_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 1 To UBound(arrProdVer11, 1)
If InStr(arrProdVer11(iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
Else
iExptnCnt = 0
End If 'InStr(O11_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound(arrProdVer11, 2)
If sProductVersion = Left(arrProdVer11(iExptnCnt, iSpCnt), Len(sProductVersion)) Then
'Special release references are noted within same field with a "," separator
If InStr(arrProdVer11(iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid(arrProdVer11(iExptnCnt, iSpCnt), InStr(arrProdVer11(iExptnCnt, iSpCnt), ",") + 1, Len(arrProdVer11(iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
Exit For
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case 12
'Sku ProductID is 4 digits starting at pos 11
sSku = Mid(sProductCode, 11, 4)
If InStr(O12_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 2 To UBound(arrProdVer12, 1)
If InStr(arrProdVer12(iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
ElseIf Left(sSku, 1) = "1" Then 'Server SKU
iExptnCnt = 1
Else
iExptnCnt = 0
End If 'InStr(O12_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound(arrProdVer12, 2)
If Left(sProductVersion, 10) = Left(arrProdVer12(iExptnCnt, iSpCnt), 10) Then
'Special release references are noted within same field with a "," separator
If InStr(arrProdVer12(iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid(arrProdVer12(iExptnCnt, iSpCnt), InStr(arrProdVer12(iExptnCnt, iSpCnt), ",") + 1, Len(arrProdVer12(iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
Exit For
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case 14
'Sku ProductID is 4 digits starting at pos 11
sSku = Mid(sProductCode, 11, 4)
If InStr(O14_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 1 To UBound(arrProdVer14, 1)
If InStr(arrProdVer14(iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
Else
iExptnCnt = 0
End If 'InStr(O14_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound(arrProdVer14, 2)
If Left(sProductVersion, 10) = Left(arrProdVer14(iExptnCnt, iSpCnt), 10) Then
'Special release references are noted within same field with a "," separator
If InStr(arrProdVer14(iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid(arrProdVer14(iExptnCnt, iSpCnt), InStr(arrProdVer14(iExptnCnt, iSpCnt), ",") + 1, Len(arrProdVer14(iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
Exit For
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case 15
'Sku ProductID is 4 digits starting at pos 11
sSku = Mid(sProductCode, 11, 4)
If InStr(O15_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 1 To UBound(arrProdVer15, 1)
If InStr(arrProdVer15(iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
Else
iExptnCnt = 0
End If 'InStr(O15_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound(arrProdVer15, 2)
If Left(sProductVersion, 10) = Left(arrProdVer15(iExptnCnt, iSpCnt), 10) Then
'Special release references are noted within same field with a "," separator
If InStr(arrProdVer15(iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid(arrProdVer15(iExptnCnt, iSpCnt), InStr(arrProdVer15(iExptnCnt, iSpCnt), ",") + 1, Len(arrProdVer15(iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
Exit For
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case 16
'Sku ProductID is 4 digits starting at pos 11
sSku = Mid(sProductCode, 11, 4)
If InStr(O16_EXCEPTION, sSku) > 0 Then
For iExptnCnt = 1 To UBound(arrProdVer16, 1)
If InStr(arrProdVer16(iExptnCnt, 0), sSku) > 0 Then Exit For
Next 'iExptnCnt
Else
iExptnCnt = 0
End If 'InStr(O16_Exception, sSku) > 0
For iRetry = 0 To 1
For iSpCnt = 1 To UBound(arrProdVer16, 2)
If Left(sProductVersion, 10) = Left(arrProdVer16(iExptnCnt, iSpCnt), 10) Then
'Special release references are noted within same field with a "," separator
If InStr(arrProdVer16(iExptnCnt, iSpCnt), ",") > 0 Then
OVersionToSpLevel = Mid(arrProdVer16(iExptnCnt, iSpCnt), InStr(arrProdVer16(iExptnCnt, iSpCnt), ",") + 1, Len(arrProdVer16(iExptnCnt, iSpCnt)))
Exit Function
Else
iLevel = iSpCnt
Exit For
End If
End If
Next 'iSpCnt
If iLevel > 0 Then Exit For
'Did not find the SP level yet. Retry with core build numbers
iExptnCnt = 0
Next 'iRetry
Case Else
End Select
Select Case iLevel
Case 1 : sSpLevel = "RTM"
Case 2 : sSpLevel = "SP1"
Case 3 : sSpLevel = "SP2"
Case 4 : sSpLevel = "SP3"
Case Else : sSpLevel = ""
End Select
OVersionToSpLevel = sSpLevel
End Function 'OVersionToSpLevel
'=======================================================================================================
'Initialize arrays for translation ProductVersion -> ServicePackLevel
Sub InitProdVerArrays
On Error Resume Next
' O16 Products -> KB ?
ReDim arrProdVer16(0, 0) 'n, 1=RTM
arrProdVer16(0, 0) = ""
' 2013 Products -> KB 2786054
ReDim arrProdVer15(0, 44) 'n, 1=RTM
arrProdVer15(0, 0) = "" : arrProdVer15(0, 1) = "15.0.4420.1017" : arrProdVer15(0, 2) = "15.0.4569.1507"
arrProdVer15(0, 3) = "15.0.4454.1004, 2013/01" : arrProdVer15(0, 4) = "15.0.4454.1511, 2013/02"
arrProdVer15(0, 5) = "15.0.4481.1005, 2013/03" : arrProdVer15(0, 6) = "