Для решения потребуется север SharePoint той же версии, где обновления устанавливаются.
Скопируйте папку c:\windows\installer с другого работающего сервера SharePoint в локальную c:\temp\ папку на ваш плохой сервер.
Создаем файл OpUtil.vbs следующего содержания:
'=======================================================================================================
' Name: OPUtil.vbs - Office Patch Utility
' Author: Microsoft Customer Support Services
' Copyright (c) 2009, Microsoft Corporation
'
' Utility for Office patch maintenance tasks "log, repair, apply, remove, clean"
' Formerly published as MspFixUp.vbs
'
'=======================================================================================================
'=======================================================================================================
'[INI] Section for script behavior customizations
'Quiet switch.
'Default: False -> A summary log opens automatically when done
Dim bQuiet
bQuiet = False
'Set fDetectOnly to 'True' if only a log should be generated
'None of the detected actions required will be executed!
'Default: False -> execute detected actions required
Dim fDetectOnly
fDetectOnly = False
'Optional location to provide .msp patch files that should be applied
'A list of full path references to folders with .msp files, separated by semicolons
'Default: sUpdateLocation = ""
Dim sUpdateLocation
sUpdateLocation = ""
'Optional location to restore .msi & .msp packages that have gone missing
'A list of fully qualified paths to folders with .msi and/or .msp files, separated by semicolons
'Default: sUpdateLocation = ""
Dim sRestoreLocation
sRestoreLocation = ""
'Option to explicitly exclude the Windows Installer cache when searching for applicable .msp files.
'This allows to enforce patches are only applied from the provided SUpdateLocation folders
'Note: For detection integrity it's still required to include the patches in the sequence logic!
'Default: fExcludeCache = False -> Scans %WinDir%\Installer folder for applicable patches
Dim fExcludeCache
fExcludeCache = False
'Option to include OCT patches from the Windows Installer cache.
'This option is a subset of the above 'fExcludeCache' option
'it allows to include that cached (installed) OCT patches get applied
'NOTE: It's recommended to keep this set to 'False' unless you have a specific requirement to enforce this
'Default: fIncludeOctCache = False -> Filters OCT patches from %WinDir%\Installer folder
Dim fIncludeOctCache
fIncludeOctCache = False
'Check the integrity of the local Windows Installer cache and try to repair missing .msi and .msp files if needed
'Default: fRepairCache = True -> Try to repair missing files
Dim fRepairCache
fRepairCache = True
'Unregister patches that have gone missing from the local Windows Installer cache to unblock maintenance transactions
'Default: fReconcileCache = False -> Don't unregister missing patches
Dim fReconcileCache
fReconcileCache = False
'Apply .msp patch files
'Patch files are applied from the optional SUpdateLocation folders and the local Windows Installer cache.
'Note: To fine tune the behavior see the options for SUpdateLocation, fExcludeCache, fIncludeOctCache
'Default: fApplyPatch = True -> Apply patches
Dim fApplyPatch
fApplyPatch = True
'Remove installed patches
'Allows to uninstall superseded patches or a specified list.
'The list allows passing in a KB number(s) or PatchCode(s)
'Default: fRemovePatch = False -> Do not attempt to uninstall patches
' sMspRemoveFilter = "Superseded" -> If enabled default to remove superseded patches
' sMspProductFilter = "" -> If enabled remove from all products
Dim fRemovePatch,sMspRemoveFilter,sMspProductFilter
fRemovePatch = False
sMspRemoveFilter = "Superseded"
sMspProductFilter= ""
'Delete cached .msp files that are no longer referenced by any product from the local Windows Installer cache
Dim fCleanCache
fCleanCache = False
'Suppress debug logging details from the log
'Default: fNoDebugLog = False -> Add debug logging information
Dim fNoDebugLog
fNoDebugLog = False
'DO NOT CUSTOMIZE BELOW THIS LINE!
'=======================================================================================================
'Declarations
Const SOLUTIONNAME = "OPUtil"
Const SCRIPTBUILD = "2.24"
Const FOR_READING = 1
Const FOR_WRITING = 2
Const FOR_APPENDING = 8
Const TRISTATE_TRUE = -1
Const TRISTATE_USEDEFAULT = -2
Const LEN_GUID = 38
Const USERSID_NULL = ""
Const USERSID_EVERYONE = "s-1-1-0"
Const PID_TITLE = 2
Const PID_SUBJECT = 3 'Displayname
Const PID_AUTHOR = 4 'Author
Const PID_COMMENTS = 6 'Comments
Const PID_TEMPLATE = 7 'compatible platform and language versions for .msi / PatchTargets for .msp
Const PID_LASTAUTHOR = 8 'Transform Substorages
Const PID_REVNUMBER = 9 'package code for .msi / GUID patch code for .msp
Const PID_WORDCOUNT = 15 'minimum Windows Installer version
Const PID_SECURITY = 19 'read-only flag
'Component state constants
Const INSTALLSTATE_NOTUSED = -7 ' component disabled
Const INSTALLSTATE_UNKNOWN = -1 ' unrecognized product or feature
Const INSTALLSTATE_BROKEN = 0 ' broken
Const INSTALLSTATE_LOCAL = 3 ' installed.
Const INSTALLSTATE_SOURCE = 4 ' installed to run from source, CD, or network.
Const MSICOLUMNINFONAMES = 0
Const MSICOLUMNINFOTYPES = 1
Const MSIINSTALLCONTEXT_USERMANAGED = 1
Const MSIINSTALLCONTEXT_USERUNMANAGED = 2
Const MSIINSTALLCONTEXT_MACHINE = 4
Const MSIINSTALLCONTEXT_ALL = 7
Const MSIPATCHSTATE_APPLIED = 1
Const MSIPATCHSTATE_SUPERSEDED = 2
Const MSIPATCHSTATE_OBSOLETED = 4
Const MSIPATCHSTATE_REGISTERED = 8
Const MSIPATCHSTATE_ALL = 15
Const MSIOPENDATABASEMODE_READONLY = 0
Const MSIOPENDATABASEMODE_TRANSACT = 1
Const MSIOPENDATABASEMODE_PATCHFILE = 32
Const MSISOURCETYPE_NETWORK = 1
Const MSISOURCETYPE_URL = 2
Const MSIUILEVEL_BASIC = 3
Const MSIUILEVEL_PROGRESSONLY = 64
Const MSIINSTALLTYPE_SINGLEINSTANCE = 2
Const MSIINSTALLSTATE_LOCAL = 3
Const MSITRANSFORMERROR = 256
Const MSITRANSFORMERROR_ALL = 319
Const HKCR = &H80000000
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKU = &H80000003
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const MSP_NOSEQ = 0
Const MSP_MINOR = 1
Const MSP_SMALL = 2
Const COL_FILENAME = 0
Const COL_TARGETS = 1
Const COL_PATCHCODE = 2
Const COL_SUPERSEDES = 3
Const COL_KB = 4
Const COL_PACKAGE = 5
Const COL_RELEASE = 6
Const COL_SEQUENCE = 7
Const COL_FAMILY = 8
Const COL_PATCHXML = 9
Const COL_PATCHTABLES = 10
Const COL_REFCNT = 11
Const COL_APPLIEDCNT = 12
Const COL_SUPERSEDEDCNT = 13
Const COL_APPLICABLECNT = 14
Const COL_NOQALBASELINECNT = 15
Const COL_PATCHBASELINES = 16
Const COL_MAX = 16
Const REG_GLOBALCONFIG = "Software\Microsoft\Windows\CurrentVersion\Installer\UserData\"
Const REG_PRODUCT = "Software\Classes\Installer\"
Const REG_PRODUCTPERUSER = "Software\Microsoft\Installer\"
Const REG_PRODUCTPERUSERMANAGED = "Software\Microsoft\Windows\CurrentVersion\Installer\Managed\"
Const ERR_REBOOT = "A reboot is required to complete the update(s)!"
Const OFFICE_ALL = "78E1-11D2-B60F-006097C998E7}.0001-11D2-92F2-00104BC947F0}.6000-11D3-8CFE-0050048383C9}.6000-11D3-8CFE-0150048383C9}.BDCA-11D1-B7AE-00C04FB92F3D}.6D54-11D4-BEE3-00C04F990354}.CFDA-404E-8992-6AF153ED1719}."
'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 PPS_2007 = "CFDA-404E-8992-6AF153ED1719}" 'Project Portfolio Server 2007
Const OFFICEID = "000-0000000FF1CE}" 'cover O12, O14 with 32 & 64 bit
Const DISK_UNKNOWN = 0
Const DISK_NOROOTDIR = 1
Const DISK_REMOVABLE = 2
Const DISK_LOCAL = 3
Const DISK_NETWORK = 4
Const DISK_CD = 5
Const DISK_RAM = 6
Const SQL_CREATEFILETABLE = "CREATE TABLE `File` (`File` CHAR(72) NOT NULL, `Component_` CHAR(72) NOT NULL, `FileName` CHAR(255) NOT NULL LOCALIZABLE, `FileSize` LONG NOT NULL, `Version` CHAR(72), `Language` CHAR(20), `Attributes` SHORT, `Sequence` LONG NOT NULL PRIMARY KEY `File`)"
Const SQL_CREATECATABLE = "CREATE TABLE `CustomAction` (`Action` CHAR(72) NOT NULL, `Type` SHORT NOT NULL, `Source` CHAR(72), `Target` CHAR(255) PRIMARY KEY `Action`)"
Const SQL_CREATEPROPTABLE = "CREATE TABLE `Property` (`Property` CHAR(72) NOT NULL, `Value` LONGCHAR NOT NULL LOCALIZABLE PRIMARY KEY `Property`)"
Const MSIREADSTREAM_ANSI = 2
Const xlTop = &HFFFFEFC0
Const xlUp = &HFFFFEFBE
Const xlSrcRange = 1
Const xlYes = 1
Const xlNo = 2
Const xlMaximized = &HFFFFEFD7
Const COL_NONPOUND = 1
Const COL_POUND = 2
Const HROW = 1
Const SEQ_PATCHFAMILY = 1
Const SEQ_PRODUCTCODE = 2
Const SEQ_SEQUENCE = 3
Const SEQ_ATTRIBUTE = 4
Const MET_COMPANY = 1
Const MET_PROPERTY = 2
Const MET_VALUE = 3
Const TARGETGUID = 1
Const MSPTARGETVER = 2
Const MSPUPDATEDVER = 3
Const LCID = 4
Const CULTURE = 5
Const VAL_TARGETPRODUCTCODE = 6
Const VAL_TARGETVERSION = 7
Const VAL_TARGETLANGUAGE = 8
Const VAL_TARGETUPGRADECODE = 9
Const OTARGETGUID = 1
Const OTARGETNAME = 2
Const OFAMILYVER = 3
Const OMSPTARGETVER = 4
Const OMSPUPDATEDVER= 5
Const OLCID = 6
Const OCULTURE = 7
Const OLICENSE = 8
Const OARCHITECTURE = 9
Const OVAL_TARGETPRODUCTCODE = 10
Const OVAL_TARGETVERSION = 11
Const OVAL_TARGETLANGUAGE = 12
Const OVAL_TARGETUPGRADECODE = 13
Const OVAL_REINSTALLMODE = 14
Const OVAL_REINSTALL = 15
Const F_FILE = 1
Const F_COMPONENT = 2
Const F_FILENAME = 3
Const F_FILESIZE = 4
Const F_VERSION = 5
Const F_HASH = 6
Const F_LANGUAGE = 7
Const F_ATTRIBUTE = 8
Const F_SEQUENCE = 9
Const F_PREDICTED = 10
Const F_COMPSTATE = 11
Const F_CURSIZE = 12
Const F_CURVERSION = 13
Const F_CURHASH = 14
Const F_FILEPATH = 15
Const S_PROP = 1
Const S_VAL = 2
Const S_ROW_NAME = 2
Const S_ROW_KB = 3
Const S_ROW_PACKLET = 4
Const S_ROW_SEQUENCE = 5
Const S_ROW_BASELINE = 6
Const S_ROW_SUPERSEDENCE = 7
Const S_ROW_UNINSTALLABLE = 8
Const S_ROW_TITLE = 9
Const S_ROW_AUTHOR = 10
Const S_ROW_SUBJECT = 11
Const S_ROW_COMMENTS = 12
Const S_ROW_PATCHCODE = 13
Const S_ROW_TARGETS = 14
Const S_ROW_OBSOLETES = 15
Const S_ROW_TRANSFORMSUB = 16
Const S_ROW_PATCHTYPE = 17
Const S_ROW_SECURITY = 18
Const S_ROW_PATCHXML = 19
Dim sErr_Syntax
sErr_Syntax = vbCrLf & _
"Usage: " & vbTab & SOLUTIONNAME&".vbs [/Option] …" & vbCrLf & vbCrLf & _
" /RepairCache " & vbTab & "Tries to restore missing items in the local WI cache" & vbCrLf & _
" /SRestoreLocation=" & vbTab & "A list of fully qualified paths to folders with .msp files, separated by semicolons" & vbCrLf & _
" " & vbTab & vbTab & "<Folder01>;<\\Server02\Share02>;…" & vbCrLf & vbCrLf & _
" /ReconcileCache " & "Unregisters missing patches in the cache to unblock broken WI configurations" & vbCrLf & vbCrLf& _
" /ApplyPatch " & vbTab & "Apply patches from current folder and SUpdateLocation" & vbCrLf & _
" /SUpdateLocation=" & vbTab & "A list of fully qualified paths to folders with .msi and/or .msp files, separated by semicolons" & vbCrLf & _
" " & vbTab & vbTab & "<Folder01>;<\\Server02\Share02>;…" & vbCrLf& _
" /ExcludeCache"&vbTab& "Will not apply any patches from %windir%\installer folder" & vbCrLf& _
" /IncludeOctCache"&vbTab& "Includes OCT patches from %windir%\installer folder into patch detection" &vbCrLf&vbCrLf& _
" /RemovePatch " & vbTab & "Uninstall specified list of patches, separated by semicolons" & vbCrLf& _
" " & vbTab & "Accepts KBxxxxxx;{PatchCode};<FullPath>;SUPERSEDED" & vbCrLf&vbCrLf& _
" /CleanCache " & vbTab & "Removes unreferenced (orphaned) patch files from the local WI cache" & vbCrLf&vbCrLf& _
" /CabExtract=<Patch>" & vbTab & "Extracts the patch embedded .CAB file to the %temp% folder" & vbCrLf&vbCrLf& _
" /ViewPatch=<Patch>" & vbTab & "Display the patch contents in Excel" & vbCrLf&vbCrLf& _
" /DetectOnly"&vbTab& "Create a log file but do not execute any actions" & vbCrLf&vbCrLf & _
" /q " & vbTab& "Suppresses the automatic display of the log file" & vbCrLf&vbCrLf&vbCrLf& _
" /register " & vbTab& "Registers OPUtil context menu extensions for .msp files" & vbCrLf&vbCrLf&vbCrLf& _
" /unregister" & vbTab& "UnRegisters OPUtil context menu extensions for .msp files" & vbCrLf&vbCrLf&vbCrLf& _
"By default 'RepairCache' and 'ApplyPatch' are enabled." & vbCrLf& _
"To disable use /[Option]=False." & vbCrLf & vbCrLf & _
"Examples" &vbCrLf&"========"&vbCrLf& _
"Default 'RepairCache' & 'ApplyPatch' from current directory:" &vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs" & vbCrLf & vbCrLf & _
"Repair and reconcile a broken Windows Installer Cache:" &vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs /ReconcileCache /RepairCache /SRestoreLocation=<\\Location1\ShareName>;<\\Location2\ShareName>" & vbCrLf & vbCrLf & _
"Create a log for applicability of specific patches:" &vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs /ApplyPatch /SUpdateLocation=<\\Location1\ShareName>;<\\Location2\ShareName> /ExcludeCache /DetectOnly" & vbCrLf & vbCrLf & _
"Install applicable patches (including local Windows Installer cache):" &vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs /ApplyPatch /SUpdateLocation=<\\Location1\ShareName>;<\\Location2\ShareName>" & vbCrLf & vbCrLf & _
"UnInstall patch(es):" &vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs /RemovePatch=KB123456;KB654321" & vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs /RemovePatch={PatchCode}" & vbCrLf& _
" cscript.exe "&SOLUTIONNAME&".vbs /RemovePatch=Superseded" & vbCrLf '& vbCrLf & _
Dim oMsi,oFso,oReg,oWShell,oShellApp,oWmiLocal,DateTime,XmlDoc,oFile
Dim LogStream,ReadStream,LogProd
Dim fCScript,fx64,fCleanAggressive,fRebootRequired,fSumInit,fUpdatesCollected,fViewPatch,fCabExtract
Dim fShowLog,fForceRemovePatch,fContextMenu,fDeepScan, fDynSUpdateDiscovered, fMsiProvidedAsFile
Dim fNeedGenericSql
Dim sLogFile,sLogSummary,sAppData,sTmp,sTemp,sWinDir,sWICacheDir,sScriptDir,sTimeStamp,sLogNoRef
Dim Location,Key,vWI,vWIMajorMinor,sProductVersionNew,sProductVersionReal,sMspFile,sApplyPatch
Dim sOSinfo, sOSVersion, sComputerName, sExternalMsi
Dim iIndex,iVersionNt
Dim arrUpdateLocations,arrRestoreLocations,arrSUpdatesAll,arrTmpLog
Dim dicSUpdatesAll,dicFamily,dicSummary,dicRepair,dicLocalDisks,dicMspNoSeq,dicMspMinor,dicMspSmall
Dim dicMspObsoleted,dicMspSequence,dicDynCultFolders,dicSqlCreateTbl,dicProdMst
'=======================================================================================================
'Main
On Error Resume Next
'Initialize objects and defaults
Initialize
'Parse the command line
ParseCmdLine
'Validate ShowLog setting
If (fApplyPatch AND NOT fViewPatch) OR fCleanCache OR fForceRemovePatch OR fReconcileCache OR fRemovePatch OR fRepairCache Then fShowLog = True
sTmp = ""
Log "Current Settings:"
Log Space(30)&"/RepairCache "&fRepairCache&", "&"/SRestoreLocation="&sRestoreLocation
Log Space(30)&"/ReconcileCache "&fReconcileCache
Log Space(30)&"/ApplyPatch "&fApplyPatch&", /ExcludeCache "&fExcludeCache&", /IncludeOctCache "&fIncludeOctCache&", /SUpdateLocation="&sUpdateLocation
Log Space(30)&"/RemovePatch "&fRemovePatch&", Patches="&sMspRemoveFilter
Log Space(30)&"/CleanCache "&fCleanCache
Log Space(30)&"/CabExtract "&fCabExtract
Log Space(30)&"/ViewPatch "&fViewPatch
Log Space(30)&"/DetectOnly "&fDetectOnly
Log Space(30)&"/Q "&bQuiet &vbCrLf
Log Space(30)&"For more details on available commands run "&chr(34)&"cscript OPUtil.vbs /?"&chr(34)&vbCrLf
If Not Err = 0 Then
Log "Error: Could not determine script parameters. Aborting"
Log vbCrLf & "End of script: " & Now
LogStream.Close
wscript.Quit 1
End If
If fCscript Then wscript.echo "Init complete"
'Log if DetectOnly
If fDetectOnly Then
sTmp = "DetectOnly mode. No changes will be done to the system!"
Log String(Len(sTmp),"=")&vbCrLf&sTmp&vbCrLf&String(Len(sTmp),"=")&vbCrLf
sTmp = ""
End If 'fDetectOnly
'Set the bookmark for the summary
Log "[SUMMARY]"
'Add marker to indicate the start of debug logging section
sTmp = "Debug Logging Section"
Log vbCrLf&String(Len(sTmp),"=")&vbCrLf&sTmp&vbCrLf&String(Len(sTmp),"=")
'Ensure correct value for SRestoreLocation
arrRestoreLocations = EnsureLocation(sRestoreLocation & ";" & sUpdateLocation)
'Ensure correct value for SUpdateLocation
If (NOT fApplyPatch) AND (NOT fRemovePatch) AND sUpdateLocation="" _
Then arrUpdateLocations=Split(sScriptDir,";") _
Else arrUpdateLocations = EnsureLocation(sUpdateLocation)
'"RepairCache" .msi/.msp resiliency'
'——————————-
If fRepairCache Then
'Build the 'Repair' references
InitRepairDic
'Check and try to restore missing files if needed
RepairCache
End If 'fRepairCache
'"ReconcileCache" patch reconcile
'——————————-
If fReconcileCache Then MspReconcile
'"ApplyPatch" apply patches
'————————-
If fApplyPatch AND NOT fViewPatch Then ApplyPatches
'"CleanCache" orphaned .msp cleanup
'———————————-
If fCleanCache Then WICleanOrphans
'"RemovePatch" Uninstall patches
'——————————-
If fRemovePatch Then
Dim arrMspRemove
Dim Msp,Item
sTmp = "Running MspRemove with filter: '" & sMspRemoveFilter &"'"
Log vbCrLf&vbCrLf&sTmp &vbCrLf& String(Len(sTmp),"-")
If fCscript Then wscript.echo "Checking for removable patches"
arrMspRemove = Split(sMspRemoveFilter,";")
For Each Item In arrMspRemove
Msp = Item
'Check if it's a reference to a .msp file
If Len(Msp)>4 Then
If LCase(Right(Msp,4))=".msp" Then
If oFso.FileExists(Msp) Then
sMspRemoveFilter=sMspRemoveFilter & Left(oMsi.SummaryInformation(Msp).Property(PID_REVNUMBER),38)
End If
End If
End If
If NOT Left(Msp,1)="{" Then
If NOT fUpdatesCollected Then CollectSUpdates
For iIndex = 0 To UBound(arrSUpdatesAll)
If arrSUpdatesAll(iIndex,COL_KB) = Replace(Msp,"KB","") Then sMspRemoveFilter=sMspRemoveFilter & ";"&arrSUpdatesAll(iIndex,COL_PATCHCODE)
If UCase(arrSUpdatesAll(iIndex,COL_RELEASE)) = UCase(Msp) Then sMspRemoveFilter=sMspRemoveFilter & ";"&arrSUpdatesAll(iIndex,COL_PATCHCODE)
Next 'iIndex
End If
Next 'Item
If InStr(sMspRemoveFilter,"{")>0 Then MspRemove sMspRemoveFilter,sMspProductFilter
If InStr(UCase(sMspRemoveFilter),"SUPERSEDED")>0 Then MspRemove "Superseded",sMspProductFilter
End If
'"ViewPatch"
'———-
If fViewPatch Then
ViewPatch sMspFile
End If
'"CabExtract"
'————-
If fCabExtract Then
sTmp = CabExtract(sMspFile)
End If
'Check reboot requirement
If fRebootRequired Then
Log vbCrLf & "Note: "&ERR_REBOOT
wscript.echo ERR_REBOOT
End If 'fRebootRequired
'Close the temp log
sTmp = "End of script: " & Now
Log vbCrLf & vbCrLf & String(Len(sTmp),"=") &vbCrLf & sTmp
LogStream.Close
'Create the final log including the summary section
'Log Notes & Errors
For Each Key in dicSummary.Keys
sTmp = ""
If NOT Left(Key,1)="{" Then sLogSummary = sLogSummary &vbCrLf&Key & dicSummary.Item(Key)
Next 'Key
'By Patch Summary
fSumInit = False
If fApplyPatch AND (NOT fViewPatch OR fDeepScan) Then
For iIndex = 0 To UBound(arrSUpdatesAll)
If (NOT Left(arrSUpdatesAll(iIndex,COL_FILENAME),Len(sWICacheDir)) = sWICacheDir) OR _
(Len(arrSUpdatesAll(iIndex,COL_APPLICABLECNT))>0) OR _
(Len(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT))>0) Then
'Found patch to be logged
'Check if Heading needs to be added
If NOT fSumInit Then
fSumInit = True
sLogSummary = sLogSummary &vbCrLf&vbCrLf&"Summary By Patch"&vbCrLf&"================"
sLogNoRef = ""
End If
'Add patch & product details
If (arrSUpdatesAll(iIndex,COL_REFCNT)= 0) Then
sLogNoRef = sLogNoRef &vbCrLf&" - KB "&arrSUpdatesAll(iIndex,COL_KB)& _
", "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
Else
sLogSummary = sLogSummary &vbCrLf&vbCrLf&"KB "&arrSUpdatesAll(iIndex,COL_KB)& _
", "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
'Applied details
sTmp = vbTab&"Applied: "
If InStr(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),";")>0 Then
ReDim arrTmpLog(-1)
If Right(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),1)=";" Then _
arrSUpdatesAll(iIndex,COL_APPLIEDCNT) = Left(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),Len(arrSUpdatesAll(iIndex,COL_APPLIEDCNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),";")
sTmp = sTmp & "Patch is installed to "&UBound(arrTmpLog)+1&" product(s)"
For Each LogProd in arrTmpLog
sTmp = sTmp&vbCrLf&vbTab&vbTab&LogProd&" - "
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")
Next 'LogPatch
sLogSummary = sLogSummary &vbCrLf&sTmp
Else
sTmp = sTmp & "No"
End If
'Superseded details
sTmp = vbTab&"Superseded: "
If InStr(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),";")>0 Then
ReDim arrTmpLog(-1)
If Right(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),1)=";" Then _
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = Left(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),Len(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),";")
sTmp = sTmp & "Patch is superseded for "&UBound(arrTmpLog)+1&" product(s)"
For Each LogProd in arrTmpLog
sTmp = sTmp&vbCrLf&vbTab&vbTab&LogProd&" - "
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")
Next 'LogPatch
sLogSummary = sLogSummary &vbCrLf&sTmp
Else
sTmp = sTmp & "No"
End If
'Applicable details
sTmp = vbTab&"Applicable: "
If InStr(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),";")>0 Then
ReDim arrTmpLog(-1)
If Right(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),1)=";" Then _
arrSUpdatesAll(iIndex,COL_APPLICABLECNT) = Left(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),Len(arrSUpdatesAll(iIndex,COL_APPLICABLECNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),";")
sTmp = sTmp & "Patch is applicable to "&UBound(arrTmpLog)+1&" product(s)"
For Each LogProd in arrTmpLog
sTmp = sTmp&vbCrLf&vbTab&vbTab&LogProd&" - "
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")
Next 'LogPatch
sLogSummary = sLogSummary &vbCrLf&sTmp
Else
sTmp = sTmp & "No"
End If
'Applicable but no valid baseline details
sTmp = vbTab&"Can't apply: "
If InStr(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),";")>0 Then
ReDim arrTmpLog(-1)
If Right(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),1)=";" Then _
arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT) = Left(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),Len(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),";")
sTmp = sTmp & "Patch is applicable to "&UBound(arrTmpLog)+1&" product(s) but the product(s) do(es) not meet the required SP level "
For Each LogProd in arrTmpLog
sTmp = sTmp&vbCrLf&vbTab&vbTab&LogProd&" - "&oMsi.ProductInfo(LogProd,"ProductName")& _
vbCrLf&vbTab&vbTab&"Patch baseline(s): "&arrSUpdatesAll(iIndex,COL_PATCHBASELINES)& ". Installed baseline: " &oMsi.ProductInfo(LogProd,"VersionString")&vbCrLf
Next 'LogPatch
sLogSummary = sLogSummary &vbCrLf&sTmp
Else
sTmp = sTmp & "No"
End If
End If
End If
Next 'iIndex
If NOT sLogNoRef="" Then sLogSummary = sLogSummary & vbCrLf&vbCrLf& "Patch(es) that don't target any installed applications:"& sLogNoRef
End If 'fApplyPatch
'By Product Summary
If fSumInit Then sLogSummary = sLogSummary &vbCrLf&vbCrLf&vbCrLf&"Summary By Product"&vbCrLf&"=================="&vbCrLf
For Each Key in dicSummary.Keys
sTmp = ""
If Left(Key,1)="{" Then
sTmp = Key&" - "&oMsi.ProductInfo(Key,"ProductName")
sLogSummary = sLogSummary &vbCrLf&sTmp & dicSummary.Item(Key)
End If
Next 'Key
Err.Clear
If sLogSummary = "==============="&vbCrLf&"Summary Section"&vbCrLf&"==============="&vbCrLf Then sLogSummary = sLogSummary&vbCrLf&" All appears to be well."&vbCrLf&vbCrLf&"For detailed logging see the 'Debug' section below."&vbCrLf
Set ReadStream= oFso.OpenTextFile(sLogFile,FOR_READING,False,TRISTATE_USEDEFAULT)
Set LogStream = oFso.CreateTextFile(sTemp&SOLUTIONNAME&".log",True,True)
Do While Not ReadStream.AtEndOfStream
sTmp = ReadStream.ReadLine
If NOT InStr(sTmp,"[SUMMARY]")>0 Then
LogStream.WriteLine sTmp
Else
LogStream.Write sLogSummary&vbCrLf
If fRebootRequired Then LogStream.Write vbCrLf&ERR_REBOOT&vbCrLf&vbCrLf
If (NOT ReadStream.AtEndOfStream AND NOT fNoDebugLog) Then LogStream.Write ReadStream.ReadAll
Exit Do
End If
Loop
ReadStream.Close
LogStream.Close
oFso.DeleteFile sLogFile
'Show completion notice
If fCscript Then wscript.echo "Script execution complete."
'Show the log
If (NOT bQuiet) AND fShowLog Then oWShell.Run chr(34) & sTemp&SOLUTIONNAME&".log" & chr(34)
'END
'====
'=======================================================================================================
'Initialize Objects and defaults
Sub Initialize
Dim Item,ComputerItem,Process,Processes
Dim iInstanceCnt
On Error Resume Next
fCScript = False
fx64 = False
fViewPatch = False
fCabExtract = False
fShowLog = False
sMspFile = ""
sApplyPatch = ""
fUpdatesCollected = False
fCleanAggressive = False
fForceRemovePatch = False
fRebootRequired = False
fContextMenu = False
fDeepScan = False
fDynSUpdateDiscovered = False
fNeedGenericSql = True
fMsiProvidedAsFile = False
Set dicSqlCreateTbl = CreateObject("Scripting.Dictionary")
Set dicProdMst = CreateObject("Scripting.Dictionary")
sLogSummary = "==============="&vbCrLf&"Summary Section"&vbCrLf&"==============="&vbCrLf
Set oMsi = CreateObject("WindowsInstaller.Installer")
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oWShell = CreateObject("WScript.Shell")
Set oShellApp = CreateObject("Shell.Application")
Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Set oWmiLocal = GetObject("winmgmts:\\.\root\cimv2")
Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
Set XmlDoc = CreateObject("Microsoft.XMLDOM")
'Ensure there's only a single instance running of this script
iInstanceCnt = 0
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),"oputil")>0 Then iInstanceCnt=iInstanceCnt+1
End If
Next 'Process
If iInstanceCnt>1 Then
wscript.echo "Error: Another instance of this script is already running."
wscript.quit
End If
'Obtain the current timestamp
DateTime.SetVarDate Now,True
sTimeStamp = Left(DateTime.Value,14)
'Are we running on Cscript?
fCScript = (LCase(Mid(Wscript.FullName, Len(Wscript.Path)+2, 1)) = "c")
'Get environment path info
sAppData = oWShell.ExpandEnvironmentStrings("%appdata%")&"\"
sTemp = oWShell.ExpandEnvironmentStrings("%temp%")&"\"
sWinDir = oWShell.ExpandEnvironmentStrings("%windir%")&"\"
sWICacheDir = sWinDir&"Installer\"
sScriptDir = wscript.ScriptFullName
sScriptDir = Left(sScriptDir,InStrRev(sScriptDir,"\"))
'Init default for the resiliency .msi & .msp location
sRestoreLocation = sRestoreLocation&";"&sScriptDir&";"&sWICacheDir
If Left(sRestoreLocation,1)=";" Then sRestoreLocation = Mid(sRestoreLocation,2)
'Create the logfile with initial data
sLogFile = sTemp & "~"&SOLUTIONNAME&".log"
Set LogStream = oFso.CreateTextFile(sLogFile,True,True)
Log "Microsoft Customer Support Services - " &SOLUTIONNAME & " V "& SCRIPTBUILD & " - " & Now & vbCrLf
vWI = oMsi.Version
vWIMajorMinor = Left(vWi,3)
sTmp = "Windows Installer Version:"
Log sTmp&Space(30-Len(sTmp))&vWI
sTmp = "ComputerName:"
Log sTmp&Space(30-Len(sTmp))& oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
'Initialize the 'Summary' log dictionary
Set dicSummary = CreateObject("Scripting.Dictionary")
If vWIMajorMinor = "4.5" AND vWI<"4.5.6001.22392" Then _
LogSummary "Important Note:","KB 972397 contains important updates for the installed version of Windows Installer! http://support.microsoft.com/kb/972397/EN-US/”"
'More recent version of WI: KB 2388997. KB search term "Msi.dll" AND "hotfix information"
'Detect if we're running on a 64 bit OS
Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
For Each Item In ComputerItem
fx64 = Instr(Left(Item.SystemType,3),"64") > 0
sTmp = "OS Architecture:"
Log sTmp&Space(30-Len(sTmp))& Item.SystemType
Next
'Find local disk drives
Set dicLocalDisks = CreateObject("Scripting.Dictionary")
FindLocalDisks
End Sub
'=======================================================================================================
'Command Line Parser
Sub ParseCmdLine
Dim sTmp,sArg
Dim iCnt,iArgCnt
Dim fIgnoreOnce,fArray,fValidCmdFound
Dim arrArg
On Error Resume Next
fIgnoreOnce = False
fArray = False
iArgCnt = WScript.Arguments.Count
If Not iArgCnt > 0 Then
'Use defaults
Exit Sub
End If
Dim iActionCnt
Dim fRepairCacheOrg,fReconcileCacheOrg,fApplyPatchOrg,fRemovePatchOrg,fCleanCacheOrg
'Found command line argument(s) -> default to disabled modules
iActionCnt = 0
fValidCmdFound = False
fRepairCacheOrg = fRepairCache : fRepairCache = False
fReconcileCacheOrg = fReconcileCache : fReconcileCache = False
fApplyPatchOrg = fApplyPatch : fApplyPatch = False
fRemovePatchOrg = fRemovePatch : fRemovePatch = False
fCleanCacheOrg = fCleanCache : fCleanCache = False
For iCnt = 0 To (iArgCnt-1)
sArg = ""
sArg = UCase(WScript.Arguments(iCnt))
If InStr(sArg,"=")>0 Then
Set arrArg = Nothing
arrArg=Split(sArg,"=",2)
sArg = arrArg(0)
fArray = True
End If
Select Case sArg
Case "/?"
Wscript.Echo sErr_Syntax
Wscript.Quit
Case "/APPLYPATCH","-APPLYPATCH","APPLYPATCH"
fValidCmdFound = True
fShowLog = True
If fArray Then
If arrArg(1) = "FALSE" Then
fApplyPatch = False
fApplyPatchOrg = False
fValidCmdFound = False
End If
fApplyPatch = True
iActionCnt = iActionCnt + 1
sApplyPatch = arrArg(1)
If oFso.FileExists(sApplyPatch) Then
Set oFile = oFso.GetFile(sApplyPatch)
If sUpdateLocation = "" Then sUpdateLocation = oFile.ParentFolder.Path Else sUpdateLocation = sUpdateLocation&";"&oFile.ParentFolder.Path
End If
fArray = False
Else
fApplyPatch = True
iActionCnt = iActionCnt + 1
End If
Case "/CABEXTRACT","-CABEXTRACT","CABEXTRACT"
fValidCmdFound = True
iActionCnt = iActionCnt + 1
fCabExtract = True
If fArray Then
sMspFile = arrArg(1)
fArray = False
Else
fIgnoreOnce = True
If (iArgCnt-1) > iCnt Then _
sMspFile = WScript.Arguments(iCnt+1) Else
sMspFile = ""
End If
Case "/CLEANAGGRESSIVE","-CLEANAGGRESSIVE","CLEANAGGRESSIVE"
fCleanAggressive = True
Case "/CLEANCACHE","-CLEANCACHE","CLEANCACHE"
fValidCmdFound = True
fShowLog = True
If fArray Then
If arrArg(1) = "FALSE" Then
fCleanCache = False
fCleanCacheOrg = False
End If
If arrArg(1) = "TRUE" Then
fCleanCache = True
iActionCnt = iActionCnt + 1
End If
fArray = False
Else
fCleanCache = True
iActionCnt = iActionCnt + 1
End If
Case "/CONTEXTMENU"
fContextMenu = True
' Case "/DEEPSCAN"
' iActionCnt = iActionCnt + 1
' fDeepScan = True
' fDetectOnly = True
' fApplyPatch = True
Case "/DETECTONLY","-DETECTONLY","DETECTONLY"
If fArray Then
If arrArg(1)="TRUE" OR arrArg(1)=1 Then fDetectOnly=True Else fDetectOnly=False
fArray=False
Else
fDetectOnly = True
End If 'fArray
Case "/DISABLEREPAIR","-DISABLEREPAIR","DISABLEREPAIR"
fRepairCache = False
Case "/EXCLUDECACHE","-EXCLUDECACHE","EXCLUDECACHE"
fExcludeCache = True
'Warning: This is an undocumented and unsupported feature!
Case "/FORCEREMOVEPATCH","-FORCEREMOVEPATCH","FORCEREMOVEPATCH"
fForceRemovePatch = True
fValidCmdFound = True
fShowLog = True
If fArray Then
If arrArg(1) = "FALSE" Then
fForceRemovePatch = False
Else
fRemovePatch = True
sMspRemoveFilter = Replace(arrArg(1),",",";")
iActionCnt = iActionCnt + 1
End If
fArray = False
End If
Case "/INCLUDEOCTCACHE","-INCLUDEOCTCACHE","INCLUDEOCTCACHE"
fIncludeOctCache = True
Case "/R","-R","R","/REGISTER","-REGISTER","REGISTER"
fValidCmdFound = True
iActionCnt = iActionCnt + 1
RegisterShellExt
Case "/RECONCILECACHE","-RECONCILECACHE","RECONCILECACHE"
fValidCmdFound = True
fShowLog = True
If fArray Then
If arrArg(1) = "FALSE" Then
fReconcileCache = False
fReconcileCacheOrg = False
End If
If arrArg(1) = "TRUE" Then
fReconcileCache = True
iActionCnt = iActionCnt + 1
End If
fArray = False
Else
fReconcileCache = True
iActionCnt = iActionCnt + 1
End If
Case "/REMOVEPATCH","-REMOVEPATCH","REMOVEPATCH"
fValidCmdFound = True
fShowLog = True
If fArray Then
If arrArg(1) = "FALSE" Then
fRemovePatch = False
fRemovePatchOrg = False
Else
fRemovePatch = True
sMspRemoveFilter = Replace(arrArg(1),",",";")
iActionCnt = iActionCnt + 1
End If
fArray = False
Else
fRemovePatch = True
iActionCnt = iActionCnt + 1
End If
Case "/REPAIRCACHE","-REPAIRCACHE","REPAIRCACHE"
fValidCmdFound = True
fShowLog = True
If fArray Then
If arrArg(1) = "FALSE" Then
fRepairCache = False
fRepairCacheOrg = False
End If
If arrArg(1) = "TRUE" Then
fRepairCache = True
iActionCnt = iActionCnt + 1
End If
fArray = False
Else
fRepairCache = True
iActionCnt = iActionCnt + 1
End If
Case "/SRESTORELOCATION","-SRESTORELOCATION","SRESTORELOCATION" 'SRestoreLocation
If fArray Then
sRestoreLocation = arrArg(1)
fArray = False
Else
fIgnoreOnce = True
sRestoreLocation = WScript.Arguments(iCnt+1)
End If
Case "/SUPDATELOCATION","-SUPDATELOCATION","SUPDATELOCATION","/SUPDATESLOCATION","-SUPDATESLOCATION","SUPDATESLOCATION" 'SUpdateLocation
If fArray Then
sUpdateLocation = arrArg(1)
fArray = False
Else
fIgnoreOnce = True
sUpdateLocation = WScript.Arguments(iCnt+1)
End If
Case "/U","-U","U","/UNREGISTER","UNREGISTER","UNREGISTER"
fValidCmdFound = True
iActionCnt = iActionCnt + 1
UnRegisterShellExt
Case "/VIEW","/VIEWPATCH"
iActionCnt = iActionCnt + 1
fValidCmdFound = True
fViewPatch = True
fDetectOnly = True
fApplyPatch = True
fDeepScan = True
If fArray Then
sMspFile = arrArg(1)
If oFso.FileExists(sMspFile) Then
Set oFile = oFso.GetFile(sMspFile)
If sUpdateLocation = "" Then sUpdateLocation = oFile.ParentFolder.Path Else sUpdateLocation = sUpdateLocation&";"&oFile.ParentFolder.Path
End If
fArray = False
Else
fIgnoreOnce = True
If (iArgCnt-1) > iCnt Then _
sMspFile = WScript.Arguments(iCnt+1) Else _
sMspFile = ""
End If
Case "/Q"
bQuiet = True
Case Else
If NOT fIgnoreOnce Then
sTmp = ""
sTmp = vbCrLf&"Warning: Invalid command line switch '" & WScript.Arguments(iCnt) & "' will be ignored."&vbCrLf
If NOT bQuiet Then wscript.echo sTmp
Log sTmp
fIgnoreOnce = NOT fIgnoreOnce
End If
End Select
Next 'iCnt
'Ensure we had a valid Cmd
If NOT fValidCmdFound OR iActionCnt = 0 Then
'Restore defaults
fShowLog = True
fRepairCache = fRepairCacheOrg
fReconcileCache = fReconcileCacheOrg
fApplyPatch = fApplyPatchOrg
fRemovePatch = fRemovePatchOrg
fCleanCache = fCleanCacheOrg
End If
End Sub 'ParseCmdLine
'=======================================================================================================
'Build a dictionary array for a reference list of available .msi and .msp packages
'Key for .msi is <ProductCode>_<PackageCode> (required to support AIP installs)
'Key for .msp is <PatchCode>
Sub InitRepairDic
Dim File,Folder,MspDb,Record,SumInfo
Dim sProductCode,sPackageCode,sKey
Dim qView
On Error Resume Next
If fCscript Then wscript.echo "Collecting resiliency data"
Set dicRepair = CreateObject("Scripting.Dictionary")
For Each Folder in arrRestoreLocations
If fCscript Then wscript.echo vbTab&"Collect files from "&Folder
For Each File in oFso.GetFolder(Folder).Files
Select Case LCase(Right(File.Name,4))
Case ".msp"
sKey = ""
sKey = oMsi.SummaryInformation(File.Path,MSIOPENDATABASEMODE_READONLY).Property(PID_REVNUMBER)
If Len(sKey)>LEN_GUID Then sKey=Left(sKey,LEN_GUID)
If Not dicRepair.Exists(sKey) Then dicRepair.Add sKey,File.Path
Case ".msi"
sKey = GetMsiProductCode(File.Path)&"_"&GetMsiPackageCode(File.Path)
If Not dicRepair.Exists(sKey) Then dicRepair.Add sKey,File.Path
Case Else
'Do Nothing
End Select
Next 'File
Next 'Folder
End Sub 'InitRepairDic
'=======================================================================================================
Sub RepairCache
Dim File,Product,Prod,PatchList,Patch,Source,MsiSources,MspSources
Dim sLocalMsi,sLocalMsp,sKey,sSourceKey,sRepair,sFile,sFileName,sPackage
Dim sRegPackageCode,sMsiPackageCode,sGlobalPatchesKey,sClassesPatchesKey
Dim fTrySource,fRepaired,fMsiOK,fMsiRename,fReLoop
Dim dicMspError, dicMspChecked, dicMspUnreg ,arrKeys
Dim iReLoop
On Error Resume Next
Set dicMspError = CreateObject("Scripting.Dictionary")
Set dicMspChecked = CreateObject("Scripting.Dictionary")
Set dicMspUnreg = CreateObject("Scripting.Dictionary")
sTmp = "Running RepairCache"
Log vbCrLf&vbCrLf&sTmp&vbCrLf& String(Len(sTmp),"-")
If fCscript Then wscript.echo "Scanning Windows Installer cache"
For Each Product in oMsi.Products
Log vbCrLf&"Product: "&Product&" - "&oMsi.ProductInfo(Product,"ProductName")
If fCscript Then wscript.echo vbTab&"Scan "&Product&" - "&oMsi.ProductInfo(Product,"ProductName")
'Check local .msi package
sLocalMsi = "" : sRegPackageCode = "" : sFileName = "" : sRepair = ""
fTrySource = False : fRepaired = False : fMsiOK = False : fMsiRename = False
Err.Clear
sLocalMsi = oMsi.ProductInfo(Product,"LocalPackage")
sRegPackageCode = oMsi.ProductInfo(Product,"PackageCode")
If Err = 0 Then
If oFso.FileExists(sLocalMsi) Then
sMsiPackageCode = GetMsiPackageCode(sLocalMsi)
If sRegPackageCode = sMsiPackageCode Then
fMsiOK = True
Log vbTab&"Success: Local .msi package " &sLocalMsi & " is available and valid."
Else
'PackageCode mismatch! Windows Installer will not accept the local copy in the WI cache as valid.
fMsiRename = True
sTmp = vbTab&"Error: Local .msi package "&sLocalMsi&" is available but invalid. Registered PackageCode '"&sRegPackageCode&"' does not match cached files PackageCode '"&sMsiPackageCode&"'"
LogSummary Product,sTmp
If fCscript Then wscript.echo vbTab&vbTab&"Error: Local .msi package "&sLocalMsi&" is available but invalid."
End If
End If 'oFso.FileExists
Else
Err.Clear
End If
If NOT fMsiOK Then
If sLocalMsi = "" Then
sTmp = vbTab&"Error: No local .msi package registered. Cannot restore."
Log sTmp
Else
'Try to restore from available resources
sRepair = "Error: Local .msi package missing. Attempt failed to restore "
If fMsiRename Then sRepair = "Note: No matching .msi package available to replace the mismatched file "
sKey = ""
sKey = Product&"_"&sRegPackageCode
If dicRepair.Exists(sKey) Then
If fMsiRename Then
If NOT fDetectOnly Then
sFileName = ""
Set File = oFso.GetFile(sLocalMsi)
sFileName = File.Name
File.Name = "Renamed_"&File.Name
oFso.CopyFile dicRepair.Item(sKey),sLocalMsi
End If 'fDetectOnly
Else
If NOT fDetectOnly Then oFso.CopyFile dicRepair.Item(sKey),sLocalMsi
End If 'fMsiRename
If oFso.FileExists(sLocalMsi) _
Then sRepair = "Restored: Successfully connected to 'RestoreLocation' ("&dicRepair.Item(sKey)&") to restore local .msi package " _
Else fTrySource = True
'Handle 'DetectOnly' exception
If fDetectOnly Then
sRepair = "Note: Restore is possible from 'RestoreLocation' ("&dicRepair.Item(sKey)&") to restore local .msi package "
fTrySource = False
End If 'fDetectOnly
Else
fTrySource = True
End If
'Try to restore from resgistered sources
If fTrySource Then
'Obtain a productsex handle
Set Prod = oMsi.ProductsEx(Product,"",MSIINSTALLCONTEXT_ALL)(0)
'Get the sources
Set MsiSources = Prod.Sources(1)
sPackage = ""
sPackage = Prod.SourceListInfo("PackageName")
For Each Source in MsiSources
Log "Debug: Trying to connect to resiliency source "&Source
If fCscript Then wscript.echo vbTab&vbTab&"Trying to connect to resiliency source "&Source
If fRepaired Then Exit For
sFile = ""
sFile = Source&sPackage
If oFso.FileExists(sFile) Then
sSourceKey = ""
sSourceKey = GetMsiProductCode(sFile)&"_"&GetMsiPackageCode(sFile)
If sKey = sSourceKey Then
If Not dicRepair.Exists(sSourceKey) Then dicRepair.Add sSourceKey,sFile
If NOT fDetectOnly AND fMsiRename Then
sFileName = ""
Set File = oFso.GetFile(sLocalMsi)
sFileName = File.Name
File.Name = "Renamed_"&File.Name
End If
If NOT fDetectOnly Then oFso.CopyFile sFile,sLocalMsi
fRepaired = oFso.FileExists(sLocalMsi)
If fDetectOnly Then sRepair = "Note: Restore is possible from 'registered InstallSource' ("&sFile&") to restore local .msi package "
End If 'sKey = sSourceKey
End If
Next 'Source
If fRepaired Then sRepair = "Restored: Successfully connected to 'registered InstallSource' ("&sFile&") to restore local .msi package "
End If 'fTrySource
If NOT oFso.FileExists(sLocalMsi) AND fMsiRename Then
'Undo rename
File.Name = sFileName
sRepair = "Error: Attmpt failed to replace the mismatched file. Original cached file has been restored "
End If
Set File = Nothing
'Log the result
sTmp = vbTab&sRepair&sLocalMsi&" (PackageCode: "&sRegPackageCode&")"
Log sTmp
End If
LogSummary Product,sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If
'Check local .msp packages
For iReLoop = 0 To 1
fReLoop = False
Set PatchList = oMsi.PatchesEx(Product,USERSID_NULL,MSIINSTALLCONTEXT_MACHINE,MSIPATCHSTATE_APPLIED + MSIPATCHSTATE_SUPERSEDED + MSIPATCHSTATE_OBSOLETED)
If Err = 0 Then
For Each Patch in PatchList
Err.Clear
sLocalMsp = "" : sRepair = "" : fTrySource = False : fRepaired = False
sLocalMsp = LCase(Patch.PatchProperty("LocalPackage"))
If Not dicMspChecked.Exists(Patch.PatchCode) Then dicMspChecked.Add Patch.PatchCode,sLocalMsp
If Not Err = 0 Then
Err.Clear
'This happens if a patch is registered but the global patch registration has gone missing.
'To work around this a correction entry is created
sTmp = vbTab&"Error: Failed to obtain local patch package data for patch '"&Patch.PatchCode&"'. Fixing patch registration."
If fDetectOnly Then sTmp = vbTab&"Error: Failed to obtain local patch package data for patch '"&Patch.PatchCode&"'. Patch registration would be fixed."
Log sTmp
LogSummary Product,sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT fDetectOnly Then
FixMspGlobalReg Patch.PatchCode
fReLoop = True
sLocalMsp = LCase(Patch.PatchProperty("LocalPackage"))
End If
End If
If NOT sLocalMsp = "" Then
If oFso.FileExists(sLocalMsp) Then
Log vbTab&"Success: Confirmed local patch package as '"&sLocalMsp&"'"&vbTab&"for patch '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")&"'."
Else
'Try to restore from available resources
sRepair = "Error: Local .msp package missing. Attempt failed to restore '"
sKey = ""
sKey = Patch.PatchCode
If dicRepair.Exists(sKey) Then
If NOT fDetectOnly Then oFso.CopyFile dicRepair.Item(sKey),sLocalMsp
If oFso.FileExists(sLocalMsp) Then sRepair = "Restored: Successfully connected to 'RestoreLocation' ("&dicRepair.Item(sKey)&") to restore local .msp package '" Else fTrySource = True
'Handle 'DetectOnly' exception
If fDetectOnly Then
sRepair = "Note: Restore is possible from 'RestoreLocation' ("&dicRepair.Item(sKey)&") to restore local .msp package "
fTrySource = False
If NOT dicMspError.Exists(Patch.PatchCode) Then dicMspError.Add Patch.PatchCode,sLocalMsp
End If 'fDetectOnly
Else
fTrySource = True
End If
'Try to restore from resgistered sources
If fTrySource Then
'Get the sources
sPackage = Patch.SourceListInfo("PackageName")
Set MspSources = Patch.Sources(1)
For Each Source in MspSources
If fRepaired Then Exit For
sFile = Source&sPackage
If oFso.FileExists(sFile) Then
sSourceKey = ""
sSourceKey = oMsi.SummaryInformation(sFile,MSIOPENDATABASEMODE_READONLY).Property(PID_REVNUMBER)
If sKey = sSourceKey Then
If NOT dicRepair.Exists(sSourceKey) Then dicRepair.Add sSourceKey,sFile
If NOT fDetectOnly Then oFso.CopyFile sFile,sLocalMsp
fRepaired = oFso.FileExists(sLocalMsp)
If fDetectOnly Then
sRepair = "Note: Restore is possible from 'registered InstallSource' ("&sFile&") to restore local .msp package "
If NOT dicMspError.Exists(Patch.PatchCode) Then dicMspError.Add Patch.PatchCode,sLocalMsp
End If
End If 'sKey = sSourceKey
End If
Next 'Source
If fRepaired Then
sRepair = "Restored: Successfully connected to 'registered InstallSource' ("&sFile&") to restore local .msp package "
Else
If NOT dicMspError.Exists(Patch.PatchCode) Then dicMspError.Add Patch.PatchCode,sLocalMsp
End If
End If 'fTrySource
'Log the result
sTmp = vbTab&sRepair&sLocalMsp&"' - '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")
Log sTmp
LogSummary Product,sTmp
End If 'NOT oFso.FileExists
End If 'Not sLocalMsp = ""
If NOT fReLoop Then EnsurePatchMetadata Patch,USERSID_NULL
Next 'Patch
Else
sTmp = vbTab&"Error: PatchesEx API failed with error " & err.number & " - " & err.Description
Log sTmp
LogSummary Product,sTmp &" (Module RepairCache)"
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If 'Err = 0
If NOT fReLoop Then Exit For
Next 'iReLoop
Next 'Prod
'In case that a global patch entry exists which is no longer linked to any product this is not covered
'in the logic above and requires this special handler
sGlobalPatchesKey = REG_GLOBALCONFIG & "S-1-5-18\Patches\"
sClassesPatchesKey = "Installer\Patches\"
If RegEnumKey(HKLM,sGlobalPatchesKey,arrKeys) Then
For Each sKey in arrKeys
Patch = GetExpandedGuid(sKey)
If NOT dicMspChecked.Exists(Patch) Then
'Only care if it's impacting known patches from the repair dictionary
If dicRepair.Exists(sKey) Then
'Flag to reconcile the registration to allow a clean transaction
If Not dicMspUnreg.Exists(sKey) Then dicMspUnreg.Add sKey,sKey
End If 'dicRepair.Exists
End If
Next 'sKey
End If 'RegEnumKey sGlobalPatchesKey
If RegEnumKey(HKCR,sClassesPatchesKey,arrKeys) Then
For Each sKey in arrKeys
Patch = GetExpandedGuid(sKey)
If NOT dicMspChecked.Exists(Patch) Then
'Only care if it's impacting known patches from the repair dictionary
If dicRepair.Exists(sKey) Then
'Flag to reconcile the registration to allow a clean transaction
If Not dicMspUnreg.Exists(sKey) Then dicMspUnreg.Add sKey,sKey
End If 'dicRepair.Exists
End If
Next 'sKey
End If 'RegEnumKey sClassesPatchesKey
If dicMspUnreg.Count > 0 Then
For Each sKey in dicMspUnreg.Keys
RegDeleteKey HKLM,sGlobalPatchesKey & sKey & "\"
RegDeleteKey HKCR,sClassesPatchesKey & sKey & "\"
Next 'sKey
End If 'dicMspUnreg > 0
Err.Clear
Set PatchList = oMsi.PatchesEx("",USERSID_NULL,MSIINSTALLCONTEXT_MACHINE,MSIPATCHSTATE_APPLIED + MSIPATCHSTATE_SUPERSEDED + MSIPATCHSTATE_OBSOLETED)
If Err = 0 Then
For Each Patch in PatchList
'Only care if it's not a patch with known issues
If NOT dicMspChecked.Exists(Patch.PatchCode) Then
Err.Clear
sLocalMsp = "" : sRepair = "" : fTrySource = False : fRepaired = False
sLocalMsp = LCase(Patch.PatchProperty("LocalPackage"))
If Not Err = 0 Then
Err.Clear
'This happens if a patch is registered but the global patch registration has gone missing.
'To work around this a correction entry is created
sTmp = vbTab&"Error: Failed to obtain local patch package data for patch '"&Patch.PatchCode&"'. Fixing patch registration."
If fDetectOnly Then sTmp = vbTab&"Error: Failed to obtain local patch package data for patch '"&Patch.PatchCode&"'. Patch registration would be fixed."
Log sTmp
LogSummary "",sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT fDetectOnly Then
FixMspGlobalReg Patch.PatchCode
sLocalMsp = LCase(Patch.PatchProperty("LocalPackage"))
End If
End If
If NOT sLocalMsp = "" Then
If oFso.FileExists(sLocalMsp) Then
Log vbTab&"Success: Confirmed local patch package as '"&sLocalMsp&"'"&vbTab&"for patch '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")&"'."
Else
'Try to restore from available resources
sRepair = "Error: Local .msp package missing. Attempt failed to restore '"
sKey = ""
sKey = Patch.PatchCode
If dicRepair.Exists(sKey) Then
If NOT fDetectOnly Then oFso.CopyFile dicRepair.Item(sKey),sLocalMsp
If oFso.FileExists(sLocalMsp) Then sRepair = "Restored: Successfully connected to 'RestoreLocation' ("&dicRepair.Item(sKey)&") to restore local .msp package '" Else fTrySource = True
'Handle 'DetectOnly' exception
If fDetectOnly Then
sRepair = "Note: Restore is possible from 'RestoreLocation' ("&dicRepair.Item(sKey)&") to restore local .msp package "
fTrySource = False
If NOT dicMspError.Exists(Patch.PatchCode) Then dicMspError.Add Patch.PatchCode,sLocalMsp
End If 'fDetectOnly
Else
fTrySource = True
End If
'Try to restore from resgistered sources
If fTrySource Then
'Get the sources
sPackage = Patch.SourceListInfo("PackageName")
Set MspSources = Patch.Sources(1)
For Each Source in MspSources
If fRepaired Then Exit For
sFile = Source&sPackage
If oFso.FileExists(sFile) Then
sSourceKey = ""
sSourceKey = oMsi.SummaryInformation(sFile,MSIOPENDATABASEMODE_READONLY).Property(PID_REVNUMBER)
If sKey = sSourceKey Then
If NOT dicRepair.Exists(sSourceKey) Then dicRepair.Add sSourceKey,sFile
If NOT fDetectOnly Then oFso.CopyFile sFile,sLocalMsp
fRepaired = oFso.FileExists(sLocalMsp)
If fDetectOnly Then
sRepair = "Note: Restore is possible from 'registered InstallSource' ("&sFile&") to restore local .msp package "
If NOT dicMspError.Exists(Patch.PatchCode) Then dicMspError.Add Patch.PatchCode,sLocalMsp
End If
End If 'sKey = sSourceKey
End If
Next 'Source
If fRepaired Then
sRepair = "Restored: Successfully connected to 'registered InstallSource' ("&sFile&") to restore local .msp package "
Else
If NOT dicMspError.Exists(Patch.PatchCode) Then dicMspError.Add Patch.PatchCode,sLocalMsp
'MspReconcile logic is not designed to handle this special case.
'Unregister is called straight away if MspReconcile is scheduled to run
If NOT fDetectOnly AND fReconcileCache Then UnregisterPatch Patch
End If
End If 'fTrySource
'Log the result
sTmp = vbTab&sRepair&sLocalMsp&"' - '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")
Log sTmp
LogSummary "",sTmp
End If 'NOT oFso.FileExists
End If 'Not sLocalMsp = ""
End If 'NOT dicMspError.Exists
Next 'Patch
Else
sTmp = vbTab&"Error: PatchesEx API failed with error " & err.number & " - " & err.Description
Log sTmp
LogSummary "",sTmp &" (Module RepairCache)"
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If 'Err = 0
End Sub 'RepairCache
'=======================================================================================================
'Unregister .msp files that have gone missing from the '%windir%\installer' folder
Sub MspReconcile
Const MAX_ATTEMPT = 100
Dim Prod,Product,Patch,PatchList,ProductsList
Dim sLocalMsp,sLocalMsi
Dim iCnt
Dim fResume,fMspOk
Dim dicMspUnregister
On Error Resume Next
Set dicMspUnregister = CreateObject("Scripting.Dictionary")
sTmp = "Running Module - Msp Reconcile"
Log vbCrLf&vbCrLf&sTmp&vbCrLf& String(Len(sTmp),"-")
If fCscript Then wscript.echo "Scanning for broken patches"
iCnt = 0
'Main detection loop
Set ProductsList = oMsi.ProductsEx("","",MSIINSTALLCONTEXT_MACHINE)
For Each Prod in ProductsList
Product = Prod.ProductCode
If IsOfficeProduct (Product) Then
Log vbCrLf&"Product: "&Product&" - "&oMsi.ProductInfo(Product,"ProductName")
If fCscript Then wscript.echo vbTab&"Scan "&Product&" - "&oMsi.ProductInfo(Product,"ProductName")
If NOT fRepairCache Then
'Check local .msi package
sLocalMsi = ""
sLocalMsi = oMsi.ProductInfo(Product,"LocalPackage")
If oFso.FileExists(sLocalMsi) Then
Log vbTab&"Success: Local .msi package " &sLocalMsi & " is available."
Else
If sLocalMsi = "" Then
sTmp = vbTab&"Error: No local .msi package registered."
Log sTmp
Else
sTmp = vbTab&"Error: Local .msi package " &sLocalMsi & " is missing."
Log sTmp
End If
LogSummary Product,sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If
End If 'NOT fRepairCache
'Get the list of patches for the product
fResume = True
fMspOk = True
Do While fResume
Err.Clear
fResume = False
Set PatchList = oMsi.PatchesEx(Product,USERSID_NULL,MSIINSTALLCONTEXT_MACHINE,MSIPATCHSTATE_ALL)
If Err = 0 Then
For Each Patch in PatchList
Err.Clear
sLocalMsp = "" : sLocalMsp = LCase(Patch.PatchProperty("LocalPackage"))
If Not Err = 0 Then
fMspOk = False
Err.Clear
If NOT dicMspUnregister.Exists(Patch.PatchCode) Then
sTmp = vbTab&"Error: Failed to obtain local patch package data for patch '"&Patch.PatchCode&"'"
Log sTmp
LogSummary Product,sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If
End If 'Err = 0
If NOT oFso.FileExists(sLocalMsp) Then
sTmp = vbTab&"Error: Local patch package '"&sLocalMsp&"' missing for patch '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")&"'. Unregistering patch …"
If fDetectOnly Then sTmp = vbTab&"Error: Local patch package '"&sLocalMsp&"' missing for patch '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")&"'. This patch would need to be unregistered!"
Log sTmp
LogSummary Product,sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
'Call patch unregister routine
If NOT dicMspUnregister.Exists(Patch.PatchCode) Then dicMspUnregister.Add Patch.PatchCode,Patch.PatchCode
iCnt = iCnt + 1
If iCnt < MAX_ATTEMPT Then fResume = True
If NOT fDetectOnly Then UnregisterPatch Patch
'Refresh PatchesEx object and resume
If NOT fDetectOnly Then Exit For
'Reset flag for detect only case
fResume = False
fMspOk = False
Else
If NOT fRepairCache Then Log vbTab&"Success: Confirmed local patch package as '"&sLocalMsp&"'"&vbTab&"for patch '"&Patch.PatchCode&"' - '"&Patch.PatchProperty("DisplayName")&"'."
End If
Next 'Patch
If fMspOk Then Log vbTab&"Success: No locally cached .msp packages are missing."
Else
sTmp = vbTab&"Error: PatchesEx API failed with error " & err.number & " - " & err.Description
Log sTmp
LogSummary Product,sTmp &" (Module MspReconcile)"
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If 'Err = 0
Loop
End If 'IsOfficeProduct
Next 'Product
End Sub 'MspReconcile
'=======================================================================================================
'Run patch detection to apply missing & applicable patches
'Default is to search for patches in
'A) provided SUpdateLocation folders
'B) current directory from which script is called
'C) %windir%\installer\
Sub ApplyPatches
Dim Product,Patch,Key
Dim sPatches,sReturn
Dim iIndex
On Error Resume Next
If fApplyPatch Then sTmp = "Running ApplyPatch" Else sTmp = "Running ApplyPatch for SUpdateLocation folder "
If fViewPatch Then sTmp = "Running applicable patch detection"
Log vbCrLf&vbCrLf&sTmp &vbCrLf& String(Len(sTmp),"-")
If fCscript Then wscript.echo "Running applicable patch detection"
sPatches = ""
'Init the dictionary objects
Set dicMspNoSeq = CreateObject("Scripting.Dictionary")
Set dicMspMinor = CreateObject("Scripting.Dictionary")
Set dicMspSmall = CreateObject("Scripting.Dictionary")
Set dicMspObsoleted = CreateObject("Scripting.Dictionary")
Set dicMspSequence = CreateObject("Scripting.Dictionary")
'Get the patch references from all locations
'This calls into the patch details routine as well
CollectSUpdates
Log "Debug: Found " & UBound(arrSUpdatesAll)+1 & " unique patch(es) in total." & vbCrLf
If fCscript Then wscript.echo vbTab&"Found " & UBound(arrSUpdatesAll)+1 & " unique patch(es) in total."
'Loop all products (filter on Office products) and call the pre-sequencer
For Each Product in oMsi.Products
If IsOfficeProduct(Product) Then
Log vbCrLf&"Product: "&Product&" - "&oMsi.ProductInfo(Product,"ProductName") & ", Build: " & oMsi.ProductInfo(Product,"VersionString")
If fCscript Then wscript.echo vbCrLf & vbTab&"Scan "&Product&" - "&oMsi.ProductInfo(Product,"ProductName") & ", Build: " & oMsi.ProductInfo(Product,"VersionString")
'Ensure empty dics
dicMspNoSeq.RemoveAll
dicMspMinor.RemoveAll
dicMspSmall.RemoveAll
dicMspObsoleted.RemoveAll
dicMspSequence.RemoveAll
'Ensure empty value(s)
sProductVersionReal = ""
'Fill the dictionary objects with a raw list of applicable patches
GetRawBuckets Product
'Sequence the MinorUpdate bucket first to ensure we get the correct new build number
SequenceMspMinor Product
'Sequence the 2.x NoSequence bucket
SequenceMspNoSeq Product
'Sequence the SmallUpdate bucket
SequenceMspSmall Product
Log vbTab&"Debug: 2.x style patches bucket contains "&dicMspNoSeq.Count&" patch(es) after sequencing."
Log vbTab&"Debug: Minor Update (service pack) bucket contains "&dicMspMinor.Count&" patch(es) after sequencing."
Log vbTab&"Debug: Small Patches bucket contains "&dicMspSmall.Count&" patch(es) after sequencing."
If NOT fViewPatch Then
'Invoke msiexec to apply the list of identified patches
'Execute baseline bucket (minor update aka service pack)
sPatches = ""
For Each Key in dicMspMinor.Keys
iIndex = dicMspMinor.Item(Key)
sPatches = sPatches&";"&arrSUpdatesAll(dicMspMinor.Item(Key),COL_FILENAME)
Next 'Key
If Len(sPatches)>0 Then sReturn = ApplyPatch(Product,sPatches)
'Execute the 2.x and small patches bucket
sPatches = ""
For Each Key in dicMspNoSeq.Keys
iIndex = dicMspNoSeq.Item(Key)
sPatches = sPatches&";"&arrSUpdatesAll(iIndex,COL_FILENAME)
Next 'Key
If Len(sPatches)>0 Then sReturn = ApplyPatch(Product,sPatches)
For Each Key in dicMspSmall.Keys
iIndex = dicMspSmall.Item(Key)
sPatches = sPatches&";"&arrSUpdatesAll(dicMspSmall.Item(Key),COL_FILENAME)
Next 'Key
If Len(sPatches)>0 Then sReturn = ApplyPatch(Product,sPatches)
Else
End If 'fViewPatch
End If 'IsOfficeProduct
Next 'Product
End Sub 'ApplyPatches
'=======================================================================================================
'The arrUpdateLocations array is sorted and validated by now
'It cannot be empty since it does at least contain the current directory.
'As local folders are already sorted to the start of the array this will
'ensure that local .msp files are favored over network patches.
'Purpose if this routine is to have a reference and all metadata of
'available .msp files.
'This will be used as base to pre-sequence the applicable patches.
Sub CollectSUpdates
Dim File,Folder,SumInfo
Dim sKey,sPatchTargets,sFilter
Dim i,iCnt
On Error Resume Next
Set dicSUpdatesAll = CreateObject("Scripting.Dictionary")
'If NOT sApplyPatch = "" Then CheckPatchExtract
CheckPatchExtract
iCnt = 0
'Collect a reference list of all patches
For Each Folder in arrUpdateLocations
If fCscript Then wscript.echo vbTab&"Collect files from "&Folder
For Each File in oFso.GetFolder(Folder).Files
If LCase(Right(File.Name,4)) = ".msp" Then
If LCase(File.Path)=LCase(sApplyPatch) OR sApplyPatch = "" OR (LCase(oFso.GetFolder(Folder).Path)&"\" = LCase(sWICacheDir)) Then
Set SumInfo = Nothing
Set SumInfo = oMsi.SummaryInformation(File.Path,MSIOPENDATABASEMODE_READONLY)
sKey = "" : sPatchTargets = ""
sKey = SumInfo.Property(PID_REVNUMBER)
sPatchTargets = SumInfo.Property(PID_TEMPLATE)
If Not dicSUpdatesAll.Exists(sKey) Then
'Found new patch
If IsOfficePatch(sPatchTargets) Then
dicSUpdatesAll.Add sKey,File.Path
Else
If NOT LCase(oFso.GetFolder(Folder).Path)&"\" = LCase(sWICacheDir) Then
sTmp = "Not an Office patch. Excluding patch "&File.Path&" from detection sequence."
Log vbTab&"Debug: "&sTmp
End If
End If
Else
If NOT Left(File.Path,Len(sWICacheDir)) = sWICacheDir Then
sTmp = "Excluding patch "&File.Path&" from detection sequence as duplicate of " & dicSUpdatesAll.Item(sKey)
Log vbTab&"Debug: "&sTmp
LogSummary "Note:",vbTab&sTmp
End If
End If 'dicSUpdatesAll.Exists
End If
End If '.msp
Next 'File
Log "Debug: Found " & dicSUpdatesAll.Count - iCnt & " unique patch(es) in folder " & Folder
If fCscript Then wscript.echo vbTab&"Found " & dicSUpdatesAll.Count - iCnt & " unique patch(es) in folder " & Folder
iCnt = dicSUpdatesAll.Count
Next 'Folder
If dicSUpdatesAll.Count = 0 Then Exit Sub
'Initialize the patch details array
ReDim arrSUpdatesAll(dicSupdatesAll.Count-1,COL_MAX)
'Collect all patch details
i = 0
If fCscript Then wscript.echo vbTab&"Obtaining patch details for identified patches"
For Each key in dicSUpdatesAll.Keys
AddPatchDetails dicSUpdatesAll.Item(key),i
i=i+1
Next 'key
fUpdatesCollected = True
End Sub 'CollectSUpdate
'=======================================================================================================
Sub AddPatchDetails(sMspPath,iIndex)
Dim SumInfo,Msp,Record
Dim sSiTmp,sChar,sTitle
Dim i,iSiCnt
Dim qView
Dim arrTitle,arrSi
On Error Resume Next
'Defaults
'——-
Set Record = Nothing
arrSUpdatesAll(iIndex,COL_APPLIEDCNT) = ""
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = ""
arrSUpdatesAll(iIndex,COL_APPLICABLECNT) = ""
arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT) = ""
'SummaryInformation
'——————
Set SumInfo = oMsi.SummaryInformation(sMspPath,0)
arrSUpdatesAll(iIndex,COL_FILENAME) = sMspPath 'Msp FileName
arrSUpdatesAll(iIndex,COL_TARGETS) = SumInfo.Property(PID_TEMPLATE) 'PatchTargets
arrSUpdatesAll(iIndex,COL_PATCHCODE) = SumInfo.Property(PID_REVNUMBER) 'PatchCode
If Len(arrSUpdatesAll(iIndex,COL_PATCHCODE))>LEN_GUID Then
arrSUpdatesAll(iIndex,COL_SUPERSEDES)=Mid(arrSUpdatesAll(iIndex,COL_PATCHCODE),LEN_GUID+1)
arrSUpdatesAll(iIndex,COL_PATCHCODE)=Left(arrSUpdatesAll(iIndex,COL_PATCHCODE),LEN_GUID)
End If
'PatchXml
'——-
arrSUpdatesAll(iIndex,COL_PATCHXML) = oMsi.ExtractPatchXMLData(arrSUpdatesAll(iIndex,COL_FILENAME))
'Other
'—-
arrSUpdatesAll(iIndex,COL_REFCNT) = 0
'Patch tables
'————
Set Msp = oMsi.OpenDatabase(sMspPath,MSIOPENDATABASEMODE_PATCHFILE)
If Not Err = 0 Then
'An error at this points indicates a severe issue
sTmp = "Failed to read data from .msp package "&sMspPath
Log vbTab&"Debug: "&sTmp
LogSummary "Error:",vbTab&sTmp
Exit Sub
End If
arrSUpdatesAll(iIndex,COL_PATCHTABLES) = GetDatabaseTables(Msp)
If InStr(arrSUpdatesAll(iIndex,COL_PATCHTABLES),"MsiPatchMetadata")>0 Then
'KB
Set qView = Msp.OpenView("SELECT `Property`,`Value` FROM MsiPatchMetadata WHERE `Property`='KBArticle Number'")
qView.Execute : Set Record = qView.Fetch()
If Not Record Is Nothing Then
arrSUpdatesAll(iIndex,COL_KB) = UCase(Record.StringData(2))
arrSUpdatesAll(iIndex,COL_KB) = Replace(arrSUpdatesAll(iIndex,COL_KB),"KB","")
Else
arrSUpdatesAll(iIndex,COL_KB) = ""
End If
qView.Close
'StdPackageName
Set qView = Msp.OpenView("SELECT `Property`,`Value` FROM MsiPatchMetadata WHERE `Property`='StdPackageName'")
qView.Execute : Set Record = qView.Fetch()
If Not Record Is Nothing Then
arrSUpdatesAll(iIndex,COL_PACKAGE) = Record.StringData(2)
Else
arrSUpdatesAll(iIndex,COL_PACKAGE) = ""
End If
qView.Close
'Release (required for SP uninstall)
Set qView = Msp.OpenView("SELECT `Property`,`Value` FROM MsiPatchMetadata WHERE `Property`='Release'")
qView.Execute : Set Record = qView.Fetch()
If Not Record Is Nothing Then
arrSUpdatesAll(iIndex,COL_RELEASE) = Record.StringData(2)
Else
arrSUpdatesAll(iIndex,COL_RELEASE) = ""
End If
qView.Close
Else
arrSUpdatesAll(iIndex,COL_KB) = ""
arrSUpdatesAll(iIndex,COL_PACKAGE) = ""
arrSUpdatesAll(iIndex,COL_RELEASE) = ""
End If
If arrSUpdatesAll(iIndex,COL_KB) = "" Then
'Scan the SummaryInformation data for the KB
For iSiCnt = 1 To 2
Select Case iSiCnt
Case 1
arrSi = Split(SumInfo.Property(PID_SUBJECT),";")
Case 2
arrSi = Split(SumInfo.Property(PID_TITLE),";")
End Select
If IsArray(arrSi) Then
For Each sTitle in arrSi
sSiTmp = ""
sSiTmp = Replace(UCase(sTitle)," ","")
If InStr(sSiTmp,"KB")>0 Then
'Strip the KB
sSiTmp = Mid(sSiTmp,InStr(sSiTmp,"KB")+2)
For i = 1 To Len(sSiTmp)
sChar = ""
sChar = Mid(sSiTmp,i,1)
If (Asc(sChar) >= 48 AND Asc(sChar) <= 57) Then arrSUpdatesAll(iIndex,COL_KB)=arrSUpdatesAll(iIndex,COL_KB)&sChar
Next 'i
'Ensure a valid length
If Len(arrSUpdatesAll(iIndex,COL_KB))<5 Then arrSUpdatesAll(iIndex,COL_KB)="" Else Exit For
End If
Next
If Len(arrSUpdatesAll(iIndex,COL_KB))>4 Then Exit For
End If 'IsArray(arrSi)
Next 'iSiCnt
End If
'PatchSequence & PatchFamily
If InStr(arrSUpdatesAll(iIndex,COL_PATCHTABLES),"MsiPatchSequence")>0 Then
Set qView = Msp.OpenView("SELECT `PatchFamily`,`Sequence` FROM MsiPatchSequence")
qView.Execute : Set Record = qView.Fetch()
If Not Record Is Nothing Then
Do Until Record Is Nothing
arrSUpdatesAll(iIndex,COL_FAMILY) = arrSUpdatesAll(iIndex,COL_FAMILY)&";"&Record.StringData(1)
arrSUpdatesAll(iIndex,COL_SEQUENCE) = arrSUpdatesAll(iIndex,COL_SEQUENCE)&";"&Record.StringData(2)
Set Record = qView.Fetch()
Loop
arrSUpdatesAll(iIndex,COL_FAMILY) = Mid(arrSUpdatesAll(iIndex,COL_FAMILY),2)
arrSUpdatesAll(iIndex,COL_SEQUENCE) = Mid(arrSUpdatesAll(iIndex,COL_SEQUENCE),2)
Else
arrSUpdatesAll(iIndex,COL_FAMILY) = ""
arrSUpdatesAll(iIndex,COL_SEQUENCE) = "0"
End If
qView.Close
Else
arrSUpdatesAll(iIndex,COL_FAMILY) = ""
arrSUpdatesAll(iIndex,COL_SEQUENCE) = "0"
End If
arrTitle = Split(SumInfo.Property(PID_TITLE),";")
If UBound(arrTitle)>0 Then
If arrSUpdatesAll(iIndex,COL_FAMILY)="" Then arrSUpdatesAll(iIndex,COL_FAMILY) = arrTitle(1)
If arrSUpdatesAll(iIndex,COL_PACKAGE)= "" Then arrSUpdatesAll(iIndex,COL_PACKAGE) = arrTitle(1)
End If
'Exception handler for OCT patches
If arrSUpdatesAll(iIndex,COL_FAMILY) = "SetupCustomizationFile" Then
arrSUpdatesAll(iIndex,COL_KB) = "n/a (SetupCustomizationFile)"
arrSUpdatesAll(iIndex,COL_PACKAGE) = "OCT"
If IsBaselineRequired("",arrSUpdatesAll(iIndex,COL_PATCHXML)) Then _
LogSummary "Important Note:",sMspPath&" is a customization patch based on the original release of the OCT. A more recent OCT version is available from http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=73d955c0-da87-4bc2-bbf6-260e700519a8″"
End If
End Sub 'AddPatchDetails
'=======================================================================================================
'This function parses all available patches and
'fills the unsequenced buckets for the given Product(Code)
'Already Installed patches are excluded here
Sub GetRawBuckets(sProductCode)
Dim PatchList,Patch
Dim sAppliedPatches,sApplicablePatches,sProductVersion,sDetectedVersion
Dim iBucket,iIndex
Dim fSkipRealDetection, fIsWICached
On Error Resume Next
'Get installed patches
'———————
Set PatchList = oMsi.PatchesEx(sProductCode,USERSID_NULL,MSIINSTALLCONTEXT_MACHINE,MSIPATCHSTATE_ALL)
sAppliedPatches = ""
For Each Patch in PatchList
sAppliedPatches = sAppliedPatches & ";" & Patch.PatchCode
Next 'Patch
fSkipRealDetection = False
If Not Err=0 Then fSkipRealDetection = True
'Sort the patches based on their bucket
For iIndex = 0 To UBound(arrSUpdatesAll)
'Honor the fExcludeCache and fIncludeOctCache flag
fIsWICached = False
If Len(arrSUpdatesAll(iIndex,COL_FILENAME)) > Len(sWICacheDir) Then
fIsWICached = (LCase(Left(arrSUpdatesAll(iIndex,COL_FILENAME),Len(sWICacheDir))) = LCase(sWICacheDir))
End If
If ( (NOT fExcludeCache) OR (NOT fIsWICached) ) AND _
NOT ( (arrSUpdatesAll(iIndex,COL_FAMILY)="SetupCustomizationFile") AND (fIsWICached) AND (NOT fIncludeOctCache) ) Then
'Exclude patches that do
' - not target the product
' - are already applied
If (InStr(arrSUpdatesAll(iIndex,COL_TARGETS),sProductCode)>0) Then
'Update reference counter
arrSUpdatesAll(iIndex,COL_REFCNT) = arrSUpdatesAll(iIndex,COL_REFCNT)+1
If (NOT InStr(sAppliedPatches,arrSUpdatesAll(iIndex,COL_PATCHCODE))>0) Then
'Patch targets the current product and is not applied
Select Case GetMspBucket(sProductCode,iIndex)
Case MSP_NOSEQ
dicMspNoSeq.Add arrSUpdatesAll(iIndex,COL_PATCHCODE),iIndex
Case MSP_MINOR
dicMspMinor.Add arrSUpdatesAll(iIndex,COL_PATCHCODE),iIndex
Case MSP_SMALL
dicMspSmall.Add arrSUpdatesAll(iIndex,COL_PATCHCODE),iIndex
Case Else
End Select
Else
If NOT fIsWICached Then
'Update reference counter
arrSUpdatesAll(iIndex,COL_APPLIEDCNT) = arrSUpdatesAll(iIndex,COL_APPLIEDCNT)&sProductCode&";"
sTmp = "Patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" is already installed for this product."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
End If
End If
Else
If NOT fIsWICached Then
sTmp = "Patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" ("&arrSUpdatesAll(iIndex,COL_FILENAME)&") does not target this product."
Log vbTab&"Debug: "&sTmp
End If
End If
Else
If fExcludeCache Then sTmp="ExcludeCache=True" Else sTmp="IncludeOctCache=False"
If (InStr(arrSUpdatesAll(iIndex,COL_TARGETS),sProductCode)>0) Then _
Log vbTab&"Debug: Excluding patch per '"&sTmp&"' filter. "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_KB)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
End If 'fExcludeCache
Next 'iIndex
'Validate integrity of the registered ProductVersion (build) as the sequencing
'logic relies on the correctness of this value.
If NOT fSkipRealDetection Then
sProductVersion = oMsi.ProductInfo(sProductCode,"VersionString")
sDetectedVersion = GetRealBuildVersion(sAppliedPatches,sProductCode)
If NOT sProductVersion = sDetectedVersion Then
sTmp = vbTab&"Error: Registered build version does not match detected build version. Registered build: "&sProductVersion&". Detected build: "&sDetectedVersion
If fDetectOnly Then
sTmp = sTmp & ". Registered build would be corrected to "&sDetectedVersion
Else
sTmp = sTmp & ". Updated registered build to new value "&sDetectedVersion
UpdateProductVersion sProductCode,sDetectedVersion
End If
Log sTmp
LogSummary sProductCode,sTmp
End If
End If
End Sub 'GetRawBuckets
'=======================================================================================================
Function GetMspBucket(sProductCode,iIndex)
On Error Resume Next
'Defaults
GetMspBucket = MSP_NOSEQ 'Default to 2.x NoSequence bucket
'Check if it's a 3.x type patch which has sequence information
If arrSUpdatesAll(iIndex,COL_SEQUENCE) = "0" Then
'This is a 2.x patch. Only continue if it's a service pack
If NOT IsMinorUpdate(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML)) Then Exit Function
End If
'Check if it's a "Minor Upgrade" aka "Service Pack" vs. as "Small Update"
If IsMinorUpdate(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML)) Then GetMspBucket = MSP_MINOR Else GetMspBucket = MSP_SMALL
End Function 'GetMspBucket
'=======================================================================================================
'Sequence the Minor Update (service pack) bucket
'The logic relies on the Office specific assumption that a service pack:
'- is cumulative
'- always uses "Equals" as baseline verification
Sub SequenceMspMinor(sProductCode)
Dim Key,Patch,Sequences,Seq
Dim sProductVersion,sProductVersionMax,sMspApplicable,sFamily,sSeq,sErr
Dim iCntBld,iCntMsp,iIndex
Dim fSeqFound,fHihgerBaselineExists
Dim arrMspUpdatedVersions,arrMspSuperseded,dicMspUpdatedVersion,arrErr
On Error Resume Next
fSeqFound = False
sMspApplicable = ""
Set dicMspUpdatedVersion = CreateObject("Scripting.Dictionary")
'Get the current product build
sProductVersion = sProductVersionReal
sProductVersionNew = sProductVersion
'Get the updated build versions. Sorted descending
'This call will already filter out superseded patches
arrMspUpdatedVersions = GetMspUpdatedVersion(sProductCode,dicMspUpdatedVersion)
'Check if there's an updated version available
fHihgerBaselineExists = (UBound(arrMspUpdatedVersions)> -1)
'Iterate the patches if we have a higher baseline than the current
If fHihgerBaselineExists Then
sProductVersionMax =arrMspUpdatedVersions(0)
'Find applicable patch sequence
For iCntBld = 0 To UBound(arrMspUpdatedVersions)
For Each Key in dicMspMinor.Keys
iIndex = dicMspMinor.Item(Key)
If IsValidVersion(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML),sProductVersionNew,sErr) Then
'Found new baseline. Add patch as applicable
'Remember new baseline
sProductVersionNew = dicMspUpdatedVersion.Item(iIndex)
fHihgerBaselineExists = (sProductVersionMax>sProductVersionNew)
arrErr = Split(sErr,";",2)
'Update reference counter
arrSUpdatesAll(iIndex,COL_APPLICABLECNT) = arrSUpdatesAll(iIndex,COL_APPLICABLECNT)&sProductCode&";"
sTmp = "Found applicable service pack patch to update build from "&arrErr(1)&" to build "&sProductVersionNew&" : KB "&arrSUpdatesAll(iIndex,COL_KB)& _
", "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
sMspApplicable = sMspApplicable&";"&Key
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
Exit For
End If
Next 'Key
If NOT fHihgerBaselineExists Then Exit For
Next 'iCntBld
End If 'fHihgerBaselineExists
For Each Key in dicMspMinor.Keys
If NOT InStr(sMspApplicable,Key)>0 Then
'patch excluded because higher baseline has been found
iIndex = dicMspMinor.Item(Key)
'Update reference counter
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT)&sProductCode&";"
sTmp = "Excluding patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" because it's superseded by a scheduled service pack installation."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
If dicMspMinor.Exists(Key) Then dicMspMinor.Remove Key
Log vbTab&"Debug: "&sTmp
If (NOT Left(arrSUpdatesAll(iIndex,COL_FILENAME),Len(sWICacheDir)) = sWICacheDir) Then LogSummary sProductCode,vbTab&sTmp
End If
Next 'Key
'Add patch family sequence data if available
For Each Key in dicMspMinor.Keys
iIndex = dicMspMinor.Item(Key)
AddSequenceData arrSUpdatesAll(iIndex,COL_PATCHXML)
Next 'Key
'Add obsoletion data
For Each Key in dicMspMinor.Keys
Set arrMspSuperseded = Nothing
iIndex = dicMspMinor.Item(Key)
arrMspSuperseded = Split(arrSUpdatesAll(iIndex,COL_SUPERSEDES),";")
For Each Patch in arrMspSuperseded
If NOT dicMspObsoleted.Exists(Patch) Then dicMspObsoleted.Add Patch,Patch
Next 'Patch
Next 'Key
End Sub 'SequenceMspMinor
'=======================================================================================================
'Sequence the bucket with 2.x NoSequence patches
'Superseded (obsoleted) patches are filtered out
Sub SequenceMspNoSeq(sProductCode)
Dim Key,Patch
Dim sErr
Dim iIndex
Dim arrMspSuperseded,arrErr
On Error Resume Next
'Build list of obsoleted patches
For Each Key in dicMspNoSeq.Keys
Set arrMspSuperseded = Nothing
iIndex = dicMspNoSeq.Item(Key)
arrMspSuperseded = Split(arrSUpdatesAll(iIndex,COL_SUPERSEDES),";")
For Each Patch in arrMspSuperseded
If NOT dicMspObsoleted.Exists(Patch) Then dicMspObsoleted.Add Patch,Patch
Next 'Patch
Next 'Key
For Each Key in dicMspNoSeq.Keys
iIndex = dicMspNoSeq.Item(Key)
'Remove patch if obsolete
If dicMspObsoleted.Exists(Key) Then
'Update reference counter
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT)&sProductCode&";"
If NOT Left(arrSUpdatesAll(iIndex,COL_FILENAME),Len(sWICacheDir)) = sWICacheDir Then
sTmp = "Patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" is obsoleted by an already installed patch."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&". "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
End If
If dicMspNoSeq.Exists(Key) Then dicMspNoSeq.Remove Key
End If
'Check if patch is applicable
If IsValidVersion(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML),sProductVersionNew,sErr) Then
arrErr = Split(sErr,";",2)
'Update reference counter
arrSUpdatesAll(iIndex,COL_APPLICABLECNT) = arrSUpdatesAll(iIndex,COL_APPLICABLECNT)&sProductCode&";"
sTmp = "Found applicable 2.x style patch: KB "&arrSUpdatesAll(iIndex,COL_KB)&", "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
vbCrLf&vbTab&vbTab&"Applicable baseline: " & arrErr(1)
Else
arrErr = Split(sErr,";",2)
'Update reference counter
arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT) = arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT)&sProductCode&";"
'Cache valid baselines
arrSUpdatesAll(iIndex,COL_PATCHBASELINES) = arrErr(1)
sTmp = "No valid baseline available for this 2.x style patch KB "&arrSUpdatesAll(iIndex,COL_KB)&"."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
vbCrLf&vbTab&vbTab&"Patch baseline(s): " & arrErr(1)& ". Installed baseline: " &sProductVersionNew
If dicMspNoSeq.Exists(Key) Then dicMspNoSeq.Remove Key
End If 'IsValidVersion
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
Next 'Key
End Sub 'SequenceMspNoSeq
'=======================================================================================================
Sub SequenceMspSmall(sProductCode)
Dim Key,Element,Elements
Dim sMspApplicable,sFamily,sSeq,sErr
Dim iIndex
Dim fApplicable
Dim arrErr
On Error Resume Next
sErr = ""
'Determine current patch family sequence
For Each Key in dicMspSmall.Keys
fApplicable = False
iIndex = dicMspSmall.Item(Key)
'Load baselines the patch can be applied to
'Exclude patches that do not target the current baseline
If IsValidVersion(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML),sProductVersionNew,sErr) Then
AddSequenceData(arrSUpdatesAll(iIndex,COL_PATCHXML))
Else
arrErr = Split(sErr,";",2)
If arrErr(0) = "1" Then
'Patch is superseded by the installed baseline (service pack)
'Update reference counter
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT)&sProductCode&";"
sTmp = "Patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" is superseded by an already installed service pack."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
vbCrLf&vbTab&vbTab&"Patch baseline(s): " & arrErr(1)& ". Installed baseline: " &sProductVersionNew
Else
'Patch excluded because it does not apply to the available baseline
'Cache valid baselines
arrSUpdatesAll(iIndex,COL_PATCHBASELINES) = arrErr(1)
'Update reference counter
arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT) = arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT)&sProductCode&";"
sTmp = "No valid baseline available for patch KB "&arrSUpdatesAll(iIndex,COL_KB)&"."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
vbCrLf&vbTab&vbTab&"Patch baseline(s): " & arrErr(1)& ". Installed baseline: " &sProductVersionNew
End If
Log vbTab&"Debug: "&sTmp
If (NOT Left(arrSUpdatesAll(iIndex,COL_FILENAME),Len(sWICacheDir)) = sWICacheDir) Then LogSummary sProductCode,vbTab&sTmp
If dicMspSmall.Exists(Key) Then dicMspSmall.Remove Key
End If
Next 'Key
'Determine applicable patches
For Each Key in dicMspSmall.Keys
fApplicable = False
iIndex = dicMspSmall.Item(Key)
XmlDoc.LoadXml(arrSUpdatesAll(iIndex,COL_PATCHXML))
Set Elements = XmlDoc.GetElementsByTagName("SequenceData")
For Each Element in Elements
sFamily="" : sSeq=""
sFamily = Element.selectSingleNode("PatchFamily").text
sSeq = Element.selectSingleNode("Sequence").text
sTmp = "Found applicable patch with sequence version "&sSeq&" : KB "&arrSUpdatesAll(iIndex,COL_KB)&", "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)
If dicMspSequence.Exists(sFamily) Then
If sSeq = dicMspSequence.Item(sFamily) Then
fApplicable = True
End If
Else
fApplicable = True
End If
Next 'Element
If NOT fApplicable Then
'patch excluded because higher family patch available
'Update reference counter
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT)&sProductCode&";"
sTmp = "Patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" is superseded by a later patch of the same family."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
vbCrLf&vbTab&vbTab&"Patch build: " & sSeq& ". Installed build: " &dicMspSequence.Item(sFamily)
If dicMspSmall.Exists(Key) Then dicMspSmall.Remove Key
Log vbTab&"Debug: "&sTmp
If (NOT Left(arrSUpdatesAll(iIndex,COL_FILENAME),Len(sWICacheDir)) = sWICacheDir) Then LogSummary sProductCode,vbTab&sTmp
Else
'Update reference counter
arrSUpdatesAll(iIndex,COL_APPLICABLECNT) = arrSUpdatesAll(iIndex,COL_APPLICABLECNT)&sProductCode&";"
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
End If
Next 'Key
End Sub 'SequenceMspSmall
'=======================================================================================================
'Return the updated version (build) of a minor update (service pack)
'sorted from highest to lowest
Function GetMspUpdatedVersion(sProductCode,dicMspUpdatedVersion)
Dim Key,Element,Elements
Dim sVersions,sProductVersion,sProductVersionMsi,sErr
Dim iIndex,iArrCnt
Dim arrVersions,arrErr,dicTmp
On Error Resume Next
Set dicTmp = CreateObject("Scripting.Dictionary")
'Get the current product build
sProductVersion = sProductVersionReal
sProductVersionMsi = ""
sProductVersionMsi = GetMsiProductVersion(oMsi.ProductInfo(sProductCode,"LocalPackage"))
If sProductVersionMsi = "" Then sProductVersionMsi = sProductVersionReal
'Identify the available updated build (UpdatedVersion)
sVersions = "" : sErr = ""
For Each Key in dicMspMinor.Keys
iIndex = dicMspMinor.Item(Key)
'Don't assume we have a valid RTM build. Beta products may break the logic!
XmlDoc.LoadXml(arrSUpdatesAll(iIndex,COL_PATCHXML))
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
If IsValidVersion(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML),sProductVersionMsi,sErr) Then
If Element.selectSingleNode("UpdatedVersion").text > sProductVersion Then
If NOT dicTmp.Exists(iIndex) Then
dicTmp.Add iIndex,Element.selectSingleNode("UpdatedVersion").text
sVersions = sVersions&";"&Element.selectSingleNode("UpdatedVersion").text
End If
Else
'patch excluded since not a higher baseline
'Update reference counter
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT)&sProductCode&";"
sTmp = "Service pack patch KB "&arrSUpdatesAll(iIndex,COL_KB)&" is superseded by an already installed service pack."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
vbCrLf&vbTab&vbTab&"Patch build: "&Element.selectSingleNode("UpdatedVersion").text&", Installed build: "&sProductVersion
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
If dicMspMinor.Exists(Key) Then dicMspMinor.Remove Key
End If 'UpdatedVersion
Else
'Not a RTM product
arrErr = Split(sErr,";",2)
sTmp = "No valid baseline available for service pack patch KB "&arrSUpdatesAll(iIndex,COL_KB)&". This may indicate a BETA ProductVersion."& _
" Patch details: "&arrSUpdatesAll(iIndex,COL_PATCHCODE)&", "&arrSUpdatesAll(iIndex,COL_PACKAGE)&", "&arrSUpdatesAll(iIndex,COL_FILENAME)& _
bCrLf&vbTab&vbTab&"Patch baseline(s): " & arrErr(1)& ". Installed baseline: " &sProductVersion
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
End If 'IsValidVersion
End If 'TargetProductCode
Next 'Element
Next 'Key
If sVersions = "" Then
Redim arrVersions(-1)
GetMspUpdatedVersion = arrVersions
Exit Function
End If
'Sort descending
arrVersions = BubbleSort(Split(Mid(sVersions,2),";"))
'Build the dictionary
For iArrCnt = 0 To UBound(arrVersions)
For Each Key in dicTmp.Keys
If dicTmp.Item(Key)=arrVersions(iArrCnt) AND NOT dicMspUpdatedVersion.Exists(Key) Then dicMspUpdatedVersion.Add Key,dicTmp.Item(Key)
Next 'Key
Next 'iArrCnt
'Return the sorted versions
GetMspUpdatedVersion = arrVersions
End Function 'GetMspUpdatedVersion
'=======================================================================================================
'Determine if a patch is applicable to the provided baseline
Function IsValidVersion(sProductCode,sXml,sProductVersion,sErr)
Dim Element,Elements,Node
Dim sCompType,sCompFlt,sVersion,sDelimiter,sTargets
Dim iCnt,iLoop,iRet
Dim fSuccess,fValidate
Dim arrLeftNum,arrRightNum
On Error Resume Next
sErr = "" : sTargets = ""
fValidate = True
sDelimiter = Delimiter(sProductVersion)
arrLeftNum = Split(sProductVersion,sDelimiter)
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
fSuccess = False
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
'Collect the compare details
sCompType = "" : sCompFlt = "" : sVersion = ""
Set Node = Element.selectSingleNode("TargetVersion")
sCompType = Node.getAttribute("ComparisonType")
sCompFlt = Node.getAttribute("ComparisonFilter")
sVersion = Node.text
sTargets = sTargets&";"&sVersion
fValidate = CBool(Node.getAttribute("Validate"))
Set arrRightNum = Nothing
arrRightNum = Split(sVersion,sDelimiter)
'Set the filter setting
Select Case sCompFlt
Case "None"
iLoop = -1
Case "Major"
iLoop = 0
Case "MajorMinor"
iLoop = 1
Case "MajorMinorUpdate"
iLoop = 2
Case Else
End Select
'Compare the version strings based on the filter
iRet = -2
For iCnt = 0 To iLoop
iRet = StrComp(arrLeftNum(iCnt),arrRightNum(iCnt))
If NOT iRet = 0 Then Exit For
Next 'iCnt
'Evaluate the compare result
Select Case sCompType
Case "LessThan"
fSuccess = (iRet = -1)
Case "LessThanOrEqual"
fSuccess = ((iRet = -1) OR (iRet = 0))
Case "Equal"
fSuccess = (iRet = 0)
Case "GreaterThanOrEqual"
fSuccess = ((iRet = 1) OR (iRet = 0))
Case "GreaterThan"
fSuccess = (iRet = 1)
Case "None"
fSuccess = True
Case Else
End Select
If NOT fValidate Then fSuccess = True
If fSuccess Then Exit For
End If
Next
If fSuccess Then sErr = iRet&";"&sVersion Else sErr = iRet&";"&Join(RemoveDuplicates(Split(Mid(sTargets,2),";")),";")
IsValidVersion = fSuccess
End Function 'IsValidVersion
'=======================================================================================================
'Return the tables of a given .msp file
Function GetDatabaseTables(MsiDb)
Dim ViewTables,Table
Dim sTables
On Error Resume Next
sTables = ""
Set Table = Nothing
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)
Loop
ViewTables.Close
If Len(sTables)>2 Then GetDatabaseTables=Mid(sTables,2)
End Function 'GetDatabaseTables
'=======================================================================================================
'Returns the possible build versions the patch will be compared against
Function MspBldTargets(sProductCode,sXml)
Dim Element,Elements,Node
Dim sBaselines
On Error Resume Next
sBaselines = ""
'Check baselines from XML
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
Set Node = Element.selectSingleNode("TargetVersion")
sBaselines = sBaselines & ";"&Node.text
End If
Next
If Len(sBaselines)>1 Then sBaselines = Mid(sBaselines,2)
MspBldTargets = sBaselines
End Function
'=======================================================================================================
'Returns all possible build versions the patch will be compared against
Function GetMspBldTargets(sXml)
Dim Element,Elements,Node
Dim sBaselines
On Error Resume Next
sBaselines = ""
'Check baselines from XML
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
Set Node = Element.selectSingleNode("TargetVersion")
If NOT InStr(sBaselines,Node.text) > 0 then
sBaselines = sBaselines & ";"&Node.text&GetSpLevel(Node.text)
End If
Next
If Len(sBaselines)>1 Then sBaselines = Mid(sBaselines,2)
If NOT IsBaselineRequired("",sXml) Then sBaselines = "Baselineless Patch"
GetMspBldTargets = Replace(sBaselines,";",vbCrLf)
End Function
'=======================================================================================================
'Returns the comparison term for the build version validation
Function GetComparisonType(sProductCode,sXml)
Dim Element,Elements,Node
On Error Resume Next
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
Set Node = Element.selectSingleNode("TargetVersion")
GetComparisonType = Node.getAttribute("ComparisonType")
Exit For
End If
Next
End Function 'GetComparisonType
'=======================================================================================================
'Determines from patch xml if patch requires baseline validation
Function IsBaselineRequired(sProductCode,sXml)
Dim Element,Elements,Node
On Error Resume Next
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
If sProductCode = "" Then sProductCode = Element.selectSingleNode("TargetProductCode").text
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
Set Node = Element.selectSingleNode("TargetVersion")
IsBaselineRequired = CBool(Node.getAttribute("Validate"))
Exit For
End If
Next
End Function 'IsBaselineRequired
'=======================================================================================================
'Determine if the patch is a minor update (service pack)
Function IsMinorUpdate(sProductCode,sXml)
Dim Element,Elements,Node,ChildNodes
On Error Resume Next
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
If sProductCode = "" Then sProductCode = Element.selectSingleNode("TargetProductCode").text
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
For Each Node in Element.ChildNodes
If Node.NodeName = "UpdatedVersion" Then
IsMinorUpdate = True
Exit Function
End If
Next 'Node
End If
Next 'Element
End Function 'IsMinorUpdate
'=======================================================================================================
'Add patch family sequence information to the dictionary
Sub AddSequenceData(sXml)
Dim Element,Elements
Dim sFamily,sSeq
On Error Resume Next
XmlDoc.LoadXml(sXml)
Set Elements = XmlDoc.GetElementsByTagName("SequenceData")
For Each Element in Elements
sFamily="" : sSeq=""
sFamily = Element.selectSingleNode("PatchFamily").text
sSeq = Element.selectSingleNode("Sequence").text
'Only add to the family sequence number if it's marked to supersede earlier
If Element.selectSingleNode("Attributes").text = "1" Then
If dicMspSequence.Exists(sFamily) Then
If sSeq > dicMspSequence.Item(Key) Then dicMspSequence.Item(sFamily)=sSeq
Else
dicMspSequence.Add sFamily,sSeq
End If
End If 'Attributes = 1
Next 'Element
End Sub 'AddSequenceData
'=======================================================================================================
'Detect and remove unreferenced .msp files from
'%windir%\installer folder
Sub WICleanOrphans
Dim File,Patch,AllPatches,Product,AllProducts,oRefFilesDic
Dim sLocalFile,sTargetFolder,sFileErr
Dim iFoo
Dim fFoundOrphan,fMspOK,fMsiOK
On Error Resume Next
sTmp = "Running CleanCache to remove unreferenced .msi, .msp files from " & sWICacheDir
Log vbCrLf&vbCrLf&sTmp &vbCrLf& String(Len(sTmp),"-")
If fCscript Then wscript.echo "Checking for unreferenced files in folder "& sWICacheDir
fFoundOrphan = False
fMspOK = True
fMsiOK = True
sTargetFolder = sTemp & "MovedCacheFiles\"
Err.Clear
Set oRefFilesDic = CreateObject("Scripting.Dictionary")
If Not Err = 0 Then Exit Sub
'Collect referenced .msp files
If fCscript Then wscript.echo vbTab&"Scanning .msp files"
For iFoo = 1 To 1
Set AllPatches = oMsi.PatchesEx("",USERSID_EVERYONE,MSIINSTALLCONTEXT_ALL,MSIPATCHSTATE_ALL)
If Not Err = 0 Then
sTmp = "Error: Failed to get a complete list of all .msp files. Aborting unreferenced .msp detection."
Log vbTab&sTmp
LogSummary "CleanCache",vbTab&sTmp
Log vbTab&" Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
"; Err# (Dec): " & Err & "; Description : " & Err.Description
If fCscript Then wscript.echo vbTab&sTmp
Err.Clear
fMspOK = False
Exit For
End If
For Each Patch in AllPatches
sLocalFile = ""
sLocalFile = LCase(Patch.Patchproperty("LocalPackage"))
If NOT oRefFilesDic.Exists(sLocalFile) Then oRefFilesDic.Add sLocalFile,sLocalFile
Next 'Patch
If Not Err = 0 Then
sTmp = "Error: Unhandled error. Aborting unreferenced .msp detection."
Log vbTab&sTmp
LogSummary "CleanCache",vbTab&sTmp
Log vbTab&" Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
"; Err# (Dec): " & Err & "; Description : " & Err.Description
If fCscript Then wscript.echo vbTab&sTmp
Err.Clear
fMspOK = False
Exit For
End If
Next 'iFoo
'Collect referenced .msi files
If fCscript Then wscript.echo vbTab&"Scanning .msi files"
For iFoo = 1 To 1
Set AllProducts = oMsi.ProductsEx("",USERSID_EVERYONE,MSIINSTALLCONTEXT_ALL)
If Not Err = 0 Then
sTmp = "Error: Failed to get a complete list of all .msi files. Aborting unreferenced .msi detection."
Log vbTab&sTmp
LogSummary "CleanCache",vbTab&sTmp
Log vbTab&" Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
"; Err# (Dec): " & Err & "; Description : " & Err.Description
If fCscript Then wscript.echo vbTab&sTmp
Err.Clear
fMsiOK = False
Exit For
End If
For Each Product in AllProducts
sLocalFile = ""
sLocalFile = LCase(Product.InstallProperty("LocalPackage"))
If NOT oRefFilesDic.Exists(sLocalFile) Then oRefFilesDic.Add sLocalFile,sLocalFile
Next 'Patch
If Not Err = 0 Then
sTmp = "Error: Unhandled error. Aborting unreferenced .msi detection."
Log vbTab&sTmp
LogSummary "CleanCache",vbTab&sTmp
Log vbTab&" Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
"; Err# (Dec): " & Err & "; Description : " & Err.Description
If fCscript Then wscript.echo vbTab&sTmp
Err.Clear
fMsiOK = False
Exit For
End If
Next 'iFoo
'Move unreferenced files
For Each File in oFso.GetFolder(sWICacheDir).Files
If Not Err = 0 Then
Log vbTab&" Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
"; Err# (Dec): " & Err & "; Description : " & Err.Description
Select Case Err
Case 70
'Permission denied. Skip this file
sTmp = "Note: File move operation failed. Skipping file "&sFileErr
Log vbTab&sTmp
LogSummary "CleanCache",vbTab&sTmp
Err.Clear
Case Else
sTmp = "Error: Unhandled error. Aborting unreferenced file detection."
Log vbTab&sTmp
LogSummary "CleanCache",vbTab&sTmp
Err.Clear
Exit Sub
End Select 'Err
End If
sFileErr = File.Name
Select Case LCase(Right(File.Name,4))
Case ".msp"
If fMspOK Then
If NOT oRefFilesDic.Exists(LCase(File.Path)) Then
fFoundOrphan = True
If Not oFso.FolderExists(sTargetFolder) Then oFso.CreateFolder sTargetFolder
sTmp = "Moving unreferenced file " & File.Path &vbTab& " -> " &sTargetFolder
If fDetectOnly Then sTmp = "Identified unreferenced file '" & File.Path &"'. This would be moved to folder " &sTargetFolder
Log vbTab&"Note: "&sTmp
LogSummary "CleanCache",vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT fDetectOnly Then
If oFso.FileExists(sTargetFolder&File.Name) _
Then oFso.MoveFile File.Path,sTargetFolder&sTimeStamp&"_"&File.Name _
Else oFso.MoveFile File.Path,sTargetFolder&File.Name
End If 'fDetectOnly
End If 'NOT oRefFilesDic.Exists
End If 'fMspOK
Case ".msi"
If fMsiOK Then
If NOT oRefFilesDic.Exists(LCase(File.Path)) Then
fFoundOrphan = True
If Not oFso.FolderExists(sTargetFolder) Then oFso.CreateFolder sTargetFolder
sTmp = "Moving unreferenced file " & File.Path &vbTab& " -> " &sTargetFolder
If fDetectOnly Then sTmp = "Identified unreferenced file '" & File.Path &"'. This would be moved to folder " &sTargetFolder
Log vbTab&"Note: "&sTmp
LogSummary "CleanCache",vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT fDetectOnly Then
If oFso.FileExists(sTargetFolder&File.Name) _
Then oFso.MoveFile File.Path,sTargetFolder&sTimeStamp&"_"&File.Name _
Else oFso.MoveFile File.Path,sTargetFolder&File.Name
End If 'fDetectOnly
End If 'NOT oRefFilesDic.Exists
End If 'fMsiOK
Case Else
End Select
Next 'File
If NOT fFoundOrphan Then Log vbTab&"Success: No unreferenced .msp files found."
'Delete the moved files in aggresive mode
sTargetFolder = sTemp & "MovedCacheFiles"
If fCleanAggressive Then
sTmp = "Deleting moved files folder "&sTargetFolder
If fDetectOnly Then sTmp = "Moved files folder would be deleted: "&sTargetFolder
Log vbTab&"Note: "&sTmp
LogSummary "CleanCache",vbTab&sTmp
If NOT fDetectOnly Then oFso.DeleteFolder sTargetFolder,True
End If 'fCleanAggressive
End Sub 'WICleanOrphans
'=======================================================================================================
'=======================================================================================================
'Uninstall a removable patch
Sub MspRemove(sPatchCodes,sProductCodes)
Dim Product,Patch,oPatches,Update
Dim sPatches,sCmd,sReturn,sStateFilter,sLogFilter
Dim iFoo,iActivityCnt
Dim arrLogFilter
Dim fPatchLoop,fSupersededMode,fMatchFound
Dim sPatchCodeCompressed,sProductCodeCompressed,sUserSid,sGlobalConfigKey,sMspFile
Dim fForceReconcile
Dim MspDb,Record
Dim qView
On Error Resume Next
iActivityCnt = 0
If UCase(sPatchCodes) = "SUPERSEDED" Then
sStateFilter = MSIPATCHSTATE_SUPERSEDED
fSupersededMode = True
sLogFilter = "superseded patches"
Else
sStateFilter = MSIPATCHSTATE_ALL
fSupersededMode = False
arrLogFilter = Split(sPatchCodes,";")
sLogFilter = ""
For Each Patch in arrLogFilter
If InStr(Patch,"{")>0 Then sLogFilter = sLogFilter&";"&Patch
Next 'Patch
Set Patch = Nothing
If NOT sLogFilter = "" Then sLogFilter="patch(es) "&Mid(sLogFilter,2)
End If
'Loop all products
For Each Product In oMsi.Products
If IsOfficeProduct (Product) Then
If InStr(sProductCodes,Product)>0 OR sProductCodes = "" Then
For iFoo = 1 To 1
Do
fPatchLoop = False
fMatchFound = False
Log "Scanning "&Product&" - "&oMsi.ProductInfo(Product,"ProductName")&" - for "&sLogFilter
Set oPatches = oMsi.PatchesEx(Product,USERSID_NULL,MSIINSTALLCONTEXT_MACHINE,sStateFilter)
If Not Err = 0 Then
Err.Clear
Log vbCrLf&" Failed to retrieve list of patches"
If fCscript Then wscript.echo vbTab&" Failed to retrieve list of patches"
Exit For 'iFoo
End If
For Each Patch in oPatches
If InStr(sPatchCodes,Patch.PatchCode)>0 OR fSupersededMode Then
fForceReconcile = False
sMspFile = Patch.PatchProperty("LocalPackage")
iActivityCnt = iActivityCnt + 1
sCmd = "msiexec.exe /i " & Product & _
" MSIPATCHREMOVE="&Patch.PatchCode& _
" REBOOT=ReallySuppress" & _
" /qb-" & _
" /l*v+ %temp%\"&Product&"_"&Patch.PatchCode&"_MspRemove.log"
If Patch.PatchProperty("Uninstallable") = "1" Then
fMatchFound = True
sTmp = "Uninstalling patch " & Patch.PatchCode&" - "&Patch.PatchProperty("DisplayName")
If fDetectOnly Then
sTmp = "Uninstall attempt possible to remove patch " & Patch.PatchCode&" - "&Patch.PatchProperty("DisplayName")
End If 'fDetectOnly
Log vbTab&"Note: "&sTmp
LogSummary Product,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT fDetectOnly Then
Log vbTab&"Debug: calling msiexec with '"&sCmd&"'"
'Execute the patch uninstall
sReturn = CStr(oWShell.Run(sCmd, 0, True))
fRebootRequired = fRebootRequired OR (sReturn = "3010")
sTmp = "Msiexec patch removal returned: " & sReturn &" "& MsiexecRetval(sReturn)
Log vbTab&"Debug: "& sTmp
LogSummary Product,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT (sReturn="0" OR sReturn="3010") AND oFso.FileExists(sMspFile) AND fForceRemovePatch Then fForceReconcile = True
End If 'NOT fDetectOnly
sPatches = sPatches & Patch.PatchCode & ";"
Else
If fForceRemovePatch AND NOT fDetectOnly Then
fMatchFound = True
sTmp = "Attmpting forced uninstall of patch " & Patch.PatchCode&" - "&Patch.PatchProperty("DisplayName")
Log vbTab&"Note: "&sTmp
LogSummary Product,vbTab&sTmp
'A) Tweak registry flag
'Fill variables
sPatchCodeCompressed = GetCompressedGuid(Patch.PatchCode)
sProductCodeCompressed = GetCompressedGuid(Patch.ProductCode)
sUserSid = Patch.UserSid : If sUserSid = "" Then sUserSid = "S-1-5-18\" Else sUserSid = sUserSid & "\"
sGlobalConfigKey = REG_GLOBALCONFIG & sUserSid & "Products\" & sProductCodeCompressed & "\Patches\"
oFso.GetFile(sMspFile).Attributes = 0
If RegValExists(HKLM,sGlobalConfigKey&sPatchCodeCompressed,"Uninstallable") Then
oReg.SetDWordValue HKLM,sGlobalConfigKey&sPatchCodeCompressed,"Uninstallable",1
'B) Tweak cached .msp
TweakDatabase(sMspFile)
'Call msiexec to uninstall patch
Log vbTab&"Debug: calling msiexec with '"&sCmd&"'"
'Execute the patch uninstall
sReturn = CStr(oWShell.Run(sCmd, 0, True))
fRebootRequired = fRebootRequired OR (sReturn = "3010")
sTmp = "Msiexec patch removal returned: " & sReturn &" "& MsiexecRetval(sReturn)
Log vbTab&"Debug: "& sTmp
LogSummary Product,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
If NOT (sReturn="0" OR sReturn="3010") Then fForceReconcile = True
Else
fForceReconcile = True
End If
Else
sTmp = "Patch " & Patch.PatchCode&" - "&Patch.PatchProperty("DisplayName")&" - is not uninstallable"
Log vbTab&"Note: "&sTmp
LogSummary Product,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
End If 'fForceRemovePatch
End If 'Patch Uninstallable
If fForceReconcile Then
sTmp = "Msiexec based uninstall not possible. Unregistering patch "
sTmp = sTmp & Patch.PatchCode&" - "&Patch.PatchProperty("DisplayName")
Log vbTab&"Note: "&sTmp
LogSummary Product,vbTab&sTmp
If oFso.FileExists(sMspFile) Then oFso.MoveFile sMspFile,sTemp&oFso.GetFileName(sMspFile)
UnregisterPatch Patch
End If
End If 'InStr
Next 'Patch
If NOT fMatchFound Then Log vbTab&"No match found for specified patch filter"
Loop While fPatchLoop
Next 'iFoo
End If 'InStr sProductCodes
End If 'IsOfficeProduct
Next 'Product
If iActivityCnt = 0 Then LogSummary "RemovePatch",vbTab&"Nothing to remove for specified patch filter"&vbCrLf
End Sub 'MspRemove
'=======================================================================================================
'Create and call an external script task to tweak the cached .msp
'This is required to work around the missing option in VBScript to release the database handle
Sub TweakDatabase(sMspFile)
Dim TweakDb
Dim sTweakCmd
Set TweakDb = oFso.CreateTextFile(sTemp&"TweakDb.vbs",True,True)
TweakDb.WriteLine "On Error Resume Next"
TweakDb.WriteLine "Set Msi = CreateObject("&chr(34)&"WindowsInstaller.Installer"&chr(34)&")"
TweakDb.WriteLine "Set MspDb = Msi.OpenDatabase("&chr(34)&sMspFile&chr(34)&","&MSIOPENDATABASEMODE_TRANSACT + MSIOPENDATABASEMODE_PATCHFILE&")"
TweakDb.WriteLine "Set ModifyView = MspDb.OpenView("&chr(34)&"UPDATE `MsiPatchMetadata` SET `MsiPatchMetadata`.`Value`='1′ WHERE `MsiPatchMetadata`.`Property`='AllowRemoval'"&chr(34)&")"
TweakDb.WriteLine "ModifyView.Execute"
TweakDb.WriteLine "ModifyView.Close"
TweakDb.WriteLine "MspDb.Commit"
TweakDb.Close
sTweakCmd = "cscript "&chr(34)&sTemp&"TweakDb.vbs"&chr(34)
oWShell.Run sTweakCmd, 0, True
oFso.DeleteFile sTemp&"TweakDb.vbs",True
End Sub 'TweakDatabase
'=======================================================================================================
'Extracts the patch embedded .cab file to the %temp% folder
'and returns a string list of extracted cab files
Function CabExtract (sMspFile)
Dim MspDb,Record,File,CabFile,DataSize
Dim qView
Dim sCabList,sCabFile
sCabList = ""
If NOT oFso.FileExists(sMspFile) Then
wscript.echo "File '"&sMspFile&"' does not exist."
Exit Function
End If
If NOT LCase(Right(sMspFile,4))=".msp" Then
wscript.echo "'"&sMspFile&"' is not a valid .msp file."
Exit Function
End If
Set File = oFso.GetFile(sMspFile)
Set MspDb = oMsi.OpenDatabase(sMspFile,MSIOPENDATABASEMODE_PATCHFILE)
Set qView = MspDb.OpenView("SELECT * FROM _Streams") : qView.Execute
Do
Set Record = qView.Fetch
If Record Is Nothing Then Exit Do
If InStr(UCase(Record.StringData(1)),"_CAB")>0 Then
sCabFile = "" : sCabFile = Replace(File.Name,".msp","")&"_"&Record.StringData(1)&".cab"
Set CabFile = oFso.CreateTextFile(sTemp&sCabFile)
CabFile.Write Record.ReadStream(2,Record.DataSize(2),MSIREADSTREAM_ANSI)
CabFile.Close
sCabList = ";"&sTemp&sCabFile
oWShell.Run chr(34) &sTemp&sCabFile& chr(34)
End If
Loop
qView.Close
If Len(sCabList)>0 Then sCabList = Mid(sCabList,2)
CabExtract = sCabList
End Function 'CabExtract
'=======================================================================================================
'Module CollectUpdates
'=======================================================================================================
Sub CollectUpdates (sFilter)
Dim sUpdatesFolder, sMspPackageName
Dim Msp, PatchEx, PatchesEx
Const PRODUCTCODE_EMPTY = ""
sUpdatesFolder = oWShell.ExpandEnvironmentStrings("%TEMP%")&"\Updates"
If Not oFso.FolderExists(sTargetFolder) Then oFso.CreateFolder sUpdatesFolder
'Get all applied patches
Set PatchesEx = oMsi.PatchesEx(PRODUCTCODE_EMPTY,USERSID_NULL,MSIINSTALLCONTEXT_MACHINE,MSIPATCHSTATE_APPLIED)
On Error Resume Next
'Enum the patches
For Each PatchEx in PatchesEx
If Not Err = 0 Then Err.Clear
'Connect to the patch file
Set Msp = oMsi.OpenDatabase(PatchEx.PatchProperty("LocalPackage"),MSIOPENDATABASEMODE_PATCHFILE)
Set SumInfo = msp.SummaryInformation
If Err = 0 Then
sMspPackageName = PatchEx.PatchProperty("LocalPackage")
If InStr(SumInfo.Property(PID_TEMPLATES),OFFICEID)>0 Then
'Get the original patch name
Set qView = msp.OpenView("SELECT `Property`,`Value` FROM MsiPatchMetadata WHERE `Property`='StdPackageName'")
qView.Execute : Set record = qView.Fetch()
'Copy and rename the patch to the original filename
oFso.CopyFile patch.PatchProperty("LocalPackage"),sTargetFolder&"\"&record.StringData(2),TRUE
End If
End If 'Err = 0
Next 'patch
oWShell.Run "explorer /e,"&chr(34)&sTargetFolder&chr(34)
End Sub 'CollectUpdates
'=======================================================================================================
'Module ViewPatch
'=======================================================================================================
'Show contents of .MSP files in an Excel workbook
'This requires XL to be installed
Sub ViewPatch (sMspFile)
Dim XlApp,XlWkbk,XlSheet,MspDb,File
Dim Element,Elements,Node,Record,qView,CompItem
Dim i,iSheetCnt,iRow,iRowCnt,iCol,iColCnt,iVersionMajor,iCnt
Dim MspTarget,sXml,sProductCode,sOFamilyVersion,sCompType,sCompFlt,sTargetVersion
Dim sTmpVersion,sRange,prod,sInstProds
Dim arrMspTargets,arrFileVersion,arrComputer,arrCompItem
Dim fOfficePatch,fOctPatch,fValidate
On Error Resume Next
If NOT XLInstalled Then
wscript.echo "This feature requires Excel to be installed. Cannot continue"
Exit Sub
End If
If NOT oFso.FileExists(sMspFile) Then
wscript.echo "File '"&sMspFile&"' does not exist."
Exit Sub
End If
If NOT LCase(Right(sMspFile,4))=".msp" Then
wscript.echo "'"&sMspFile&"' is not a valid .msp file."
Exit Sub
End If
Set File = oFso.GetFile(sMspFile)
Dim fNeedObsoleted,fNeedMstSubStorage,fSupersedesPrevious
fOfficePatch = False
fNeedObsoleted = False
fNeedMstSubStorage = False
fSupersedesPrevious = False
'Get the database handle
Set MspDb = oMsi.OpenDatabase(sMspFile,MSIOPENDATABASEMODE_PATCHFILE)
If Not Err = 0 Then
wscript.echo "Could not open patch "&sMspFile
Err.Clear
Exit Sub
End If
'Determine if this is an Office Patch
arrMspTargets = Split(MspDb.SummaryInformation.Property(PID_TEMPLATE),";")
For Each MspTarget in arrMspTargets
If IsOfficeProduct(MspTarget) Then
fOfficePatch = True
Exit For
End If
Next
Dim sPatchTables
sPatchTables = GetDatabaseTables(MspDb)
'Get the PatchXml
sXml = oMsi.ExtractPatchXMLData(sMspFile)
XmlDoc.LoadXml(sXml)
'Create the XL instance
Set XlApp = CreateObject("Excel.Application")
'Suppress XL alerts
XlApp.DisplayAlerts = False
'Avoid blank worksheets
iSheetCnt = XlApp.SheetsInNewWorkbook
XlApp.SheetsInNewWorkbook = 1
Set XlWkbk = XlApp.Workbooks.Add
XlApp.SheetsInNewWorkbook = iSheetCnt
'TmpStatus
'———
Set XlSheet = XlWkbk.Worksheets(1)
XlSheet.Name = "Status"
XlSheet.Cells(1, S_PROP).Value = "Please wait"
XlSheet.Cells(1, S_VAL).Value = "Collecting Patch Details …"
XlSheet.Columns.Autofit
'Start the user UI experience
XlApp.Interactive = False
XlApp.Visible = True
XlApp.WindowState = xlMaximized
XlApp.ScreenUpdating = False
'Summary
'——-
'Create a new workbook
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "Summary"
Dim OctXml,sOctXmlFile,sRegXlOptions,fRegDelXmlSchemaAlert
iRow = 1 : iCol = 1
XlSheet.Cells(1, S_PROP).Value = "Property"
XlSheet.Cells(1, S_VAL).Value = "Value"
'FileName
XlSheet.Cells(S_ROW_NAME, S_PROP).Value = "FileName"
XlSheet.Cells(S_ROW_NAME, S_VAL).Value = File.Name
'KB
Dim sKB
If InStr(sPatchTables,"MsiPatchMetadata")>0 Then
Set qView = MspDb.OpenView("SELECT `Property`,`Value` FROM MsiPatchMetadata WHERE `Property`='KBArticle Number'")
qView.Execute : Set Record = qView.Fetch()
If Not Record Is Nothing Then
sKB = UCase(Record.StringData(2))
sKB = Replace(sKB,"KB","")
Else
sKB = ""
End If
qView.Close
End If
If sKB = "" Then
Dim iSiCnt,arrSi,sTitle,sSiTmp,sChar
'Scan the SummaryInformation data for the KB
For iSiCnt = 1 To 2
Select Case iSiCnt
Case 1
arrSi = Split(MspDb.SummaryInformation.Property(PID_SUBJECT),";")
Case 2
arrSi = Split(MspDb.SummaryInformation.Property(PID_TITLE),";")
End Select
If IsArray(arrSi) Then
For Each sTitle in arrSi
sSiTmp = ""
sSiTmp = Replace(UCase(sTitle)," ","")
If InStr(sSiTmp,"KB")>0 Then
'Strip the KB
sSiTmp = Mid(sSiTmp,InStr(sSiTmp,"KB")+2)
For i = 1 To Len(sSiTmp)
sChar = ""
sChar = Mid(sSiTmp,i,1)
If (Asc(sChar) >= 48 AND Asc(sChar) <= 57) Then sKB=sKB&sChar
Next 'i
'Ensure a valid length
If Len(sKB)<5 Then sKB="" Else Exit For
End If
Next
If Len(sKB)>4 Then Exit For
End If 'IsArray(arrSi)
Next 'iSiCnt
End If
XlSheet.Cells(S_ROW_KB, S_PROP).Value = "KB"
If Len(sKB)>0 Then
XlSheet.Cells(S_ROW_KB, S_VAL).Value = "KB"&sKB
XlSheet.Hyperlinks.Add XlSheet.Cells(S_ROW_KB, S_VAL),"http://support.microsoft.com/kb/"&sKB
End If
'Packlet
XlSheet.Cells(S_ROW_PACKLET, S_PROP).Value = "Patch Packlet Family"
If fOfficePatch Then
Dim arrPacklet,sPacklet
sPacklet = ""
arrPacklet = Split(MspDb.SummaryInformation.Property(PID_TITLE),";")
If IsArray(arrPacklet) Then
If UBound(arrPacklet)>0 Then
sPacklet = arrPacklet(1)
If InStr(sPacklet,".")>0 Then sPacklet = Left(sPacklet,InStr(sPacklet,".")-1)
End If
End If
XlSheet.Cells(S_ROW_PACKLET, S_VAL).Value = sPacklet
End If
'Sequence
Dim sSequence
sSequence = ""
XlSheet.Cells(S_ROW_SEQUENCE, S_PROP).Value = "Sequence Number"
XlSheet.Cells(S_ROW_SEQUENCE, S_VAL).Value = "" 'Defer to MsiPatchSequence handling
'Baseline
XlSheet.Cells(S_ROW_BASELINE, S_PROP).Value = "Patch can be applied to build(s)"
XlSheet.Cells(S_ROW_BASELINE, S_VAL).Value = GetMspBldTargets(sXml)
'Prepare Supersedence field
XlSheet.Cells(S_ROW_SUPERSEDENCE, S_PROP).Value = "Supersedes previous patches"
XlSheet.Cells(S_ROW_SUPERSEDENCE, S_VAL).Value = "No supersedence data available"
'Prepare Uninstallable field
XlSheet.Cells(S_ROW_UNINSTALLABLE, S_PROP).Value = "Uninstallable"
'SummaryInformation
For i = 1 To 19
Select Case i
Case PID_TITLE
XlSheet.Cells(S_ROW_TITLE, S_PROP).Value = "Title"
XlSheet.Cells(S_ROW_TITLE, S_VAL).Value = MspDb.SummaryInformation.Property(PID_TITLE)
Case PID_AUTHOR
XlSheet.Cells(S_ROW_AUTHOR, S_PROP).Value = "Author"
XlSheet.Cells(S_ROW_AUTHOR, S_VAL).Value = MspDb.SummaryInformation.Property(PID_AUTHOR)
Case PID_SUBJECT
XlSheet.Cells(S_ROW_SUBJECT, S_PROP).Value = "Subject"
XlSheet.Cells(S_ROW_SUBJECT, S_VAL).Value = MspDb.SummaryInformation.Property(PID_SUBJECT)
Case PID_COMMENTS
XlSheet.Cells(S_ROW_COMMENTS, S_PROP).Value = "Comments"
XlSheet.Cells(S_ROW_COMMENTS, S_VAL).Value = MspDb.SummaryInformation.Property(PID_COMMENTS)&vbCrLf
Case PID_REVNUMBER 'PatchCode & Obsoletion
Dim sPatchCode
XlSheet.Cells(S_ROW_PATCHCODE, S_PROP).Value = "PatchCode"
XlSheet.Cells(S_ROW_OBSOLETES, S_PROP).Value = "Obsoletes"
sPatchCode = MspDb.SummaryInformation.Property(PID_REVNUMBER) 'PatchCode
If Len(sPatchCode)>LEN_GUID Then
XlSheet.Cells(S_ROW_OBSOLETES, S_VAL).Value = "See ObsoletedPatches Sheet"
XlSheet.Hyperlinks.Add XlSheet.Cells(S_ROW_OBSOLETES, S_VAL),"","ObsoletedPatches!$A$1"
fNeedObsoleted = True
sPatchCode=Left(sPatchCode,LEN_GUID)
End If
XlSheet.Cells(S_ROW_PATCHCODE, S_VAL).Value = sPatchCode
Case PID_TEMPLATE 'Targets
XlSheet.Cells(S_ROW_TARGETS, S_PROP).Value = "Targets"
XlSheet.Cells(S_ROW_TARGETS, S_VAL).Value = "See PatchTargets Sheet"
XlSheet.Hyperlinks.Add XlSheet.Cells(S_ROW_TARGETS, S_VAL),"","PatchTargets!$A$1"
Case PID_LASTAUTHOR 'List of mst substorages
XlSheet.Cells(S_ROW_TRANSFORMSUB, S_PROP).Value = "Transform Substorages"
XlSheet.Cells(S_ROW_TRANSFORMSUB, S_VAL).Value = "See TransformSubStorages Sheet"
XlSheet.Hyperlinks.Add XlSheet.Cells(S_ROW_TRANSFORMSUB, S_VAL),"","TransformSubStorages!$A$1"
fNeedMstSubStorage = True
Case PID_WORDCOUNT 'Required WI version
XlSheet.Cells(S_ROW_PATCHTYPE, S_PROP).Value = "WI Version Required"
Select Case MspDb.SummaryInformation.Property(PID_WORDCOUNT)
Case 1
XlSheet.Cells(S_ROW_PATCHTYPE, S_VAL).Value = "1.0 (Type 1) "
Case 2
XlSheet.Cells(S_ROW_PATCHTYPE, S_VAL).Value = "1.2 (Type 2)"
Case 3
XlSheet.Cells(S_ROW_PATCHTYPE, S_VAL).Value = "2.0 (Type 3)"
Case 4
XlSheet.Cells(S_ROW_PATCHTYPE, S_VAL).Value = "3.0 (Type 4)"
Case 5
XlSheet.Cells(S_ROW_PATCHTYPE, S_VAL).Value = "3.1 (Type 5)"
Case Else
XlSheet.Cells(S_ROW_PATCHTYPE, S_VAL).Value = MspDb.SummaryInformation.Property(PID_WORDCOUNT)
End Select
Case PID_SECURITY 'Read Only Flag
XlSheet.Cells(S_ROW_SECURITY, S_PROP).Value = "Read-Only Security"
Select Case MspDb.SummaryInformation.Property(PID_SECURITY)
Case 0
XlSheet.Cells(S_ROW_SECURITY, S_VAL).Value = "No Restriction"
Case 2
XlSheet.Cells(S_ROW_SECURITY, S_VAL).Value = "Read-only recommended"
Case 4
XlSheet.Cells(S_ROW_SECURITY, S_VAL).Value = "Read-only enforced"
Case Else
XlSheet.Cells(S_ROW_SECURITY, S_VAL).Value = MspDb.SummaryInformation.Property(PID_SECURITY)
End Select
Case Else
'Do Not List
End Select
Next 'i
'PatchXml
Dim PatchXml
Set PatchXml = oFso.CreateTextFile(sTemp&File.Name&"_Patch.xml",True,True)
PatchXml.Write sXml
PatchXml.Close
XlSheet.Cells(S_ROW_PATCHXML, S_PROP).Value = "PatchXML"
XlSheet.Cells(S_ROW_PATCHXML, S_VAL).Value = sTemp&File.Name&"_Patch.xml"
XlSheet.Hyperlinks.Add XlSheet.Cells(S_ROW_PATCHXML, S_VAL),sTemp&File.Name&"_Patch.xml"
'OCT PatchXml
Set qView = MspDb.OpenView("SELECT * FROM _Streams") : qView.Execute
i = 0
Do
Set Record = qView.Fetch
If Record Is Nothing Then Exit Do
If InStr(UCase(Record.StringData(1)),"METADATA")>0 Then
i = i + 1
sOctXmlFile = "" : sOctXmlFile = sTemp&File.Name&"_OCT_"&Record.StringData(1)&".xml"
Set OctXml = oFso.CreateTextFile(sOctXmlFile)
OctXml.Write Record.ReadStream(2,Record.DataSize(2),MSIREADSTREAM_ANSI)
OctXml.Close
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow, S_PROP).Value = "OCT Metadata"
XlSheet.Cells(iRow, S_VAL).Value = sOctXmlFile
XlSheet.Hyperlinks.Add XlSheet.Cells(iRow, S_VAL),sOctXmlFile
If IsBaselineRequired("",sXml) Then
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow, S_PROP).Value = "IMPORTANT NOTE"
XlSheet.Cells(iRow, S_VAL).Value = "This is a customization patch based on the original release of the OCT."&vbCrLf&"A more recent OCT version is available from http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=73d955c0-da87-4bc2-bbf6-260e700519a8”"
End If
End If
Loop
qView.Close
'Transform SubStorages
'———————
If fNeedMstSubStorage Then
Dim arrMstSubStore,dicTransformRow
Set dicTransformRow = CreateObject("Scripting.Dictionary")
'Create the TransformSubStorages sheet
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "TransformSubStorages"
XlSheet.Move ,XlWkbk.Sheets("Summary")
'Fill the sheet
iRow = 1 : iCol = 1
XlSheet.Cells(HROW, COL_NONPOUND).Value = "Non Pound Transform"
XlSheet.Cells(HROW, COL_POUND).Value = "(Patch Specific Tables)"
arrMstSubStore = Split(MspDb.SummaryInformation.Property(PID_LASTAUTHOR),";")
For i = 0 To UBound(arrMstSubStore)
If InStr(arrMstSubStore(i),"#")>0 Then iCol = COL_POUND Else iCol = COL_NONPOUND
iRow = Int((i+4)/2)
XlSheet.Cells(iRow, iCol).Value = arrMstSubStore(i)
If NOT dicTransformRow.Exists(arrMstSubStore(i)) Then dicTransformRow.Add arrMstSubStore(i),iRow
Next 'i
If fOfficePatch Then ExtendTransformTable XlSheet,dicTransformRow,MspDb
End If
'Obsoleted Patches
'—————-
If fNeedObsoleted Then
Dim arrObsoleted
'Create the Obsoleted sheet
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "ObsoletedPatches"
XlSheet.Move ,XlWkbk.Sheets("Summary")
'Fill the sheet
iRow = 1 : iCol = 1
XlSheet.Cells(HROW, iCol).Value = "Obsoleted Patches"
arrObsoleted = Split(Mid(MspDb.SummaryInformation.Property(PID_REVNUMBER),LEN_GUID+1),"}")
For i = 0 To UBound(arrObsoleted)-1
XlSheet.Cells(i+2, iCol).Value = arrObsoleted(i)&"}"
Next 'i
End If
'MsiPatchSequence
'—————-
If InStr(UCase(sPatchTables),"MSIPATCHSEQUENCE")>0 Then
fSupersedesPrevious = False
'Create the MsiPatchSequence sheet
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "MsiPatchSequence"
XlSheet.Move ,XlWkbk.Sheets("Summary")
'Fill the sheet
iRow = 1 : iCol = 1
XlSheet.Cells(HROW, SEQ_PATCHFAMILY).Value = "PatchFamily"
XlSheet.Cells(HROW, SEQ_PRODUCTCODE).Value = "ProductCode"
XlSheet.Cells(HROW, SEQ_SEQUENCE).Value = "Sequence"
XlSheet.Cells(HROW, SEQ_ATTRIBUTE).Value = "(Supersedence Flag)"
Set qView = MspDb.OpenView("SELECT * FROM MsiPatchSequence") : qView.Execute
Set Record = qView.Fetch()
Do Until Record Is Nothing
iRow = iRow + 1
XlSheet.Cells(iRow, SEQ_PATCHFAMILY).Value = Record.StringData(SEQ_PATCHFAMILY)
XlSheet.Cells(iRow, SEQ_PRODUCTCODE).Value = Record.StringData(SEQ_PRODUCTCODE)
XlSheet.Cells(iRow, SEQ_SEQUENCE).Value = Record.StringData(SEQ_SEQUENCE)
If NOT InStr(sSequence,Record.StringData(SEQ_SEQUENCE))>0 Then sSequence = ";"&Record.StringData(SEQ_SEQUENCE)
XlSheet.Cells(iRow, SEQ_ATTRIBUTE).Value = Record.StringData(SEQ_ATTRIBUTE)
fSupersedesPrevious = fSupersedesPrevious OR Record.StringData(SEQ_ATTRIBUTE)="1"
Set Record = qView.Fetch()
Loop
qView.Close
If Len(sSequence)>1 Then sSequence = Mid(sSequence,2)
'Update Supersedence field on Summary Sheet
Set XlSheet = XlWkbk.Sheets("Summary")
If fSupersedesPrevious Then XlSheet.Cells(S_ROW_SUPERSEDENCE, S_VAL).Value = "Yes" Else XlSheet.Cells(S_ROW_SUPERSEDENCE, S_VAL).Value = "No"
End If 'MsiPatchSequence
'Add Sequence data to summary sheet
Set XlSheet = XlWkbk.Sheets("Summary")
If InStr(sSequence,";")>0 Then
XlSheet.Cells(S_ROW_SEQUENCE, S_VAL).Value = "Mulitple sequence data available"
XlSheet.Hyperlinks.Add XlSheet.Cells(S_ROW_SEQUENCE, S_VAL),"","MsiPatchSequence!$A$1"
Else
If sSequence = "" Then
If fOfficePatch Then sSequence = GetLegacyMspSeq(MspDb)
End If
If sSequence = "" Then sSequence = "No sequence data available"
XlSheet.Cells(S_ROW_SEQUENCE, S_VAL).Value = sSequence
End If
'MsiPatchMetaData
'—————-
If InStr(UCase(sPatchTables),"MSIPATCHMETADATA")>0 Then
'Create the MsiPatchMetaData sheet
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "MsiPatchMetaData"
XlSheet.Move ,XlWkbk.Sheets("Summary")
'Fill the sheet
iRow = 1 : iCol = 1
XlSheet.Cells(HROW, MET_COMPANY).Value = "Company"
XlSheet.Cells(HROW, MET_PROPERTY).Value = "Property"
XlSheet.Cells(HROW, MET_VALUE).Value = "Value"
Set qView = MspDb.OpenView("SELECT * FROM MsiPatchMetadata") : qView.Execute
Set Record = qView.Fetch()
Do Until Record Is Nothing
iRow = iRow + 1
XlSheet.Cells(iRow, MET_COMPANY).Value = Record.StringData(MET_COMPANY)
XlSheet.Cells(iRow, MET_PROPERTY).Value = Record.StringData(MET_PROPERTY)
XlSheet.Cells(iRow, MET_VALUE).Value = Record.StringData(MET_VALUE)
If UCase(Record.StringData(MET_PROPERTY)) = "STDPACKAGENAME" AND fOfficePatch Then
Set XlSheet = XlWkbk.Sheets("Summary")
sTmp = ""
sTmp = Record.StringData(MET_VALUE)
If InStr(sTmp,".")>0 Then sTmp = Left(sTmp,InStr(sTmp,".")-1)
If NOT sTmp = "" Then XlSheet.Cells(S_ROW_PACKLET, S_VAL).Value = sTmp
Set XlSheet = XlWkbk.Sheets("MsiPatchMetaData")
End If
If UCase(Record.StringData(MET_PROPERTY)) = "ALLOWREMOVAL" Then
Set XlSheet = XlWkbk.Sheets("Summary")
If Record.StringData(MET_VALUE) = 1 Then sTmp = "Yes" Else sTmp = "No"
XlSheet.Cells(S_ROW_UNINSTALLABLE, S_VAL).Value = sTmp
Set XlSheet = XlWkbk.Sheets("MsiPatchMetaData")
End If
Set Record = qView.Fetch()
Loop
qView.Close
End If 'MsiPatchMetaData
'PatchTargets
'————
Dim iTargetGuid,iTargetVer,iUpdatedVer,iLcid,iCulture,iVTargetProd,iVTargetVer,iVTargetLang,iVTargetUpg
'Create the PatchTarget sheet
'- - - - - - - - - - - - - -
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "PatchTargets"
XlSheet.Move ,XlWkbk.Sheets("Summary")
iRow = 1 : iCol = 1
If fOfficePatch Then
iTargetGuid = OTARGETGUID
iTargetVer = OMSPTARGETVER
iUpdatedVer = OMSPUPDATEDVER
iLcid = OLCID
iCulture = OCULTURE
iVTargetProd = OVAL_TARGETPRODUCTCODE
iVTargetVer = OVAL_TARGETVERSION
iVTargetLang = OVAL_TARGETLANGUAGE
iVTargetUpg = OVAL_TARGETUPGRADECODE
XlSheet.Cells(HROW, OTARGETNAME).Value = "ProductName"
XlSheet.Cells(HROW, OFAMILYVER).Value = "Office Family"
XlSheet.Cells(HROW, OLICENSE).Value = "License"
XlSheet.Cells(HROW, OARCHITECTURE).Value = "Platform"
Else
iTargetGuid = TARGETGUID
iTargetVer = MSPTARGETVER
iUpdatedVer = MSPUPDATEDVER
iLcid = LCID
iCulture = CULTURE
iVTargetProd = VAL_TARGETPRODUCTCODE
iVTargetVer = VAL_TARGETVERSION
iVTargetLang = VAL_TARGETLANGUAGE
iVTargetUpg = VAL_TARGETUPGRADECODE
End If
XlSheet.Cells(HROW, iTargetGuid).Value = "ProductCode"
XlSheet.Cells(HROW, iTargetVer).Value = "Target Baseline"
XlSheet.Cells(HROW, iUpdatedVer).Value = "Updated Baseline"
XlSheet.Cells(HROW, iLcid).Value = "LCID"
XlSheet.Cells(HROW, iCulture).Value = "Culture"
XlSheet.Cells(HROW, iVTargetProd).Value = "Validate ProductCode"
XlSheet.Cells(HROW, iVTargetVer).Value = "Validate ProductVersion"
XlSheet.Cells(HROW, iVTargetLang).Value = "Validate Language"
XlSheet.Cells(HROW, iVTargetUpg).Value = "Validate UpgradeCode"
If fOfficePatch Then
XlSheet.Cells(HROW, iTargetVer).Value = "Required Office Build"
XlSheet.Cells(HROW, iUpdatedVer).Value = "Office Build Version After Patch"
End If
'Fill data into the PatchTargets sheet
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
iRow = iRow + 1
sProductCode = Element.selectSingleNode("TargetProductCode").text
XlSheet.Cells(iRow, iTargetGuid).Value = sProductCode
If NOT dicProdMst.Exists(sProductCode) Then dicProdMst.Add sProductCode,XlWkbk.Sheets("TransformSubStorages").Cells(iRow,COL_NONPOUND)
If fOfficePatch Then
iVersionMajor = GetVersionMajor(sProductCode)
'ProductName
Select Case iVersionMajor
Case 9
sOFamilyVersion = 2000
XlSheet.Cells(iRow, OTARGETNAME).Value = GetProductID(Mid(sProductCode,4,2),sOFamilyVersion)
Case 10
sOFamilyVersion = 2002
XlSheet.Cells(iRow, OTARGETNAME).Value = GetProductID(Mid(sProductCode,4,2),sOFamilyVersion)
Case 11
sOFamilyVersion = 2003
XlSheet.Cells(iRow, OTARGETNAME).Value = GetProductID(Mid(sProductCode,4,2),sOFamilyVersion)
Case 12
sOFamilyVersion = 2007
XlSheet.Cells(iRow, OTARGETNAME).Value = GetProductID(Mid(sProductCode,11,4),sOFamilyVersion)
Case 14
sOFamilyVersion = 2010
XlSheet.Cells(iRow, OTARGETNAME).Value = GetProductID(Mid(sProductCode,11,4),sOFamilyVersion)
Case Else
sOFamilyVersion = ""
End Select
XlSheet.Cells(iRow, OFAMILYVER).Value = sOFamilyVersion
XlSheet.Cells(iRow, OLICENSE).Value = GetReleaseType(CInt(Mid(sProductCode,3,1)))
If Mid(sProductCode,21,1) = "1" Then XlSheet.Cells(iRow, OARCHITECTURE).Value = "x64" Else XlSheet.Cells(iRow, OARCHITECTURE).Value = "x86"
End If
For Each Node in Element.ChildNodes
Select Case Node.NodeName
Case "TargetProductCode"
XlSheet.Cells(iRow, iVTargetProd).Value = CBool(Node.getAttribute("Validate"))
Case "TargetVersion"
fValidate = CBool(Node.getAttribute("Validate"))
sTargetVersion = Element.selectSingleNode("TargetVersion").text
If fValidate Then
sCompFlt = Node.getAttribute("ComparisonFilter")
sCompType = Node.getAttribute("ComparisonType")
arrFileVersion = Split(sTargetVersion,".")
'Set the filter setting
Select Case sCompFlt
Case "None"
iCnt = -1
Case "Major"
iCnt = 0
Case "MajorMinor"
iCnt = 1
Case "MajorMinorUpdate"
iCnt = 2
Case Else
End Select
sTmpVersion = ""
If iCnt > -1 Then
For i = 0 To iCnt
sTmpVersion = sTmpVersion&"."&arrFileVersion(i)
Next 'i
sTmpVersion = Mid(sTmpVersion,2)
Else
sTmpVersion = "None"
End If
'XlSheet.Cells(iRow, iTargetVer).Value = sTmpVersion&" ("&sTargetVersion&")"
XlSheet.Cells(iRow, iTargetVer).Value = sTargetVersion
XlSheet.Cells(iRow, iVTargetVer).Value = "TRUE: "&sCompType&" "&sTmpVersion
Else
XlSheet.Cells(iRow, iTargetVer).Value = "Baselineless ("&sTargetVersion&")"
XlSheet.Cells(iRow, iVTargetVer).Value = "FALSE"
End If
'If this is an Office patch, add the SP Level
If fOfficePatch Then XlSheet.Cells(iRow, iTargetVer).Value = XlSheet.Cells(iRow, iTargetVer).Value & GetSpLevel(sTargetVersion)
Case "TargetLanguage"
XlSheet.Cells(iRow, iLcid).Value = Element.selectSingleNode("TargetLanguage").text
XlSheet.Cells(iRow, iCulture).Value = GetCultureInfo(XlSheet.Cells(iRow, iLcid).Value)
XlSheet.Cells(iRow, iVTargetLang).Value = CBool(Node.getAttribute("Validate"))
Case "UpdatedVersion"
XlSheet.Cells(iRow, iUpdatedVer).Value = Element.selectSingleNode("UpdatedVersion").text & GetSpLevel(Element.selectSingleNode("UpdatedVersion").text)
Case "UpgradeCode"
fValidate = CBool(Node.getAttribute("Validate"))
If fValidate Then
XlSheet.Cells(iRow, iVTargetUpg).Value = "TRUE: "&Element.selectSingleNode("UpgradeCode").text
Else
XlSheet.Cells(iRow, iVTargetUpg).Value = "FALSE"
End If
Case Else
End Select
Next 'Node
If NOT Len(XlSheet.Cells(iRow, iUpdatedVer).Value)>0 Then XlSheet.Cells(iRow, iUpdatedVer).Value = "Not Updated ("&sTargetVersion&")"& GetSpLevel(sTargetVersion)
Next 'Element
'CustomAction Table
'——————
Set XlSheet = XlWkbk.Sheets("Summary")
'File and other tables
'———————
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "File_Table"
XlSheet.Move ,XlWkbk.Sheets(XlWkbk.Sheets.Count)
iRow = 1 : iCol = 1
Dim dicMspFiles
Set dicMspFiles = CreateObject("Scripting.Dictionary")
FillTables XlWkbk,XlSheet,MspDb,sMspFile,dicMspFiles,fOfficePatch,XmlDoc
AddMspHashes XlWkbk
If fMsiProvidedAsFile Then AddFileNames XlWkbk
'Per Product Detection (DeepScan)
'——————————-
For Each prod in oMsi.Products
sInstProds = sinstProds & ";" & prod
Next
fDeepScan = False
For Each MspTarget in arrMspTargets
If InStr(sInstProds,MspTarget)>0 Then
If IsOfficeProduct(MspTarget) Then
fDeepScan = True
Exit For
End If
End If
Next
'PredictedAction, ComponentState, ComponentClients, FilePath, CurrentVersion
If fDeepScan Then
'Run the full patch detection
ApplyPatches
'Refresh the status screen
Set XlSheet = XlWkbk.Sheets("Status")
XlSheet.Activate
XlSheet.Cells(1, S_VAL).Value = "DeepScan in progress …"
XlApp.Interactive = False
XlApp.ScreenUpdating = True
XlApp.ScreenUpdating = False
ComputerProperties
Set XlSheet = XlWkbk.Sheets("File_Table")
MspDeepScan MspDb,dicMspFiles,XlSheet
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = "Computer"
XlSheet.Move XlWkbk.Sheets("Summary")
XlSheet.Cells(HROW,S_PROP).Value = "Property"
XlSheet.Cells(HROW,S_VAL).Value = "Value"
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = "ComputerName"
XlSheet.Cells(iRow,S_VAL).Value = sComputerName
arrComputer = Split(sOSinfo,",")
For Each CompItem in arrComputer
arrCompItem = Split(CompItem,": ")
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = arrCompItem(0)
XlSheet.Cells(iRow,S_VAL).Value = arrCompItem(1)
Next
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = "Windows Installer Version"
XlSheet.Cells(iRow,S_VAL).Value = vWI
Set XlSheet = XlWkbk.Sheets("Summary")
For iIndex = 0 To UBound(arrSUpdatesAll)
If UCase(arrSUpdatesAll(iIndex,COL_FILENAME)) = UCase(sMspFile) Then
'Patch is applicable to
If InStr(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),";")>0 Then
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = "Patch is applicable to"
ReDim arrTmpLog(-1)
arrSUpdatesAll(iIndex,COL_APPLICABLECNT) = Left(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),Len(arrSUpdatesAll(iIndex,COL_APPLICABLECNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_APPLICABLECNT),";")
sTmp = ""
For Each LogProd in arrTmpLog
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")&" - "&oMsi.ProductInfo(LogProd,"VersionString")&vbCrLf
Next '
XlSheet.Cells(iRow,S_VAL).Value = sTmp
End If
'Patch already applied to
If InStr(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),";")>0 Then
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = "Patch is already applied to"
ReDim arrTmpLog(-1)
arrSUpdatesAll(iIndex,COL_APPLIEDCNT) = Left(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),Len(arrSUpdatesAll(iIndex,COL_APPLIEDCNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_APPLIEDCNT),";")
sTmp = ""
For Each LogProd in arrTmpLog
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")&" - "&oMsi.ProductInfo(LogProd,"VersionString")&vbCrLf
Next '
XlSheet.Cells(iRow,S_VAL).Value = sTmp
End If
'Patch is superseded for
If InStr(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),";")>0 Then
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = "Patch is superseded for"
ReDim arrTmpLog(-1)
arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT) = Left(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),Len(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_SUPERSEDEDCNT),";")
sTmp = ""
For Each LogProd in arrTmpLog
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")&" - "&oMsi.ProductInfo(LogProd,"VersionString")&vbCrLf
Next '
XlSheet.Cells(iRow,S_VAL).Value = sTmp
End If
'Patch not applicable to
If InStr(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),";")>0 Then
iRow = XlSheet.Columns(1).CurrentRegion.Rows.Count +1
XlSheet.Cells(iRow,S_PROP).Value = "Patch is not applicable to"
ReDim arrTmpLog(-1)
arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT) = Left(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),Len(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT))-1)
arrTmpLog = Split(arrSUpdatesAll(iIndex,COL_NOQALBASELINECNT),";")
sTmp = ""
For Each LogProd in arrTmpLog
sTmp = sTmp&oMsi.ProductInfo(LogProd,"ProductName")&" - "&oMsi.ProductInfo(LogProd,"VersionString")&vbCrLf
Next '
XlSheet.Cells(iRow,S_VAL).Value = sTmp
End If
End If
Next 'iIndex
End If
'Final cleanups
XlWkbk.BuiltinDocumentProperties(1) = SOLUTIONNAME&" v"&SCRIPTBUILD
XlWkbk.Sheets("Status").Delete
MakeWkbkLookPretty(XlWkbk)
Set XlSheet = XlWkbk.Sheets("Summary")
If NOT fOfficePatch Then XlSheet.Rows(S_ROW_PACKLET).Delete xlUp
'Hand over XL control to the user
'——————————-
XlWkbk.Worksheets("Summary").Activate
XlApp.UserControl = True
XlApp.ScreenUpdating = True
XlApp.Interactive = True
XlWkbk.Saved = True
XlApp.DisplayAlerts = True
oWShell.AppActivate XlApp.Name&" - "&XlWkBk.Name
Set XlApp = Nothing
End Sub 'ViewPatch
'=======================================================================================================
Sub MakeWkbkLookPretty(XlWkbk)
Dim XlSheet
Dim sRange,sSheetName,sGuid,sTName
Dim iRowCnt,iColCnt
On Error Resume Next
For Each XlSheet in XlWkbk.Sheets
XlSheet.Columns.Autofit
XlSheet.Rows.Autofit
sSheetName = XlSheet.Name
If InStr(sSheetName,"}")>0 Then
sGuid = Left(sSheetName,InStr(sSheetName,"}"))
sSheetName = Mid(sSheetName,InStr(sSheetName,"}")+2)
Else
sGuid = ""
End If
Select Case sSheetName
Case "Computer"
sTName = "TableComputer" & sGuid
XlSheet.Columns(1).VerticalAlignment = xlTop
XlSheet.Columns(2).NumberFormat = "@"
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).ShowTableStyleFirstColumn = True
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium10"
Case "Summary"
sTName = "TableSummary" & sGuid
XlSheet.Columns(1).VerticalAlignment = xlTop
XlSheet.Columns(2).NumberFormat = "@"
XlSheet.Cells(S_ROW_BASELINE, S_PROP).NumberFormat = "0.00"
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).ShowTableStyleFirstColumn = True
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium10"
Case "TransformSubStorages"
sTName = "TableSubStore" & sGuid
XlSheet.Columns(1).VerticalAlignment = xlTop
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium4"
XlSheet.Cells(HROW, COL_NONPOUND).Value = "Non Pound Transform"&vbCrLf&"(Database Diff)"
XlSheet.Cells(HROW, COL_POUND).Value = "Pound Transform"&vbCrLf&"(Patch Specific Tables)"
Case "ObsoletedPatches"
sTName = "TableObsoleted" & sGuid
XlSheet.Columns(1).VerticalAlignment = xlTop
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium4"
Case "MsiPatchSequence"
sTName = "TableMsiPatchSequence" & sGuid
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium4"
XlSheet.Columns.Autofit
XlSheet.Cells(HROW, SEQ_ATTRIBUTE).Value = "Attribute"&vbCrLf&"(Supersedence Flag)"
XlSheet.Rows.Autofit
Case "MsiPatchMetaData"
sTName = "TableMsiPatchMetaData" & sGuid
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium4"
Case "PatchTargets"
sTName = "TablePatchTargets" & sGuid
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = sTName
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium4"
Case "File_Table"
sTName = "TableFiles" & sGuid
iRowCnt = XlSheet.Cells(1, 1).CurrentRegion.Rows.Count
sRange = "$A$1:"&XlSheet.Cells(iRowCnt,F_SEQUENCE).Address
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.Range(sRange), , xlYes).Name = sTName
XlSheet.ListObjects(sTName).TableStyle = "TableStyleMedium2"
If fDeepScan Then
sRange = XLSheet.Cells(1,F_PREDICTED).Address&":"&XLSheet.Cells(iRowCnt,F_FILEPATH).Address
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.Range(sRange), , xlYes).Name = "ThisComputerFiles"
XlSheet.ListObjects("ThisComputerFiles").TableStyle = "TableStyleMedium4"
End If 'fDeepScan
Case Else
XlSheet.ListObjects.Add(xlSrcRange, XlSheet.UsedRange, , xlYes).Name = XlSheet.Name
XlSheet.ListObjects(XlSheet.Name).TableStyle = "TableStyleMedium2"
End Select
Next 'XlSheet
End Sub 'MakeWkbkLookPretty
'=======================================================================================================
Sub MspDeepScan (MspDb,dicMspFile,XlSheet)
Dim Prod,Session,SessionDb,Record,Component,File
Dim sPatchTargets,sTargetPath,sFileName,sComponent,sComponentId,sComponentClients
Dim sDirectory,CompClient,Ftk,sFullFileName,sKeyPath,sVersionKeyPath,sCurVer,sLfn
Dim fFound,fAllFound,fCompLocal,fKeyPathLow,fPatchFileVersionLow,fCopyPatchFile
Dim fUserModified,fFileNotFound
Dim dicDirectory,dicFtkFile,dicAssembly,dicTables,dicFtkComp,dicCompDir,dicCompComp
Dim dicComponents,dicKeypathConflict
Dim qView
Dim iRow,iCmp
fAllFound = False
fFound = False
oMsi.UILevel = 2 'None
Set dicDirectory = CreateObject("Scripting.Dictionary")
Set dicTables = CreateObject("Scripting.Dictionary")
Set dicAssembly = CreateObject("Scripting.Dictionary")
Set dicFtkComp = CreateObject("Scripting.Dictionary")
Set dicFtkFile = CreateObject("Scripting.Dictionary")
Set dicCompDir = CreateObject("Scripting.Dictionary")
Set dicCompComp = CreateObject("Scripting.Dictionary")
Set dicKeypathConflict = CreateObject("Scripting.Dictionary")
Set dicComponents = CreateObject("Scripting.Dictionary")
'Get the PatchTargets
sPatchTargets = MspDb.SummaryInformation.Property(PID_TEMPLATE)
'Enum installed clients to build the reference dictionaries
For Each Prod in oMsi.Products
If InStr(sPatchTargets,Prod)>0 Then
'Found a targeted product
fFound = True
'Create the session object
Set Session = oMsi.OpenProduct(Prod)
Session.DoAction("CostInitialize")
Session.DoAction("FileCost")
Session.DoAction("CostFinalize")
Set SessionDb = Session.Database
'Get a list of available tables
dicTables.RemoveAll
Set qView = Nothing
Set qView = SessionDb.OpenView("SELECT `Name` FROM `_Tables` ORDER BY `Name`")
qView.Execute
Do
Set Record = qView.Fetch
If Record Is Nothing then Exit Do
If Not dicTables.Exists(Record.StringData(1)) Then dicTables.Add Record.StringData(1),""
Loop
qView.Close
If dicTables.Exists("File") Then
Set qView = Nothing
Set qView = SessionDb.OpenView("SELECT `File`,`Component_`,`FileName` FROM File")
qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
If Not dicFtkComp.Exists(Record.StringData(1)) Then dicFtkComp.Add Record.StringData(1),Record.StringData(2)
If Not dicFtkFile.Exists(Record.StringData(1)) Then dicFtkFile.Add Record.StringData(1),Record.StringData(3)
Set Record = qView.Fetch
Loop
qView.Close
End If 'File
If dicTables.Exists("Component") Then
Set qView = Nothing
Set qView = SessionDb.OpenView("SELECT `Component`,`ComponentId`,`Directory_` FROM Component")
qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
If Not dicCompComp.Exists(Record.StringData(1)) Then dicCompComp.Add Record.StringData(1),Record.StringData(2)
If Not dicCompDir.Exists(Record.StringData(1)) Then dicCompDir.Add Record.StringData(1),Record.StringData(3)
Set Record = qView.Fetch
Loop
qView.Close
End If 'Component
If dicTables.Exists("Directory") Then
Set qView = Nothing
Set qView = SessionDb.OpenView("SELECT DISTINCT `Directory` FROM Directory")
qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
If Not dicDirectory.Exists(Record.Stringdata(1)) Then
sTargetPath = "" : sTargetPath = Session.TargetPath(Record.Stringdata(1))
If NOT sTargetPath="" Then dicDirectory.Add Record.Stringdata(1)&"_"&Prod,sTargetPath
End If
Set Record = qView.Fetch
Loop
qView.Close
End If 'Directory
If dicTables.Exists("MsiAssembly") Then
Set qView = Nothing
Set qView = SessionDb.OpenView("SELECT `Component_` FROM `MsiAssembly`")
qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
If Not dicAssembly.Exists(Record.StringData(1)) Then dicAssembly.Add Record.StringData(1),""
Set Record = qView.Fetch
Loop
qView.Close
End If 'MsiAssembly
If dicTables.Exists("SxsMsmGenComponents") Then
Set qView = Nothing
Set qView = SessionDb.OpenView("SELECT `Component_` FROM SxsMsmGenComponents")
qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
If Not dicAssembly.Exists(Record.StringData(1)) Then dicAssembly.Add Record.StringData(1),""
Set Record = qView.Fetch
Loop
qView.Close
End If 'SxsMsmGenComponents
Set SessionDb = Nothing
Set Session = Nothing
End If 'Prod found
Next 'Prod
If NOT fFound Then
fDeepScan = False
Exit Sub
End If
XlSheet.Cells(HROW,F_PREDICTED).Value = "Predicted Action"
XlSheet.Cells(HROW,F_COMPSTATE).Value = "ComponentState"
XlSheet.Cells(HROW,F_CURSIZE).Value = "FileSize On Disk"
XlSheet.Cells(HROW,F_CURVERSION).Value = "Version On Disk"
XlSheet.Cells(HROW,F_CURHASH).Value = "Hash On Disk"
XlSheet.Cells(HROW,F_FILEPATH).Value = "FilePath"
For Each Component in oMsi.Components
dicComponents.Add Component,""
Next 'Component
'For Each Ftk in dicMspFile.Keys
For iRow = 2 To XlSheet.Columns(F_FILE).CurrentRegion.Rows.Count
Ftk = XlSheet.Cells(iRow,F_FILE).Value
fCompLocal = False
fKeyPathLow = False
fPatchFileVersionLow = False
fCopyPatchFile = False
XlSheet.Cells(iRow,F_COMPSTATE).Value = "Unknown Component"
'Get ComponentID
If dicFtkComp.Exists(Ftk) Then
'This is a known file
sComponent = ""
sComponent = dicFtkComp.Item(Ftk)
If XlSheet.Cells(iRow,F_COMPONENT) = "" Then XlSheet.Cells(iRow,F_COMPONENT) = sComponent
'Since it's known it has the filenmae entry listed as well
sFileName = ""
sFileName = dicFtkFile.Item(Ftk)
If XlSheet.Cells(iRow,F_FILENAME) = "" Then XlSheet.Cells(iRow,F_FILENAME) = sFileName
sComponentId = ""
sComponentId = dicCompComp.Item(sComponent)
If dicComponents.Exists(sComponentId) Then
sKeyPath = ""
sComponentClients = ""
For Each CompClient in oMsi.ComponentClients(sComponentId)
If InStr(sPatchTargets,CompClient)>0 Then
sComponentClients = sComponentClients &","& CompClient
If oMsi.Product(CompClient,"",4).ComponentState(sComponentId) = INSTALLSTATE_LOCAL Then
fCompLocal = True
sKeyPath = oMsi.ComponentPath(CompClient,sComponentId)
Prod = CompClient
End If
End If
Next 'CompClient
On Error Goto 0
If fCompLocal Then XlSheet.Cells(iRow,F_COMPSTATE).Value = "Local" Else XlSheet.Cells(iRow,F_COMPSTATE).Value = "Not Used"
sDirectory = ""
sDirectory = dicDirectory.Item(dicCompDir.Item(sComponent)&"_"&Prod)
sFullFileName = ""
sLfn = ""
If InStr(sFileName,"|")>0 Then sLfn = Mid(sFileName,InStr(sFileName,"|")+1) Else sLfn = sFileName
If dicAssembly.Exists(sComponent) Then
sFullFileName=GetAssemblyPath(sLfn,sKeyPath,sDirectory)
End If
If sFullFileName="" Then sFullFileName = sDirectory & sLfn
XlSheet.Cells(iRow,F_FILEPATH).Value = sFullFileName
sCurVer = ""
iCmp = 2
If fCompLocal Then
fFileNotFound = NOT oFso.FileExists(sFullFileName)
If NOT fFileNotFound Then
Set File = oFso.GetFile(sFullFileName)
sCurVer = oFso.GetFileVersion(sFullFileName)
If NOT sCurVer = "" Then XlSheet.Cells(iRow,F_CURVERSION).Value = sCurVer Else XlSheet.Cells(iRow,F_CURHASH).Value = GetMsiFileHash(sFullFileName)
XlSheet.Cells(iRow,F_CURSIZE).Value = File.Size
iCmp = CompareVersion(XlSheet.Cells(iRow,F_VERSION).Value,sCurVer,True)
Select Case iCmp
Case -1
XlSheet.Cells(iRow,F_PREDICTED).Value = "Don't Update - Existing file has a newer version"
Case 0
If sCurVer = "" Then
'This is an unversioned file.
fUserModified = False
fUserModified = NOT(File.DateCreated = File.DateLastModified)
If fUserModified Then
XlSheet.Cells(iRow,F_PREDICTED).Value = "Don't Update - Existing file is unversioned but modified"
Else
If XlSheet.Cells(iRow,F_HASH).Value = XlSheet.Cells(iRow,F_CURHASH).Value Then
If XlSheet.Cells(iRow,F_CURHASH).Value = "" Then
XlSheet.Cells(iRow,F_PREDICTED).Value = "Update - Existing file is unversioned and unmodified - no source file hash provided to compare"
Else
XlSheet.Cells(iRow,F_PREDICTED).Value = "Don't Update - Hash matches existing file"
End If
Else
XlSheet.Cells(iRow,F_PREDICTED).Value = "Update - Hash does not match existing file"
End If 'Hash
End If 'UserModified
Else
XlSheet.Cells(iRow,F_PREDICTED).Value = "Don't Update - Existing file is of an equal version"
End If
Case 1
XlSheet.Cells(iRow,F_PREDICTED).Value = "Update - Existing file is of a lower version"
Case 2
End Select
'Check on keypath version conflict
'If a versioned keypath does not have a higher version
'no files of the component will be considered for patching
If Not dicKeypathConflict.Exists(sComponent) Then
If LCase(sKeyPath) = LCase(sFullFileName) Then
sVersionKeyPath = ""
sVersionKeyPath = oFso.GetFileVersion(sKeyPath)
If NOT (CompareVersion(XlSheet.Cells(iRow,F_VERSION).Value,sVersionKeyPath,True)=1) Then
dicKeypathConflict.Add sComponent,sVersionKeyPath
End If
End If
End If
Else
'The component is set to local but the file could not be found
'No prediction possible. Leave this field blank
End If 'fFileNotFound
Else
XlSheet.Cells(iRow,F_PREDICTED).Value = "Not Installed"
End If 'fCompLocal
End If 'dicComponents.Exist
Else
'Not a known file (added by patch or not part of installed SKU's)
End If
Next 'iRow
If dicKeypathConflict.Count > 0 Then
For iRow = 2 To XlSheet.Columns(F_FILE).CurrentRegion.Rows.Count
If dicKeyPathConflict.Exists(XlSheet.Cells(iRow,F_COMPONENT).Value) Then
If XlSheet.Cells(iRow,F_PREDICTED).Value = "Update - Existing file is of a lower version" Then _
XlSheet.Cells(iRow,F_PREDICTED).Value = "Don't Update - Existing KeyPath file has a newer version"
End If
Next 'iRow
End If 'dicKeypathConflict
End Sub 'MspDeepScan
'=======================================================================================================
'Apply the _Transform view
'Create the File table view
'Add the data to the XlSheet
Sub FillTables(XlWkbk,XlSheet,MspDb,sMspFile,dicFiles,fOfficePatch,XmlDoc)
Dim Record,dicTransforms,dicKeys,tbl,Prod,MsiDb,Element,Elements,key
Dim dicLoadedTables
Dim qView
Dim sMst,sKey,sSqlCreateTable,sPatchTargets,sProduct,sProductTarget
Dim i,iRow,iMstCnt
Dim arrTables,arrColHeaders,arrPatchMst
iRow = 1
'File table columns
XlSheet.Cells(iRow,F_FILE) = "File"
XlSheet.Cells(iRow,F_COMPONENT) = "Component_"
XlSheet.Cells(iRow,F_FILENAME) = "FileName"
XlSheet.Cells(iRow,F_FILESIZE) = "FileSize"
XlSheet.Cells(iRow,F_VERSION) = "Version"
XlSheet.Cells(iRow,F_HASH) = "Hash"
XlSheet.Cells(iRow,F_LANGUAGE) = "Language"
XlSheet.Cells(iRow,F_ATTRIBUTE) = "Attributes"
XlSheet.Cells(iRow,F_SEQUENCE) = "Sequence"
'Get the PatchTargets
sPatchTargets = MspDb.SummaryInformation.Property(PID_TEMPLATE)
Set dicLoadedTables = CreateObject("Scripting.Dictionary")
'The CustomAction table view has already been created for Office patches
'If fOfficePatch Then dicLoadedTables.Add "CustomAction","CustomAction"
'Try to dynamically obtain the schema from installed products
For Each Prod in oMsi.Products
If InStr(sPatchTargets,Prod)>0 Then
Set MsiDb = oMsi.OpenDatabase(oMsi.ProductInfo(Prod,"LocalPackage"),MSIOPENDATABASEMODE_READONLY)
arrTables = Split(GetDatabaseTables(MsiDb),",")
For Each tbl in arrTables
If NOT dicLoadedTables.Exists(tbl) Then
dicLoadedTables.Add tbl,Prod
sSqlCreateTable = "CREATE TABLE `" & tbl &"` (" & GetTableColumnDef(MsiDb,tbl) & " PRIMARY KEY " & GetPrimaryTableKeys(MsiDb,tbl) &")"
If NOT dicSqlCreateTbl.Exists(tbl) Then dicSqlCreateTbl.Add tbl,sSqlCreateTable
MspDb.OpenView(sSqlCreateTable).Execute
If tbl = "File" Then
fNeedGenericSql = False
End If
End If
Next 'tbl
End If
Next 'Prod
If fNeedGenericSql Then
If NOT MsiProvidedAsFile(MsiDb,MspDb,sMspFile,arrTables,dicLoadedTables) Then
sProduct = ""
sProduct = Right(Left(sPatchTargets,38),17)
Select Case sProduct
Case "CFE-0150048383C9}","CFE-0050048383C9}","60F-006097C998E7}" 'O11,O10,O09
sSqlCreateTable = "CREATE TABLE `File` (`File` CHAR(72) NOT NULL, `Component_` CHAR(72) NOT NULL, `FileName` CHAR(255) NOT NULL LOCALIZABLE, `FileSize` LONG NOT NULL, `Version` CHAR(72), `Language` CHAR(20), `Attributes` SHORT, `Sequence` SHORT NOT NULL PRIMARY KEY `File`)"
Case Else
'Create the generic file table view
sSqlCreateTable = SQL_CREATEFILETABLE
End Select
MspDb.OpenView(sSqlCreateTable).Execute
Else
fNeedGenericSql = False
End If 'NOT MsiProvidedAsFile
End If
'Get the patch embedded transforms
Set dicTransforms = CreateObject("Scripting.Dictionary")
Set qView = MspDb.OpenView("SELECT `Name` FROM `_Storages` ORDER BY `Name`") : qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
dicTransforms.Add Record.StringData(1),Record.StringData(1)
Set Record = qView.Fetch
Loop
qView.Close
'Apply the patch transforms to the patch itself
dicKeys = dicTransforms.Keys
On Error Resume Next
For Each sMst in dicTransforms.Keys
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
Next 'iMst
On Error Goto 0
'The file table is key thus handled in a dedicated loop
'——————————————————
Set qView = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table` = 'File' ORDER BY `Row`")
qView.Execute()
Set Record = qView.Fetch
iRow = 2 : sKey = ""
'Get the first FTK
If NOT Record Is Nothing Then
sKey = Record.StringData(3)
dicFiles.Add sKey,""
End If
XlSheet.Cells(iRow,F_FILE) = sKey
Do Until Record Is Nothing
'Next FTK?
If NOT sKey = Record.StringData(3) Then
iRow = iRow + 1
sKey = Record.StringData(3)
dicFiles.Add sKey,""
XlSheet.Cells(iRow,F_FILE) = sKey
End If
'Add data from _TransformView
Select Case Record.StringData(2)
Case "File"
'XlSheet.Cells(iRow,F_FILE) = Record.StringData(4)
Case "FileSize"
XlSheet.Cells(iRow,F_FILESIZE) = Record.StringData(4)
Case "Component_"
XlSheet.Cells(iRow,F_COMPONENT) = Record.StringData(4)
Case "CREATE"
Case "DELETE"
Case "DROP"
Case "FileName"
XlSheet.Cells(iRow,F_FILENAME) = Record.StringData(4)
dicFiles.Item(sKey) = Record.StringData(4)
Case "Version"
XlSheet.Cells(iRow,F_VERSION) = Record.StringData(4)
Case "Language"
XlSheet.Cells(iRow,F_LANGUAGE) = Record.StringData(4)
Case "Attributes"
XlSheet.Cells(iRow,F_ATTRIBUTE) = Record.StringData(4)
Case "Sequence"
XlSheet.Cells(iRow,F_SEQUENCE) = Record.StringData(4)
Case "INSERT"
Case Else
End Select
Set Record = qView.Fetch
Loop
'Only possible if the schema could be obtained
If fNeedGenericSql Then Exit Sub
'Handle all other tables per product
'———————-
'drop all tables
'create all tables
'only apply the patch embedded transform pair that targets the product
'Handle .msi files provided in the patch folder
If fMsiProvidedAsFile Then
Dim f,File,Folder
Set File = oFso.GetFile(sMspFile)
Set Folder = oFso.GetFolder(File.ParentFolder)
'Check if we have a valid .msi file in the .msp folder location
For Each f in Folder.Files
If Right(LCase(f),4)=".msi" Then
Prod = GetMsiProductCode(f.Path)
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
i = 0
For Each Element in Elements
i = i + 1
If Prod = Element.selectSingleNode("TargetProductCode").text Then
'Drop all tables
On Error Resume Next
Set MsiDb = oMsi.OpenDatabase(f.Path,MSIOPENDATABASEMODE_READONLY)
arrTables = Split(GetDatabaseTables(MsiDb),",")
For Each tbl in arrTables
MspDb.OpenView("DROP TABLE `"&tbl&"`").Execute
Next 'tbl
'Recreate all tables
For Each tbl in arrTables
MspDb.OpenView(dicSqlCreateTbl.Item(tbl)).Execute
Next 'tbl
On Error Goto 0
iMstCnt = 0
For Each sMst in dicTransforms.Keys
iMstCnt = iMstCnt + 1
If (iMstCnt = i) Then
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
ElseIf (iMstCnt = i + 1) Then
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
Exit For
End If
Next 'iMst
FillTablesEx Prod,MsiDb,MspDb,XlWkbk,XlSheet,arrTables,arrColHeaders
Exit For
End If 'Prod
Next 'Element
End If
Next 'f
End If 'fMsiProvidedAsFile
'Handle installed products
For Each Prod in oMsi.Products
If InStr(sPatchTargets,Prod)>0 Then
'Drop all tables
On Error Resume Next
Set MsiDb = oMsi.OpenDatabase(oMsi.ProductInfo(Prod,"LocalPackage"),MSIOPENDATABASEMODE_READONLY)
arrTables = Split(GetDatabaseTables(MsiDb),",")
For Each tbl in arrTables
MspDb.OpenView("DROP TABLE `"&tbl&"`").Execute
Next 'tbl
'Recreate all tables
For Each tbl in arrTables
MspDb.OpenView(dicSqlCreateTbl.Item(tbl)).Execute
Next 'tbl
On Error Goto 0
sMst = Mid(dicProdMst.Item(Prod),2)
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
MspDb.ApplyTransform ":#" & sMst,MSITRANSFORMERROR_ALL
FillTablesEx Prod,MsiDb,MspDb,XlWkbk,XlSheet,arrTables,arrColHeaders
End If 'InStr
Next 'Prod
End Sub 'FillTables
'=======================================================================================================
Sub FillTablesEx (Prod,MsiDb,MspDb,XlWkbk,XlSheet,arrTables,arrColHeaders)
Dim tbl,Col,Record,sheet
Dim sKey,sPreFix
Dim iRow,iCol,i
Dim qView
Dim fExists
Select Case GetVersionMajor(Prod)
Case 9, 10, 11
sPreFix = Mid(Prod,4,2)
Case 12, 14
sPreFix = Mid(Prod,11,4)
End Select
For Each tbl in arrTables
If NOT tbl = "File" Then
Set arrColHeaders = Nothing
arrColHeaders = Split(GetTableColumnHeaders(MsiDb,tbl),",")
If IsArray(arrColHeaders) Then
If UBound(arrColHeaders)>0 Then
'Create a new sheet
For Each sheet in XlWkbk.Worksheets
If Left(sPreFix&"_"&tbl,31) = sheet.name Then fExists = True
Next 'sheet
If NOT fExists Then
Set XlSheet = XlWkbk.Worksheets.Add
XlSheet.Name = Left(sPreFix&"_"&tbl,31)
XlSheet.Move ,XlWkbk.Sheets(XlWkbk.Sheets.Count)
iRow = 1 : iCol = 1 : i = 0
'Fill the header row
For Each Col in arrColHeaders
XlSheet.Cells(iRow,i+1) = arrColHeaders(i)
i=i+1
Next 'Col
'Initiate the view
Set qView = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table` = '"&tbl&"' ORDER BY `Row`")
qView.Execute()
Set Record = qView.Fetch
i = 0 : iRow = 2 : sKey = ""
'Get the first Row
If NOT Record Is Nothing Then
sKey = Record.StringData(3)
XlSheet.Cells(iRow,1) = Record.StringData(3)
Else
XlSheet.Delete
End If
'XlSheet.Cells(iRow,F_FILE) = sKey
Do Until Record Is Nothing
'Next Row?
If NOT sKey = Record.StringData(3) Then
iRow = iRow + 1
sKey = Record.StringData(3)
XlSheet.Cells(iRow,1) = Record.StringData(3)
End If
'Add data from _TransformView
iCol = 0
For Each Col in arrColHeaders
iCol=iCol+1
If Record.StringData(2) = Col Then
XlSheet.Cells(iRow,iCol) = Record.StringData(4)
Exit For
End If
Next 'Col
Set Record = qView.Fetch
Loop
End If 'fExists
End If 'UBound
End If 'IsArray
End If
Next 'tbl
End Sub 'FillTablesEx
'=======================================================================================================
Function MsiProvidedAsFile(MsiDb,MspDb,sMspFile,arrTables,dicLoadedTables)
Dim f,File,Folder,Prod,tbl
Dim sSqlCreateTable,sPatchTargets
MsiProvidedAsFile = False
Set File = oFso.GetFile(sMspFile)
Set Folder = oFso.GetFolder(File.ParentFolder)
'Check if we have a valid .msi file in the .msp folder location
For Each f in Folder.Files
If Right(LCase(f),4)=".msi" Then
Prod = GetMsiProductCode(f.Path)
sPatchTargets = MspDb.SummaryInformation.Property(PID_TEMPLATE)
If InStr(sPatchTargets,Prod)>0 Then
MsiProvidedAsFile = True
fMsiProvidedAsFile = True
sExternalMsi = f.Path
Set MsiDb = oMsi.OpenDatabase(f.Path,MSIOPENDATABASEMODE_READONLY)
arrTables = Split(GetDatabaseTables(MsiDb),",")
For Each tbl in arrTables
If NOT dicLoadedTables.Exists(tbl) Then
dicLoadedTables.Add tbl,Prod
sSqlCreateTable = "CREATE TABLE `" & tbl &"` (" & GetTableColumnDef(MsiDb,tbl) & " PRIMARY KEY " & GetPrimaryTableKeys(MsiDb,tbl) &")"
If NOT dicSqlCreateTbl.Exists(tbl) Then dicSqlCreateTbl.Add tbl,sSqlCreateTable
MspDb.OpenView(sSqlCreateTable).Execute
End If
Next 'tbl
End If 'Prod
End If '.msi
Next 'f
End Function 'MsiProvidedAsFile
'=======================================================================================================
Sub AddTransformProductName (dicTransformRow,MspDb)
End Sub 'AddTransformProductName
'=======================================================================================================
Sub ExtendTransformTable (XlSheet,dicTransformRow,MspDb)
Dim Record,dicTransforms,dicKeys
Dim qView
Dim sMst,sKey,sSource,sTarget,sSqlCreateTable
Dim iRow,iCol
Dim fAdd
XlSheet.Cells(1,3).Value = "REINSTALLMODE"
XlSheet.Cells(1,4).Value = "REINSTALL"
XlSheet.Cells(1,5).Value = "PATCHNEWSUMMARYSUBJECT"
XlSheet.Cells(1,6).Value = "PATCHNEWSUMMARYCOMMENTS"
'Get the patch embedded transforms
Set dicTransforms = CreateObject("Scripting.Dictionary")
Set qView = MspDb.OpenView("SELECT `Name` FROM `_Storages` ORDER BY `Name`") : qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
dicTransforms.Add Record.StringData(1),Record.StringData(1)
Set Record = qView.Fetch
Loop
qView.Close
'Apply the patch transforms to the patch itself
dicKeys = dicTransforms.Keys
'Prepare CustomAction table query
sSqlCreateTable = SQL_CREATECATABLE
If dicSqlCreateTbl.Exists("CustomAction") Then sSqlCreateTable = dicSqlCreateTbl.Item("CustomAction")
For Each sMst in dicTransforms.Keys
'Only care about non pound transforms
If NOT InStr(sMst,"#")>0 Then
'Create the CustomAction table view
MspDb.OpenView(sSqlCreateTable).Execute
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
MspDb.ApplyTransform ":#" & sMst,MSITRANSFORMERROR_ALL
iRow = dicTransformRow.Item(":"&sMst)
sKey = "" : sSource = "" : sTarget = ""
fAdd = False
Set qView = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table` = 'CustomAction' ORDER BY `Row`")
qView.Execute()
Set Record = qView.Fetch
'Get the first key
If NOT Record Is Nothing Then
sKey = Record.StringData(3)
End If
Do Until Record Is Nothing
'Next key
If NOT sKey = Record.StringData(3) Then
If fAdd Then
If XlSheet.Cells(iRow,iCol).Value = "" Then XlSheet.Cells(iRow,iCol).Value = sTarget
End If
sKey = Record.StringData(3)
sSource = "" : sTarget = ""
fAdd = False
End If
'Add data from _TransformView
Select Case Record.StringData(2)
Case "Action"
Case "Type"
Case "Source"
sSource = Record.StringData(4)
If sSource = "REINSTALLMODE" Then fAdd = True
If sSource = "REINSTALL" Then fAdd = True
If fAdd AND sSource = "REINSTALL" Then iCol=4 Else iCol=3
Case "Target"
sTarget = Record.StringData(4)
Case Else
End Select
Set Record = qView.Fetch
Loop
If fAdd Then
If XlSheet.Cells(iRow,iCol).Value = "" Then XlSheet.Cells(iRow,iCol).Value = sTarget
End If
MspDb.OpenView("DROP TABLE `CustomAction`").Execute
End If 'non pound
Next 'sMst
For Each sMst in dicTransforms.Keys
'Only care about pound transforms
If InStr(sMst,"#")>0 Then
'Create the Propery table view
sSqlCreateTable = SQL_CREATEPROPTABLE
If dicSqlCreateTbl.Exists("Property") Then sSqlCreateTable = dicSqlCreateTbl.Item("Property")
MspDb.OpenView(sSqlCreateTable).Execute
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
iRow = dicTransformRow.Item(":"&sMst)
sKey = "" : sSource = "" : sTarget = ""
fAdd = False
Set qView = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table` = 'Property' ORDER BY `Row`")
qView.Execute()
Set Record = qView.Fetch
'Get the first key
If NOT Record Is Nothing Then
sKey = Record.StringData(3)
End If
Do Until Record Is Nothing
'Next key
If NOT sKey = Record.StringData(3) Then
If fAdd Then
If XlSheet.Cells(iRow,iCol).Value = "" Then XlSheet.Cells(iRow,iCol).Value = sTarget
End If
sKey = Record.StringData(3)
sSource = "" : sTarget = ""
fAdd = False
End If
'Add data from _TransformView
Select Case Record.StringData(2)
Case "Value"
If sKey = "PATCHNEWSUMMARYSUBJECT" Then fAdd = True
If sKey = "PATCHNEWSUMMARYCOMMENTS" Then fAdd = True
If fAdd AND sKey = "PATCHNEWSUMMARYCOMMENTS" Then iCol=6 Else iCol=5
If fAdd Then sTarget = Record.StringData(4)
Case Else
End Select
If fAdd Then
If XlSheet.Cells(iRow,iCol).Value = "" Then XlSheet.Cells(iRow,iCol).Value = sTarget
fAdd = False
End If
Set Record = qView.Fetch
Loop
MspDb.OpenView("DROP TABLE `Property`").Execute
End If
Next 'sMst
End Sub 'ExtendTransformTable
'=======================================================================================================
Sub AddMspHashes (XlWkbk)
Dim Sheet,XlSheet
Dim dicFileRow
Dim sFile
Dim iF_Row,iRow
For Each Sheet in XlWkbk.Sheets
If Sheet.Name = "MsiFileHash_Table" Then
'Buid a file dic
Set dicFileRow = CreateObject("Scripting.Dictionary")
Set XlSheet = XlWkbk.Sheets("File_Table")
For iF_Row = 2 To XlSheet.Columns(F_FILE).CurrentRegion.Rows.Count
dicFileRow.Add XlSheet.Cells(iF_Row,F_FILE).Value,iF_Row
Next 'iF_Row
'Add the file hashes
For iRow = 2 To Sheet.Columns(F_FILE).CurrentRegion.Rows.Count
sFile = ""
sFile = Sheet.Cells(iRow,F_FILE).Value
If dicFileRow.Exists(sFile) Then
iF_Row = dicFileRow.Item(sFile)
XlSheet.Cells(iF_Row,F_HASH).Value = Sheet.Cells(iRow,3).Value&","&Sheet.Cells(iRow,4).Value&","&Sheet.Cells(iRow,5).Value&","&Sheet.Cells(iRow,6).Value
End If
Next 'iRow
End If
Next 'XlSheet
End Sub 'AddMspHashes
'=======================================================================================================
Sub AddFileNames (XlWkbk)
Dim XlSheet,MsiDb,Record
Dim dicFtkSize,dicTables,dicFtkFile
Dim qView
Dim sFileName,sFtk
Dim iRow
Set dicTables = CreateObject("Scripting.Dictionary")
Set dicFtkFile = CreateObject("Scripting.Dictionary")
Set dicFtkSize = CreateObject("Scripting.Dictionary")
Set MsiDb = oMsi.OpenDatabase(sExternalMsi,MSIOPENDATABASEMODE_READONLY)
'Get a list of available tables
Set qView = Nothing
Set qView = MsiDb.OpenView("SELECT `Name` FROM `_Tables` ORDER BY `Name`")
qView.Execute
Do
Set Record = qView.Fetch
If Record Is Nothing then Exit Do
If Not dicTables.Exists(Record.StringData(1)) Then dicTables.Add Record.StringData(1),""
Loop
qView.Close
If dicTables.Exists("File") Then
Set qView = Nothing
Set qView = MsiDb.OpenView("SELECT `File`,`FileSize`,`FileName` FROM File")
qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
If Not dicFtkSize.Exists(Record.StringData(1)) Then dicFtkSize.Add Record.StringData(1),Record.StringData(2)
If Not dicFtkFile.Exists(Record.StringData(1)) Then dicFtkFile.Add Record.StringData(1),Record.StringData(3)
Set Record = qView.Fetch
Loop
qView.Close
End If 'File
For Each XlSheet in XlWkbk.Sheets
If XlSheet.Name = "File_Table" Then
For iRow = 2 To XlSheet.Columns(F_FILE).CurrentRegion.Rows.Count
sFtk = XlSheet.Cells(iRow,F_FILE).Value
If dicFtkFile.Exists(sFtk) Then
sFileName = ""
sFileName = dicFtkFile.Item(sFtk)
If XlSheet.Cells(iRow,F_FILENAME) = "" Then XlSheet.Cells(iRow,F_FILENAME) = sFileName
End If
If dicFtkSize.Exists(sFtk) Then
sFileName = ""
sFileName = dicFtkSize.Item(sFtk)
If XlSheet.Cells(iRow,F_FILESIZE) = "" Then XlSheet.Cells(iRow,F_FILESIZE) = sFileName
End If
Next
End If
Next 'XlSheet
End Sub 'AddFileNames
'=======================================================================================================
'Windows Installer Helper Routines
'———————————
'=======================================================================================================
'Scans for a dynamic (optimized) SUPdateLocation folder structure
'Builds a global dictionary with identified folders
Sub DiscoverDynSUpdateFolders
Dim Product
Dim sRelPath, sCulture
Set dicDynCultFolders = CreateObject("Scripting.Dictionary")
For Each Product in oMsi.Products
If Len(Product) = 38 Then
If IsOfficeProduct(Product) Then
sRelPath = ""
sRelPath = GetVersionMajor(Product) & ".0"
Select Case sRelPath
Case "9.0","10.0","11.0"
sCulture = LCase(GetCultureInfo(CInt("&h" & Mid(Product,6,4))))
Case "12.0","14.0"
sCulture = LCase(GetCultureInfo(CInt("&h" & Mid(Product,16,4))))
If Mid(Product,11,1) = "1" Then sRelPath = sRelPath & "\Server" Else sRelPath = sRelPath & "\Client"
If Mid(Product,21,1) = "1" Then sRelPath = sRelPath & "\x64" Else sRelPath = sRelPath & "\x86"
Case Else
End Select
If sCulture = "neutral" Then sCulture = "x-none"
sRelPath = sRelPath & "\" & sCulture
If NOT sCulture = "" Then
If NOT dicDynCultFolders.Exists(sCulture) Then dicDynCultFolders.Add sCulture,sCulture
End If
End If 'IsOfficeProduct
End If '38
Next 'Product
fDynSUpdateDiscovered = True
End Sub 'DiscoverSUpdateFolders
'=======================================================================================================
'Returns a boolean to determine if Excel is installed on the computer
Function XLInstalled()
Dim Product
XLInstalled = False
For Each Product In oMsi.Products
If oMsi.FeatureState(Product,"EXCELFiles") = MSIINSTALLSTATE_LOCAL Then
XLInstalled = True : Exit For
End If
Next 'Product
End Function
'=======================================================================================================
'Returns the Msi file hash values as comma separated string list
Function GetMsiFileHash(sFullFileName)
Dim Record
On Error Resume Next
GetMsiFileHash = ""
Set Record = oMsi.FileHash(sFullFileName,0)
GetMsiFileHash = Record.StringData(1)&","&Record.StringData(2)&","&Record.StringData(3)&","&Record.StringData(4)
End Function
'=======================================================================================================
'Obtain the ProductCode (GUID) from a .msi package
'The function will open the .msi database and query the 'Property' table to retrieve the ProductCode
Function GetMsiProductCode(sMsiFile)
Dim MsiDb,Record
Dim qView
On Error Resume Next
GetMsiProductCode = ""
Set Record = Nothing
Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEMODE_READONLY)
Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductCode'")
qView.Execute
Set Record = qView.Fetch
GetMsiProductCode = Record.StringData(1)
qView.Close
End Function 'GetMsiProductCode
'=======================================================================================================
'Obtain the ProductVersion from a .msi package
'The function will open the .msi database and query the 'Property' table to retrieve the ProductCode
Function GetMsiProductVersion(sMsiFile)
Dim MsiDb,Record
Dim qView
On Error Resume Next
GetMsiProductVersion = ""
Set Record = Nothing
Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEMODE_READONLY)
Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductVersion'")
qView.Execute
Set Record = qView.Fetch
If NOT Record Is Nothing Then GetMsiProductVersion = Record.StringData(1)
qView.Close
End Function 'GetMsiProductVersion
'=======================================================================================================
'Obtain the PackageCode (GUID) from a .msi package
'The function will the .msi'S SummaryInformation stream
Function GetMsiPackageCode(sMsiFile)
On Error Resume Next
GetMsiPackageCode = ""
GetMsiPackageCode = oMsi.SummaryInformation(sMsiFile,MSIOPENDATABASEMODE_READONLY).Property(PID_REVNUMBER)
End Function 'GetMsiPackageCode
'=======================================================================================================
'Returns a string with the patch sequence data
Function GetLegacyMspSeq(Msp)
Dim i
Dim sSeq
Dim arrTitle
sSeq = ""
arrTitle = Split(Msp.SummaryInformation.Property(PID_TITLE),";")
If IsArray(arrTitle) Then
If UBound(arrTitle)>1 Then
sSeq = arrTitle(2)
For i = 1 To Len(sSeq)
If NOT (Asc(Mid(sSeq,i,1)) >= 48 AND Asc(Mid(sSeq,i,1)) <= 57) Then
sSeq = ""
Exit For
End If
Next 'i
End If
End If
GetLegacyMspSeq = sSeq
End Function 'GetMspSequence
'=======================================================================================================
'Detect the real product build number based on .msi and .msp build information
'to allow verification of the registered build number
Function GetRealBuildVersion(sAppliedPatches,sProductCode)
Dim Element,Elements
Dim sProductVersionReg,sProductVersionMsi
Dim iIndex
On Error Resume Next
sProductVersionReg = oMsi.ProductInfo(sProductCode,"VersionString")
sProductVersionMsi = GetMsiProductVersion(oMsi.ProductInfo(sProductCode,"LocalPackage"))
sProductVersionReal = sProductVersionMsi
For iIndex = 0 To UBound(arrSUpdatesAll)
If (InStr(arrSUpdatesAll(iIndex,COL_TARGETS),sProductCode)>0) Then
If InStr(sAppliedPatches,arrSUpdatesAll(iIndex,COL_PATCHCODE))>0 Then
If IsMinorUpdate(sProductCode,arrSUpdatesAll(iIndex,COL_PATCHXML)) Then
XmlDoc.LoadXml(arrSUpdatesAll(iIndex,COL_PATCHXML))
Set Elements = XmlDoc.GetElementsByTagName("TargetProduct")
For Each Element in Elements
If Element.selectSingleNode("TargetProductCode").text = sProductCode Then
If Element.selectSingleNode("UpdatedVersion").text > sProductVersionReal Then _
sProductVersionReal = Element.selectSingleNode("UpdatedVersion").text
End If
Next 'Element
End If
End If
End If 'InStr(arrSUpdatesAll…
Next 'iIndex
If NOT Err=0 Then GetRealBuildVersion=sProductVersionReg Else GetRealBuildVersion=sProductVersionReal
End Function 'GetRealBuildVersion
'=======================================================================================================
'Checks if a ProductCode belongs to an Office family
Function IsOfficeProduct(sProductCode)
On Error Resume Next
IsOfficeProduct = False
If InStr(OFFICE_ALL, UCase(Right(sProductCode,28))) > 0 OR _
InStr(OFFICEID, UCase(Right(sProductCode,17))) > 0 Then
If Not Err = 0 Then Exit Function
IsOfficeProduct = True
End If
End Function 'IsOfficeProduct
'=======================================================================================================
'Checks if a PatchCode belongs to an Office family
Function IsOfficePatch(sPatchTargets)
Dim arrPatchTargets
Dim Target
On Error Resume Next
IsOfficePatch = False
If NOT Len(sPatchTargets)>1 Then Exit Function
arrPatchTargets = Split(sPatchTargets,";")
For Each Target in arrPatchTargets
If InStr(OFFICE_ALL, UCase(Right(Target,28))) > 0 OR _
InStr(OFFICEID, UCase(Right(Target,17))) > 0 Then
If Not Err = 0 Then Exit Function
IsOfficePatch = True
Exit Function
End If
Next 'Target
End Function 'IsOfficePatch
'==============================================================================================
'Verify Windows Installer metadata are in a healthy state and initiate fixup if needed
Sub EnsurePatchMetadata (Patch,sProductUserSid)
On Error Resume Next
Dim RegItem,Folder,File,RegItems,MspDb,Record
Dim dicTransforms
dim qView
Dim fGlobalConfigPatchExists,fGlobalConfigProductExists,fConfigPatchExists
Dim fConfigProductExists,fLocalPatchPackageDataExist,fNoError
Dim sPatchCodeCompressed,sRegUserSID,sHive,sRegHive,sRegKey,sRegName,sTmp,sProductCode
Dim sProductCodeCompressed,sItem,sLocalMSP,sSqlCreateTable,sMst,sDiskPrompt,sVolumeLabel
Dim sDiskId,sKey,sMspClasses,sPackageName
Dim iContext
fLocalPatchPackageDataExist = False
fGlobalConfigPatchExists = False
fGlobalConfigProductExists = False
fConfigPatchExists = False
fConfigProductExists = False
fNoError = True
sPatchCodeCompressed = GetCompressedGuid(Patch.PatchCode)
sProductCode = Patch.ProductCode
sProductCodeCompressed = GetCompressedGuid(sProductCode)
Err.Clear
sLocalMSP = ""
sLocalMSP = Patch.Patchproperty("LocalPackage")
Select Case (Err.number)
Case 0
fLocalPatchPackageDataExist = True
Case -2147023249
'MSI API Error -> Failed to get value for local package
fNoError = False
Err.Clear
Case Else
'Unexpected Error
fNoError = False
Err.Clear
End Select
'Prepare UserSID variable needed for registry operations
sRegUserSID = "S-1-5-18\"
If NOT sProductUserSid = "" Then sRegUserSID = sProductUserSid & "\"
'Check Global Config location
'============================
sHive = HKLM
sRegHive = "HKEY_LOCAL_MACHINE\"
'Check local package registration
'——————————-
'REG_GLOBALCONFIG = "Software\Microsoft\Windows\CurrentVersion\Installer\UserData\"
sRegKey = REG_GLOBALCONFIG & sRegUserSID & "Patches\" & sPatchCodeCompressed & "\"
sRegName = "LocalPackage"
fGlobalConfigPatchExists = RegValExists(sHive,sRegKey,sRegName)
If Not fGlobalConfigPatchExists Then
sTmp = vbTab & "Missing patch metadata. Failed to read value from: " & sRegHive & sRegKey & sRegName
Log sTmp
LogSummary sProductCode,sTmp
fNoError = False
End If
'Check if patchkey exists for the product
'—————————————-
'REG_GLOBALCONFIG = "Software\Microsoft\Windows\CurrentVersion\Installer\UserData\"
sRegKey = REG_GLOBALCONFIG & sRegUserSID & "Products\" & sProductCodeCompressed & "\Patches\"
fGlobalConfigProductExists = RegKeyExists (sHive, sRegKey & sPatchCodeCompressed)
If Not fGlobalConfigProductExists Then
sTmp = vbTab & "Missing patch metadata. Failed to locate key: " & sRegHive & sRegKey & sPatchCodeCompressed & "\"
Log sTmp
LogSummary sProductCode,sTmp
'This could be related to a Windows Installer Upgrade scenario
End If
'Check per-user/per-machine/managed location
'===========================================
Select Case (Patch.Context)
Case 1
'Context = "USERMANAGED"
sHive = HKLM
sRegHive = "HKEY_LOCAL_MACHINE\"
'REG_PRODUCTPERUSERMANAGED = "Software\Microsoft\Windows\CurrentVersion\Installer\Managed\"
sRegKey = REG_PRODUCTPERUSERMANAGED &sRegUserSID & "\Installer\Patches\" & sPatchCodeCompressed & "\"
Case 2
'Context = "USER UNMANAGED"
sHive = HKU
sRegHive = "HKEY_USERS\"
'REG_PRODUCT = "Software\Classes\Installer\"
sRegKey = sRegUserSID & REG_PRODUCT & "Patches\" & sPatchCodeCompressed & "\"
Case Else ' = Case 4
'Context = "MANAGED"
sHive = HKLM
sRegHive = "HKEY_LOCAL_MACHINE\"
'REG_PRODUCT = "Software\Classes\Installer\"
sRegKey = REG_PRODUCT & "Patches\" & sPatchCodeCompressed & "\"
End Select
sMspClasses = sRegKey
'Check registration in 'Patches' section
'—————————————
fConfigPatchExists = RegKeyExists(sHive, sRegKey & "SourceList")
If Not fConfigPatchExists Then
sTmp = vbTab & "Missing patch metadata. Failed to locate key: " & sRegHive & sRegKey & "SourceList\"
Log sTmp
LogSummary sProductCode,sTmp
fNoError = False
End If
'Check if patchkey exists for the product
'—————————————-
Select Case (Patch.Context)
Case 1
'Context = "USERMANAGED"
'REG_PRODUCTPERUSERMANAGED = "Software\Microsoft\Windows\CurrentVersion\Installer\Managed\"
sRegKey = REG_PRODUCTPERUSERMANAGED & sRegUserSID & "\Installer\Products\"& sProductCodeCompressed & "\Patches\"
Case 2
'Context = "USER UNMANAGED"
'REG_PRODUCTPERUSER = "Software\Microsoft\Installer\"
sRegKey = sRegUserSID & REG_PRODUCTPERUSER & "Products\"& sProductCodeCompressed & "\Patches\"
Case Else ' = Case 4
'Context = "MANAGED"
'REG_PRODUCT = "Software\Classes\Installer\"
sRegKey = REG_PRODUCT & "Products\" & sProductCodeCompressed & "\Patches\"
End Select
sRegName = sPatchCodeCompressed
fConfigProductExists = RegValExists(sHive,sRegKey,sRegName)
If Not fConfigProductExists Then
sTmp = vbTab & "Missing patch metadata. Failed to read value from: " & sRegHive & sRegKey & sRegName
Log sTmp
End If
sRegName = "Patches"
sTmp = ""
RegItems = oWShell.RegRead(sRegHive & sRegKey & sRegName)
For Each sItem In RegItems
sTmp = sTmp & sItem
Next
fConfigProductExists = (InStr(sTmp,sPatchCodeCompressed) > 0)
If NOT fNoError AND NOT fDetectOnly Then 'FixMspReg Patch
sTmp = vbTab&"Repair: '"&Patch.PatchCode&"'. Fixing patch registration."
If fDetectOnly Then sTmp = vbTab&"Error: Registration broken for '"&Patch.PatchCode&"'. Patch registration would be fixed."
Log sTmp
LogSummary Patch.PatchCode,sTmp
If NOT fLocalPatchPackageDataExist Then FixMspGlobalReg Patch.PatchCode
If NOT fConfigPatchExists Then
Set MspDb = oMsi.OpenDatabase(sLocalMSP,MSIOPENDATABASEMODE_PATCHFILE)
sSqlCreateTable = "CREATE TABLE `Media` (`DiskId` SHORT NOT NULL, `LastSequence` LONG NOT NULL, `DiskPrompt` CHAR(64) LOCALIZABLE, `Cabinet` CHAR(255), `VolumeLabel` CHAR(32), `Source` CHAR(72) PRIMARY KEY `DiskId`)"
MspDb.OpenView(sSqlCreateTable).Execute
'Get the patch embedded transforms
Set dicTransforms = CreateObject("Scripting.Dictionary")
Set qView = MspDb.OpenView("SELECT `Name` FROM `_Storages` ORDER BY `Name`") : qView.Execute
Set Record = qView.Fetch
Do Until Record Is Nothing
dicTransforms.Add Record.StringData(1),Record.StringData(1)
Set Record = qView.Fetch
Loop
qView.Close
'Apply the patch transforms to the patch itself
For Each sMst in dicTransforms.Keys
MspDb.ApplyTransform ":" & sMst,MSITRANSFORMERROR_ALL
Set TestSumInfo = MspDb.SummaryInformation
Next 'sMst
'Obtain the DiskPrompt and VolumeLabel
Set qView = MspDb.OpenView("SELECT * FROM `_TransformView` WHERE `Table` = 'Media' ORDER BY `Row`")
qView.Execute()
Set Record = qView.Fetch
If NOT Record Is Nothing Then
sKey = Record.StringData(3)
End If
Do Until Record Is Nothing
'Next FTK?
If NOT sKey = Record.StringData(3) Then Exit Do
'Add data from _TransformView
Select Case Record.StringData(2)
Case "DiskId"
sDiskId = Record.StringData(4)
Case "DiskPrompt"
sDiskPrompt = Record.StringData(4)
Case "VolumeLabel"
sVolumeLabel = Record.StringData(4)
Case "CREATE"
Case "DELETE"
Case "DROP"
Case "INSERT"
Case Else
End Select
Set Record = qView.Fetch
Loop
qView.Close
'StdPackageName
Set qView = MspDb.OpenView("SELECT `Property`,`Value` FROM MsiPatchMetadata WHERE `Property`='StdPackageName'")
qView.Execute : Set Record = qView.Fetch()
If Not Record Is Nothing Then
sPackageName = Record.StringData(2)
Else
sPackageName = ""
End If
qView.Close
Patch.SourceListAddSource MSISOURCETYPE_NETWORK,sWICacheDir,0
Patch.SourceListInfo("DiskPrompt") = oMsi.ProductInfo(Patch.ProductCode, "ProductName")
oWShell.RegWrite sRegHive & sMspClasses & "SourceList\PackageName", sPackageName,"REG_SZ"
oWShell.RegWrite sRegHive & sMspClasses & "SourceList\Media\100", sVolumeLabel&";"&sDiskPrompt,"REG_SZ"
'Patch.SourceListAddMediaDisk sKey,sVolumeLabel,sDiskPrompt
End If
End If 'FixMspReg
End Sub 'EnsurePatchMetadata
'==============================================================================================
Sub FixMspGlobalReg(sPatchCode)
Dim sPatchCodeCompressed,sGlobalPatchKey,sValue
On Error Resume Next
sPatchCodeCompressed = GetCompressedGuid(sPatchCode)
sGlobalPatchKey = REG_GLOBALCONFIG & "S-1-5-18\Patches\" & sPatchCodeCompressed & "\"
'Create the registry key
If NOT RegKeyExists(HKEY_LOCAL_MACHINE,REG_GLOBALCONFIG & "S-1-5-18\Patches\") Then oReg.CreateKey HKEY_LOCAL_MACHINE,REG_GLOBALCONFIG & "S-1-5-18\Patches\"
If NOT RegKeyExists(HKEY_LOCAL_MACHINE,sGlobalPatchKey) Then oReg.CreateKey HKEY_LOCAL_MACHINE,sGlobalPatchKey
'Obtain a filename.
'If the file already exists in the installer cache - use that one. If not use a random filename
If dicRepair.Exists(sPatchCode) Then
If InStr(LCase(dicRepair.Item(sPatchCode)),LCase(sWICacheDir))> 0 then sValue = dicRepair.Item(sPatchCode) Else sValue = GetRandomMspName
Else
sValue = GetRandomMspName
End If
'Create the registry value
oReg.SetStringValue HKEY_LOCAL_MACHINE,sGlobalPatchKey,"LocalPackage",sValue
End Sub 'FixMspGlobalReg
'=======================================================================================================
'Only supports per-machine installations!
Sub UpdateProductVersion(sProductCode,sProductVersion)
Dim sProductCodeCompressed,sHive,sGlobalConfigKey
On Error Resume Next
sProductCodeCompressed = GetCompressedGuid(sProductCode)
sHive = HKEY_LOCAL_MACHINE
sGlobalConfigKey = REG_GLOBALCONFIG & "S-1-5-18\Products\" & sProductCodeCompressed & "\InstallProperties\"
If RegKeyExists(sHive,sGlobalConfigKey) Then oReg.SetStringValue sHive,sGlobalConfigKey,"DisplayVersion",sProductVersion
End Sub 'UpdateProductVersion
'=======================================================================================================
Sub UnregisterPatch(Patch)
Dim PatchRef,PatchR
Dim fReturn
Dim sHive,sKey,sPatchCodeCompressed,sProductCodeCompressed,sUserSid,sPatchKey,sProductKey,sPatchList
Dim sGlobalConfigKey,sGlobalPatchKey
Dim value
Dim i
Dim arrMultiSzValues,arrMultiSzNewValues,arrTest
On Error Resume Next
'Ensure empty variables
sHive = "" : sKey = "" : sPatchCodeCompressed = "" : sProductCodeCompressed = "" : sUserSid = ""
sPatchKey = "" : sProductKey = "" : sPatchList = ""
ReDim arrMultiSzNewValues(-1)
i = -1
'Fill variables
sPatchCodeCompressed = GetCompressedGuid(Patch.PatchCode)
sProductCodeCompressed = GetCompressedGuid(Patch.ProductCode)
sUserSid = Patch.UserSid : If sUserSid = "" Then sUserSid = "S-1-5-18\" Else sUserSid = sUserSid & "\"
sGlobalConfigKey = REG_GLOBALCONFIG & sUserSid & "Products\" & sProductCodeCompressed & "\Patches\"
sGlobalPatchKey = REG_GLOBALCONFIG & sUserSid & "Patches\" & sPatchCodeCompressed & "\"
If Err <> 0 Then Exit Sub
Select Case (Patch.Context)
Case MSIINSTALLCONTEXT_USERMANAGED '1
sHive = HKEY_LOCAL_MACHINE
sPatchKey = REG_PRODUCTPERUSERMANAGED & sUserSid & "Installer\Patches\" & sPatchCodeCompressed & "\"
sProductKey = REG_PRODUCTPERUSERMANAGED & "Products\" & sProductCodeCompressed & "\Patches\"
Case MSIINSTALLCONTEXT_USERUNMANAGED '2
sHive = HKEY_CURRENT_USER
sPatchKey = REG_PRODUCTPERUSER & "Patches\" & sPatchCodeCompressed & "\"
sProductKey = REG_PRODUCTPERUSER & "Products\" & sProductCodeCompressed & "\Patches\"
Case Else 'Case MSIINSTALLCONTEXT_MACHINE '4 (Managed)
sHive = HKEY_LOCAL_MACHINE
sPatchKey = REG_PRODUCT & "Patches\" & sPatchCodeCompressed & "\"
sProductKey = REG_PRODUCT & "Products\" & sProductCodeCompressed & "\Patches\"
End Select
'Unregister the patch from ProductKey
If RegReadMultiStringValue(sHive,sProductKey,"Patches",arrMultiSzValues) Then
For Each value in arrMultiSzValues
If Not value = sPatchCodeCompressed Then
i = i + 1
ReDim Preserve arrMultiSzNewValues(i)
arrMultiSzNewValues(i) = value
End If
Next 'Value
End If
fReturn = oReg.GetMultiStringValue(sHive,sProductKey,"Patches",arrTest)
If fReturn = 0 Then
Log vbTab&vbTab&"Updating value "&HiveString(sHive)&"\"&sProductKey&"Patches"
If NOT fDetectOnly Then oReg.SetMultiStringValue sHive,sProductKey,"Patches",arrMultiSzNewValues
Else
If fx64 Then
fReturn = oReg.GetMultiStringValue(sHive,Wow64Key(sHive, sProductKey),"Patches",arrMultiSzNewValues)
If fReturn = 0 Then
Log vbTab&vbTab&"Updating value "&HiveString(sHive)&"\"&Wow64Key(sHive, sProductKey)&"Patches"
If NOT fDetectOnly Then oReg.SetMultiStringValue sHive,Wow64Key(sHive, sProductKey),"Patches",arrMultiSzNewValues
End If
End If 'fx64
End If
RegDeleteValue sHive,sProductKey,sPatchCodeCompressed
'Unregister PatchKey
RegDeleteKey sHive,sPatchKey
'Unregister GlobalConfigKey
ReDim arrMultiSzNewValues(-1)
i = -1
If RegReadMultiStringValue(sHive,sGlobalConfigKey,"AllPatches",arrMultiSzValues) Then
For Each Value in arrMultiSzValues
If Not Value = sPatchCodeCompressed Then
i = i + 1
ReDim Preserve arrMultiSzNewValues(i)
arrMultiSzNewValues(i) = Value
End If
Next 'Value
End If
fReturn = oReg.GetMultiStringValue(sHive,sGlobalConfigKey,"AllPatches",arrTest)
If fReturn = 0 Then
Log vbTab&vbTab&"Updating value "&HiveString(sHive)&"\"&sGlobalConfigKey&"AllPatches"
If NOT fDetectOnly Then oReg.SetMultiStringValue sHive,sGlobalConfigKey,"AllPatches",arrMultiSzNewValues
Else
If fx64 Then
fReturn = oReg.GetMultiStringValue(sHive,Wow64Key(sHive, sGlobalConfigKey),"AllPatches",arrMultiSzNewValues)
If fReturn = 0 Then
Log vbTab&vbTab&"Updating value "&HiveString(sHive)&"\"&Wow64Key(sHive, sGlobalConfigKey)&"AllPatches"
If NOT fDetectOnly Then oReg.SetMultiStringValue sHive,Wow64Key(sHive, sGlobalConfigKey),"AllPatches",arrMultiSzNewValues
End If
End If 'fx64
End If
RegDeleteKey HKEY_LOCAL_MACHINE,sGlobalConfigKey&sPatchCodeCompressed & "\"
'Unregister sGlobalPatchKey
RegDeleteKey HKEY_LOCAL_MACHINE,sGlobalPatchKey
End Sub
'=======================================================================================================
Function ApplyPatch(sProductCode,sPatches)
Dim sReturn,sCmd
On Error Resume Next
'Build the patch apply command
sCmd = "msiexec.exe /i " & sProductCode & _
" PATCH="&chr(34)&Mid(sPatches,2)&chr(34)& _
" REBOOT=ReallySuppress" & _
" /qb-" & _
" /l*v+ %temp%\" & sProductCode & "_MspApply.log"
sTmp = "Calling msiexec to apply patch(es): " & sCmd
If fDetectOnly Then
sPatches = Replace(sPatches,";",vbCrLf&vbTab&vbTab)
sTmp = "Applicable patch(es): "&sPatches
End If 'fDetectOnly
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
'Execute the patch apply command
If NOT fDetectOnly Then
sReturn = CStr(oWShell.Run(sCmd, 0, True))
ApplyPatch = MsiexecRetVal(sReturn)
sTmp = "Msiexec returned with code: " & sReturn &" "& MsiexecRetval(sReturn)
Log vbTab&"Debug: "& sTmp
LogSummary sProductCode,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
fRebootRequired = fRebootRequired OR (sReturn = "3010")
If NOT (sReturn = "0" OR sReturn = "3010") Then
'Patch attempt failed.
Dim arrPatch,Patch
arrPatch = Split(Mid(sPatches,2),";")
If UBound(arrPatch) > 0 Then
'Fall back to apply one patch at a time
For Each Patch in arrPatch
sCmd = "msiexec.exe /i " & sProductCode & _
" PATCH="&chr(34)&Patch&chr(34)& _
" REBOOT=ReallySuppress" & _
" /qb-" & _
" /l*v+ %temp%\" & sProductCode & "_MspApply.log"
sTmp = " Fallback. Calling msiexec to apply patch: " & sCmd
Log vbTab&"Debug: "&sTmp
LogSummary sProductCode,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
sReturn = CStr(oWShell.Run(sCmd, 0, True))
sTmp = " Msiexec returned with code: " & sReturn &" "& MsiexecRetval(sReturn)
Log vbTab&"Debug: "& sTmp
LogSummary sProductCode,vbTab&sTmp
If fCscript Then wscript.echo vbTab&vbTab&sTmp
fRebootRequired = fRebootRequired OR (sReturn = "3010")
Next 'Patch
End If 'arrPatch.Count > 1
End If 'sReturn
End If 'NOT fDetectOnly
End Function 'ApplyPatch
'=======================================================================================================
'Return the primary keys of a table by using the PrimaryKeys property of the database object
'in SQL ready syntax
Function GetPrimaryTableKeys(MsiDb,sTable)
Dim iKeyCnt
Dim sPrimaryTmp
Dim PrimaryKeys
On Error Resume Next
sPrimaryTmp = ""
Set PrimaryKeys = MsiDb.PrimaryKeys(sTable)
For iKeyCnt = 1 To PrimaryKeys.FieldCount
sPrimaryTmp = sPrimaryTmp & "`"&PrimaryKeys.StringData(iKeyCnt)&"`, "
Next 'iKeyCnt
GetPrimaryTableKeys = Left(sPrimaryTmp,Len(sPrimaryTmp)-2)
End Function 'GetPrimaryTableKeys
'=======================================================================================================
'Return the Column schema definition of a table in SQL ready syntax
Function GetTableColumnDef(MsiDb,sTable)
On Error Resume Next
Dim sQuery,sColDefTmp
Dim View,ColumnNames,ColumnTypes
Dim iColCnt
'Get the ColumnInfo details
sColDefTmp = ""
sQuery = "SELECT * FROM " & sTable
Set View = MsiDb.OpenView(sQuery)
View.Execute
Set ColumnNames = View.ColumnInfo(MSICOLUMNINFONAMES)
Set ColumnTypes = View.ColumnInfo(MSICOLUMNINFOTYPES)
For iColCnt = 1 To ColumnNames.FieldCount
sColDefTmp = sColDefTmp & ColDefToSql(ColumnNames.StringData(iColCnt),ColumnTypes.StringData(iColCnt)) & ", "
Next 'iColCnt
View.Close
GetTableColumnDef = Left(sColDefTmp,Len(sColDefTmp)-2)
End Function 'GetTableColumnDef
'=======================================================================================================
'Return the Column header names
Function GetTableColumnHeaders(MsiDb,sTable)
On Error Resume Next
Dim sQuery,sColDefTmp
Dim View,ColumnNames,ColumnTypes
Dim iColCnt
'Get the ColumnInfo details
sColDefTmp = ""
sQuery = "SELECT * FROM " & sTable
Set View = MsiDb.OpenView(sQuery)
View.Execute
Set ColumnNames = View.ColumnInfo(MSICOLUMNINFONAMES)
For iColCnt = 1 To ColumnNames.FieldCount
sColDefTmp = sColDefTmp & "," & ColumnNames.StringData(iColCnt)
Next 'iColCnt
View.Close
If NOT sColDefTmp="" Then GetTableColumnHeaders = Mid(sColDefTmp,2) Else GetTableColumnHeaders=""
End Function 'GetTableColumnHeaders
'=======================================================================================================
'Translate the column definition fields into SQL syntax
Function ColDefToSql(sColName,sColType)
On Error Resume Next
Dim iLen
Dim sRight,sLeft, sSqlTmp
iLen = Len(sColType)
sRight = Right(sColType,iLen-1)
sLeft = Left(sColType,1)
sSqlTmp = "`"&sColName&"`"
Select Case sLeft
Case "s","S"
's? String, variable length (?=1-255) -> CHAR(#) or CHARACTER(#)
's0 String, variable length -> LONGCHAR
If sRight="0" Then sSqlTmp = sSqlTmp & " LONGCHAR" Else sSqlTmp = sSqlTmp & " CHAR("&sRight&")"
If sLeft = "s" Then sSqlTmp = sSqlTmp & " NOT NULL"
Case "l","L"
'CHAR(#) LOCALIZABLE or CHARACTER(#) LOCALIZABLE
If sRight="0" Then sSqlTmp = sSqlTmp & " LONGCHAR" Else sSqlTmp = sSqlTmp & " CHAR("&sRight&")"
If sLeft = "l" Then sSqlTmp = sSqlTmp & " NOT NULL"
If sRight="0" Then sSqlTmp = sSqlTmp & " LOCALIZABLE" Else sSqlTmp = sSqlTmp & " LOCALIZABLE"
Case "i","I"
'i2 Short integer
'i4 Long integer
If sRight="2" Then sSqlTmp = sSqlTmp & " SHORT" Else sSqlTmp = sSqlTmp & " LONG"
If sLeft = "i" Then sSqlTmp = sSqlTmp & " NOT NULL"
Case "v","V"
'v0 Binary Stream
sSqlTmp = sSqlTmp & " OBJECT"
If sLeft = "v" Then sSqlTmp = sSqlTmp & " NOT NULL"
Case "g","G"
'g? Temporary string (?=0-255)
Case "j","J"
'j? Temporary integer (?=0,1,2,4))
Case "o","O"
'O0 Temporary object
Case Else
End Select
ColDefToSql = sSqlTmp
End Function 'ColDefToSql
'=======================================================================================================
'Registry Helper Routines
'————————
'=======================================================================================================
'Register context menu
Sub RegisterShellExt
'Ensure to unregister old contents first
UnRegisterShellExt
'Register
oReg.CreateKey HKCR,"Msi.Patch"
oReg.CreateKey HKCR,"Msi.Patch\shell"
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil ApplyPatch"
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil ApplyPatch\command"
oReg.SetStringValue HKCR,"Msi.Patch\shell\OPUtil ApplyPatch\command",,"wscript "&chr(34)&wscript.ScriptFullName&chr(34)&" /ContextMenu /ApplyPatch="&chr(34)&"%1%"&chr(34)
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil CabExtract"
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil CabExtract\command"
oReg.SetStringValue HKCR,"Msi.Patch\shell\OPUtil CabExtract\command",,"wscript "&chr(34)&wscript.ScriptFullName&chr(34)&" /ContextMenu /CabExtract="&chr(34)&"%1%"&chr(34)
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil RemovePatch"
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil RemovePatch\command"
oReg.SetStringValue HKCR,"Msi.Patch\shell\OPUtil RemovePatch\command",,"wscript "&chr(34)&wscript.ScriptFullName&chr(34)&" /ContextMenu /RemovePatch="&chr(34)&"%1%"&chr(34)
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil ViewPatch"
oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil ViewPatch\command"
oReg.SetStringValue HKCR,"Msi.Patch\shell\OPUtil ViewPatch\command",,"wscript "&chr(34)&wscript.ScriptFullName&chr(34)&" /ContextMenu /ViewPatch="&chr(34)&"%1%"&chr(34)
' oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil ViewPatch (DeepScan)"
' oReg.CreateKey HKCR,"Msi.Patch\shell\OPUtil ViewPatch (DeepScan)\command"
' oReg.SetStringValue HKCR,"Msi.Patch\shell\OPUtil ViewPatch (DeepScan)\command",,"wscript "&chr(34)&wscript.ScriptFullName&chr(34)&" /ContextMenu /DeepScan /ViewPatch="&chr(34)&"%1%"&chr(34)
End Sub 'RegisterShellExt
'=======================================================================================================
'Register context menu
Sub UnRegisterShellExt
Dim arrKeys
Dim Key
Dim sSubKeyName
sSubKeyName = "Msi.Patch\shell\"
If (oReg.EnumKey(HKCR,sSubKeyName,arrKeys)=0) AND IsArray(arrKeys) Then
For Each Key in arrKeys
If InStr(Key,"OPUtil")>0 Then RegDeleteKey HKCR,sSubKeyName&Key
Next 'Key
End If
End Sub 'RegisterShellExt
'=======================================================================================================
Function RegKeyExists(hDefKey,sSubKeyName)
On Error Resume Next
Dim arrKeys
RegKeyExists = False
If oReg.EnumKey(hDefKey,sSubKeyName,arrKeys) = 0 Then RegKeyExists = True
End Function
'=======================================================================================================
Function HiveString(hDefKey)
On Error Resume Next
Select Case hDefKey
Case HKCR : HiveString = "HKEY_CLASSES_ROOT"
Case HKCU : HiveString = "HKEY_CURRENT_USER"
Case HKLM : HiveString = "HKEY_LOCAL_MACHINE"
Case HKU : HiveString = "HKEY_USERS"
Case Else : HiveString = hDefKey
End Select
End Function
'=======================================================================================================
Function RegValExists(hDefKey,sSubKeyName,sName)
Dim arrValueTypes, arrValueNames
Dim i
On Error Resume Next
RegValExists = False
If Not RegKeyExists(hDefKey,sSubKeyName) Then Exit Function
If oReg.EnumValues(hDefKey,sSubKeyName,arrValueNames,arrValueTypes) = 0 AND IsArray(arrValueNames) Then
For i = 0 To UBound(arrValueNames)
If LCase(arrValueNames(i)) = Trim(LCase(sName)) Then RegValExists = True
Next
End If 'oReg.EnumValues
End Function
'=======================================================================================================
Function RegReadMultiStringValue(hDefKey,sSubKeyName,sName,arrValues)
Dim RetVal
On Error Resume Next
RetVal = oReg.GetMultiStringValue(hDefKey,sSubKeyName,sName,arrValues)
If Not RetVal = 0 AND fx64 Then RetVal = oReg.GetMultiStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,arrValues)
RegReadMultiStringValue = (RetVal = 0 AND IsArray(arrValues))
End Function 'RegReadMultiStringValue
'=======================================================================================================
'Enumerate a registry key to return all values
Function RegEnumValues(hDefKey,sSubKeyName,arrNames, arrTypes)
Dim RetVal, RetVal64
Dim arrNames32, arrNames64, arrTypes32, arrTypes64
On Error Resume Next
If fx64 Then
RetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames32,arrTypes32)
RetVal64 = oReg.EnumValues(hDefKey,Wow64Key(hDefKey, sSubKeyName),arrNames64,arrTypes64)
If (RetVal = 0) AND (Not RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrTypes32) Then
arrNames = arrNames32
arrTypes = arrTypes32
End If
If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames64) AND IsArray(arrTypes64) Then
arrNames = arrNames64
arrTypes = arrTypes64
End If
If (RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrNames64) AND IsArray(arrTypes32) AND IsArray(arrTypes64) Then
arrNames = RemoveDuplicates(Split((Join(arrNames32,"\") & "\" & Join(arrNames64,"\")),"\"))
arrTypes = RemoveDuplicates(Split((Join(arrTypes32,"\") & "\" & Join(arrTypes64,"\")),"\"))
End If
Else
RetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames,arrTypes)
End If 'fx64
RegEnumValues = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrNames) AND IsArray(arrTypes)
End Function 'RegEnumValues
'=======================================================================================================
'Enumerate a registry key to return all subkeys
Function RegEnumKey(hDefKey,sSubKeyName,arrKeys)
Dim RetVal, RetVal64
Dim arrKeys32, arrKeys64
On Error Resume Next
If fx64 Then
RetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys32)
RetVal64 = oReg.EnumKey(hDefKey,Wow64Key(hDefKey, sSubKeyName),arrKeys64)
If (RetVal = 0) AND (Not RetVal64 = 0) AND IsArray(arrKeys32) Then arrKeys = arrKeys32
If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrKeys64) Then arrKeys = arrKeys64
If (RetVal = 0) AND (RetVal64 = 0) Then
If IsArray(arrKeys32) AND IsArray (arrKeys64) Then
arrKeys = RemoveDuplicates(Split((Join(arrKeys32,"\") & "\" & Join(arrKeys64,"\")),"\"))
ElseIf IsArray(arrKeys64) Then
arrKeys = arrKeys64
Else
arrKeys = arrKeys32
End If
End If
Else
RetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys)
End If 'fx64
RegEnumKey = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrKeys)
End Function 'RegEnumKey
'=======================================================================================================
'Wrapper around oReg.DeleteValue to handle 64 bit
Sub RegDeleteValue(hDefKey, sSubKeyName, sName)
Dim sWow64Key
On Error Resume Next
If RegValExists(hDefKey,sSubKeyName,sName) Then
On Error Resume Next
Log vbTab&vbTab&"Deleting value "&HiveString(hDefKey)&"\"&sSubKeyName&sName
If NOT fDetectOnly Then oReg.DeleteValue hDefKey, sSubKeyName, sName
On Error Goto 0
End If 'RegValExists
If fx64 Then
sWow64Key = Wow64Key(hDefKey, sSubKeyName)
If RegValExists(hDefKey,sWow64Key,sName) Then
On Error Resume Next
Log vbTab&vbTab&"Deleting value "&HiveString(hDefKey)&"\"&sWow64Key&sName
If NOT fDetectOnly Then oReg.DeleteValue hDefKey, sWow64Key, sName
On Error Goto 0
End If 'RegValExists
End If
End Sub 'RegDeleteValue
'=======================================================================================================
'Wrappper around RegDeleteKeyEx to handle 64bit scenarios
Sub RegDeleteKey(hDefKey, sSubKeyName)
Dim sWow64Key
On Error Resume Next
If RegKeyExists(hDefKey, sSubKeyName) Then
'Get the list of patches for the product
On Error Resume Next
RegDeleteKeyEx hDefKey, sSubKeyName
On Error Goto 0
End If 'RegKeyExists
If fx64 Then
sWow64Key = Wow64Key(hDefKey, sSubKeyName)
If RegKeyExists(hDefKey,sWow64Key) Then
On Error Resume Next
RegDeleteKeyEx hDefKey, sWow64Key
On Error Goto 0
End If 'RegKeyExists
End If
End Sub 'RegDeleteKey
'=======================================================================================================
'Recursively delete a registry structure
Sub RegDeleteKeyEx(hDefKey, sSubKeyName)
Dim arrSubkeys
Dim sSubkey
On Error Resume Next
Do While InStr(sSubKeyName,"\\")>0
sSubKeyName = Replace(sSubKeyName,"\\","\")
Loop
If Not Right(sSubKeyName,1)="\" Then sSubKeyName=sSubKeyName&"\"
oReg.EnumKey hDefKey, sSubKeyName, arrSubkeys
If IsArray(arrSubkeys) Then
For Each sSubkey In arrSubkeys
RegDeleteKeyEx hDefKey, sSubKeyName & sSubkey & "\"
Next
End If
Log vbTab&vbTab&"Deleting key "&HiveString(hDefKey)&"\"&sSubKeyName
If NOT fDetectOnly Then oReg.DeleteKey hDefKey, sSubKeyName
End Sub 'RegDeleteKeyEx
'=======================================================================================================
'Return the alternate regkey location on 64bit environment
Function Wow64Key(hDefKey, sSubKeyName)
Dim iPos
On Error Resume Next
Select Case hDefKey
Case HKCU
If Left(sSubKeyName,17) = "Software\Classes\" Then
Wow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17)
Else
iPos = InStr(sSubKeyName,"\")
Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos)
End If
Case HKLM
If Left(sSubKeyName,17) = "Software\Classes\" Then
Wow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17)
Else
iPos = InStr(sSubKeyName,"\")
Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos)
End If
Case Else
Wow64Key = "Wow6432Node\" & sSubKeyName
End Select 'hDefKey
End Function 'Wow64Key
'=======================================================================================================
'File Helper Routines
'————————
'=======================================================================================================
'Function to compare two numbers of unspecified format
'Return values:
'Left file version is lower than right file version -1
'Left file version is identical to right file version 0
'Left file version is higher than right file version 1
'Invalid comparison 2
Function CompareVersion(sFile1, sFile2, bAllowBlanks)
Dim file1, file2
Dim sDelimiter
Dim iCnt, iAsc, iMax, iF1, iF2
Dim bLEmpty,bREmpty
CompareVersion = 0
bLEmpty = False
bREmpty = False
'Ensure valid inputs values
On Error Resume Next
If IsEmpty(sFile1) Then bLEmpty = True
If IsEmpty(sFile2) Then bREmpty = True
If sFile1 = "" Then bLEmpty = True
If sFile2 = "" Then bREmpty = True
'Don't allow alpha characters
If Not bLEmpty Then
For iCnt = 1 To Len(sFile1)
iAsc = Asc(UCase(Mid(sFile1,iCnt,1)))
If (iAsc>64) AND (iAsc<91) Then
CompareVersion = 2
Exit Function
End If
Next 'iCnt
End If
If Not bREmpty Then
For iCnt = 1 To Len(sFile2)
iAsc = Asc(UCase(Mid(sFile2,iCnt,1)))
If (iAsc>64) AND (iAsc<91) Then
CompareVersion = 2
Exit Function
End If
Next 'iCnt
End If
If bLEmpty AND (NOT bREmpty) Then
If bAllowBlanks Then CompareVersion = -1 Else CompareVersion = 2
Exit Function
End If
If (NOT bLEmpty) AND bREmpty Then
If bAllowBlanks Then CompareVersion = 1 Else CompareVersion = 2
Exit Function
End If
If bLEmpty AND bREmpty Then
If bAllowBlanks Then CompareVersion = 0 Else CompareVersion = 2
Exit Function
End If
'If Files are identical we're already done
If sFile1 = sFile2 Then Exit Function
'Split the VersionString
file1 = Split(sFile1,Delimiter(sFile1))
file2 = Split(sFile2,Delimiter(sFile2))
'Ensure we get the lower count
iMax = UBound(file1)
CompareVersion = -1
If iMax > UBound(file2) Then
iMax = UBound(file2)
CompareVersion = 1
End If
'Compare the file versions
For iCnt = 0 To iMax
iF1 = CLng(file1(iCnt))
iF2 = CLng(file2(iCnt))
If iF1 > iF2 Then
CompareVersion = 1
Exit For
ElseIf iF1 < iF2 Then
CompareVersion = -1
Exit For
End If
Next 'iCnt
End Function
'=======================================================================================================
'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 = oWShell.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 IsArray(arrTmp) AND UBound(arrTmp)>0 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
End If 'InStr(sFile,".")>0
End If
GetAssemblyPath = sFolder&sFile
End Function 'GetAssemblyPath
'=======================================================================================================
'Routine to check if it's required to extract .msp files first
Sub CheckPatchExtract
Const COL_FILEDESCRIPTION = 34
Const COL_FILEVERSION = 145
Dim File, location
Dim iMspCnt,iExeCnt
For Each location in arrUpdateLocations
If NOT location = sWiCacheDir Then
iMspCnt = 0 : iExeCnt = 0
For Each File in oFso.GetFolder(location).Files
If LCase(Right(File.Name,4))=".msp" Then iMspCnt=iMspCnt+1
If LCase(Right(File.Name,4))=".exe" Then iExeCnt=iExeCnt+1
Next 'File
If (iMspCnt=0) AND (iExeCnt>0) Then
For Each File in oFso.GetFolder(location).Files
If LCase(Right(File.Name,4))=".exe" Then
If InStr(LCase(GetDetailsOf(File,COL_FILEDESCRIPTION)),"(kb")>0 Then
ExtractPatch File
End If
End If
Next 'File
End If
End If 'sWiCacheDir
Next 'location
End Sub 'CheckPatchExtract
'=======================================================================================================
Function GetDetailsOf(File,iColumn)
Dim oFolder,oFolderItem
set oFolder = oShellApp.NameSpace(File.ParentFolder.Path)
If (NOT oFolder Is Nothing) Then
Set oFolderItem = oFolder.ParseName(File.Name)
If (NOT oFolderItem Is Nothing) Then
GetDetailsOf = oFolder.GetDetailsOf(oFolderItem, iColumn)
End If
End If
End Function 'GetDetailsOf
'=======================================================================================================
Sub ExtractPatch (File)
Dim sCmd,sReturn
On Error Resume Next
sCmd = chr(34)&File.Path&chr(34) & " /extract:"&chr(34)&File.ParentFolder.Path&chr(34)&" /quiet"
sReturn = oWShell.Run(sCmd,1,True)
sTmp = vbTab&"Extracting patch "&File.Name&" returned: "&sReturn&" "& ExtractorRetval(sReturn)
Log sTmp
If fCscript Then wscript.echo sTmp
End Sub
'=======================================================================================================
'Query Wmi to identify local hard disks.
'The result is stored in a global dic array
Sub FindLocalDisks
Dim LogicalDisks,Disk
On Error Resume Next
Set LogicalDisks = oWmiLocal.ExecQuery("Select * from Win32_LogicalDisk")
For Each Disk in LogicalDisks
If Disk.DriveType = DISK_LOCAL Then dicLocalDisks.Add Disk.DeviceID,DISK_LOCAL
Next 'Disk
End Sub 'FindLocalDisks
'=======================================================================================================
Sub Log(sLog)
LogStream.WriteLine sLog
End Sub 'Log
'=======================================================================================================
Function GetRandomMspName()
Dim sRandom
Dim iHigh,iLow, iRnd
On Error Resume Next
iHigh = 268365550
iLow = 1048576
Randomize
sRandom = sWICacheDir
iRnd = Rnd
sRandom = sWICacheDir & LCase(Hex((iHigh-iLow + 1) * Rnd + iLow))&".msp"
While oFso.FileExists(sRandom)
Randomize
sRandom = sWICacheDir & LCase(Hex((iHigh-iLow + 1) * Rnd + iLow))&".msp"
Wend
GetRandomMspName = sRandom
End Function 'GetRandomMspName
'=======================================================================================================
'String Helper Routines
'————————
'=======================================================================================================
Sub LogSummary(sProductCode,sLog)
On Error Resume Next
If dicSummary.Exists(sProductCode) Then
dicSummary.Item(sProductCode) = dicSummary.Item(sProductCode)&sLog&vbCrLf
Else
dicSummary.Add sProductCode,vbCrLf&sLog&vbCrLf
End If
End Sub 'Log
'=======================================================================================================
'Translate the Office build to the SP level
'Possible return values are RTM,SP1,SP2,SP3 or ""
Function GetSpLevel(sBuild)
Dim arrVersionString
GetSpLevel = ""
arrVersionString = Split(sBuild,".")
If NOT IsArray(arrVersionString) Then Exit Function
If NOT UBound(arrVersionString)>1 Then Exit Function 'Require "major.minor.build" format
Select Case arrVersionString(0) 'BuildMajor
Case "14"
Case "12"
Select Case arrVersionstring(2)
Case "4518" : GetSpLevel = " - RTM"
Case "6213","6215","6219" : GetSpLevel = " - SP1"
Case "6425" : GetSpLevel = " - SP2"
Case Else
End Select
Case "11"
Select Case arrVersionstring(2)
Case "3216","5510","5614" : GetSpLevel = " - RTM"
Case "4301","6353","6355","6361","6707" : GetSpLevel = " - SP1"
Case "7969" : GetSpLevel = " - SP2"
Case "8173" : GetSpLevel = " - SP3"
Case Else
End Select
Case "10"
Select Case arrVersionstring(2)
Case "525","2623","2627","2915" : GetSpLevel = " - RTM"
Case "2514","3416","3506","3520" : GetSpLevel = " - SP1"
Case "4128","4219","4330","5110" : GetSpLevel = " - SP2"
Case "6308","6612","6626" : GetSpLevel = " - SP3"
Case Else
End Select
Case "9"
Select Case arrVersionstring(2)
Case "2720" : GetSpLevel = " - RTM"
Case "3821" : GetSpLevel = " - SR1"
Case "4527" : GetSpLevel = " - SP2"
Case "9327" : GetSpLevel = " - SP3"
Case Else
End Select
Case Else
End Select
End Function
'=======================================================================================================
Sub ComputerProperties
Dim oOsItem
Dim arrVersion
Dim qOS
On Error Resume Next
sComputerName = oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
'OS info from WMI Win32_OperatingSystem
Set qOS = oWmiLocal.ExecQuery("Select * from Win32_OperatingSystem")
For Each oOsItem in qOS
sOSinfo = "Operating System: " & oOsItem.Caption
sOSinfo = sOSinfo &","& "Service Pack: SP " & oOsItem.ServicePackMajorVersion
sOSinfo = sOSinfo &","& "Version: " & oOsItem.Version
sOsVersion = oOsItem.Version
sOSinfo = sOSinfo &","& "Codepage: " & oOsItem.CodeSet
sOSinfo = sOSinfo &","& "Country Code: " & oOsItem.CountryCode
sOSinfo = sOSinfo &","& "Language: " & oOsItem.OSLanguage
Next
'Build the VersionNT number
arrVersion = Split(sOsVersion,Delimiter(sOsVersion))
iVersionNt = CInt(arrVersion(0))*100 + CInt(arrVersion(1))
End Sub 'ComputerProperties
'=======================================================================================================
'Sorts an array in descending order
Function BubbleSort(arrBubble)
Dim sTmp
Dim iCntOuter,iCntInner
On Error Resume Next
BubbleSort = arrBubble
If NOT IsArray(arrBubble) Then Exit Function
For iCntOuter = UBound(arrBubble)-1 To 0 Step -1
'Inner sort loop
For iCntInner = 0 To iCntOuter
If arrBubble(iCntInner) < arrBubble(iCntInner+1) Then
sTmp = arrBubble(iCntInner+1)
arrBubble(iCntInner+1) = arrBubble(iCntInner)
arrBubble(iCntInner) = sTmp
End If
Next 'iCntInner
Next 'iCntOuter
BubbleSort = arrBubble
End Function
'=======================================================================================================
'Returns the delimiter of a number string
Function Delimiter (sVersion)
Dim iCnt, iAsc
Delimiter = " "
For iCnt = 1 To Len(sVersion)
iAsc = Asc(Mid(sVersion, iCnt, 1))
If Not (iASC >= 48 And iASC <= 57) Then
Delimiter = Mid(sVersion, iCnt, 1)
Exit Function
End If
Next 'iCnt
End Function
'=======================================================================================================
'Returns an array with valid folder locations.
'Local folders first (except WICacheDir), network folders, WICacheDir last
Function EnsureLocation(sLocations)
Dim sLocation,sLocalLocations,sNetworkLocations,DynLocation
Dim fLocal
Dim arrLocations
On Error Resume Next
sLocalLocations = "" : sNetworkLocations = ""
sLocations = sLocations &";"&sScriptDir
sLocations = Replace(sLocations,",",";")
arrLocations = RemoveDuplicates(Split(sLocations,";"))
sLocations = ""
If NOT fDynSUpdateDiscovered Then DiscoverDynSUpdateFolders
For Each Location in arrLocations
sLocation=""
sLocation = Location
If oFso.FolderExists(sLocation) Then
'Ensure trailing '\'
If NOT Right(sLocation,1)="\" Then sLocation=sLocation&"\"
fLocal=dicLocalDisks.Exists(Left(sLocation,2))
If fLocal _
Then sLocalLocations=sLocalLocations&";"&sLocation _
Else sNetworkLocations=sNetworkLocations&";"&sLocation
For Each DynLocation in dicDynCultFolders.Keys
If oFso.FolderExists(sLocation & DynLocation) Then
If NOT Right(DynLocation,1)="\" Then sLocation=sLocation&"\"
If fLocal _
Then sLocalLocations=sLocalLocations&";"&sLocation & DynLocation _
Else sNetworkLocations=sNetworkLocations&";"&sLocation & DynLocation
End If
Next 'DynLocation
End If
Next 'Location
sLocations = sLocalLocations&sNetworkLocations&";"&sWICacheDir
EnsureLocation=RemoveDuplicates(Split(Mid(sLocations,2),";"))
End Function 'EnsureLocation
'=======================================================================================================
'Remove duplicate entries from a one dimensional array
Function RemoveDuplicates(Array)
Dim Item
Dim oDic
On Error Resume Next
Set oDic = CreateObject("Scripting.Dictionary")
For Each Item in Array
If Not oDic.Exists(Item) Then oDic.Add Item,Item
Next 'Item
RemoveDuplicates = oDic.Keys
End Function 'RemoveDuplicates
'=======================================================================================================
'Converts the GUID / ProductCode into the compressed format
Function GetCompressedGuid (sGuid)
Dim sCompGUID
Dim i
On Error Resume Next
sCompGUID = StrReverse(Mid(sGuid,2,8)) & _
StrReverse(Mid(sGuid,11,4)) & _
StrReverse(Mid(sGuid,16,4))
For i = 21 To 24
If i Mod 2 Then
sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1)
Else
sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1)
End If
Next
For i = 26 To 37
If i Mod 2 Then
sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1)
Else
sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1)
End If
Next
GetCompressedGuid = sCompGUID
End Function
'=======================================================================================================
Function GetExpandedGuid (sGuid)
Dim sExpandGuid
Dim i
On Error Resume Next
sExpandGuid = "{" & StrReverse(Mid(sGuid,1,8)) & "-" & _
StrReverse(Mid(sGuid,9,4)) & "-" & _
StrReverse(Mid(sGuid,13,4))& "-"
For i = 17 To 20
If i Mod 2 Then
sExpandGuid = sExpandGuid & mid(sGuid,(i + 1),1)
Else
sExpandGuid = sExpandGuid & mid(sGuid,(i - 1),1)
End If
Next
sExpandGuid = sExpandGuid & "-"
For i = 21 To 32
If i Mod 2 Then
sExpandGuid = sExpandGuid & mid(sGuid,(i + 1),1)
Else
sExpandGuid = sExpandGuid & mid(sGuid,(i - 1),1)
End If
Next
sExpandGuid = sExpandGuid & "}"
GetExpandedGuid = sExpandGuid
End Function
'=======================================================================================================
'Translation for msiexec.exe error codes
Function MsiexecRetVal(iRetVal)
On Error Resume Next
Select Case iRetVal
Case 0 : MsiexecRetVal = "Success"
Case 1259 : MsiexecRetVal = "APPHELP_BLOCK"
Case 1601 : MsiexecRetVal = "INSTALL_SERVICE_FAILURE"
Case 1602 : MsiexecRetVal = "INSTALL_USEREXIT"
Case 1603 : MsiexecRetVal = "INSTALL_FAILURE"
Case 1604 : MsiexecRetVal = "INSTALL_SUSPEND"
Case 1605 : MsiexecRetVal = "UNKNOWN_PRODUCT"
Case 1606 : MsiexecRetVal = "UNKNOWN_FEATURE"
Case 1607 : MsiexecRetVal = "UNKNOWN_COMPONENT"
Case 1608 : MsiexecRetVal = "UNKNOWN_PROPERTY"
Case 1609 : MsiexecRetVal = "INVALID_HANDLE_STATE"
Case 1610 : MsiexecRetVal = "BAD_CONFIGURATION"
Case 1611 : MsiexecRetVal = "INDEX_ABSENT"
Case 1612 : MsiexecRetVal = "INSTALL_SOURCE_ABSENT"
Case 1613 : MsiexecRetVal = "INSTALL_PACKAGE_VERSION"
Case 1614 : MsiexecRetVal = "PRODUCT_UNINSTALLED"
Case 1615 : MsiexecRetVal = "BAD_QUERY_SYNTAX"
Case 1616 : MsiexecRetVal = "INVALID_FIELD"
Case 1618 : MsiexecRetVal = "INSTALL_ALREADY_RUNNING"
Case 1619 : MsiexecRetVal = "INSTALL_PACKAGE_OPEN_FAILED"
Case 1620 : MsiexecRetVal = "INSTALL_PACKAGE_INVALID"
Case 1621 : MsiexecRetVal = "INSTALL_UI_FAILURE"
Case 1622 : MsiexecRetVal = "INSTALL_LOG_FAILURE"
Case 1623 : MsiexecRetVal = "INSTALL_LANGUAGE_UNSUPPORTED"
Case 1624 : MsiexecRetVal = "INSTALL_TRANSFORM_FAILURE"
Case 1625 : MsiexecRetVal = "INSTALL_PACKAGE_REJECTED"
Case 1626 : MsiexecRetVal = "FUNCTION_NOT_CALLED"
Case 1627 : MsiexecRetVal = "FUNCTION_FAILED"
Case 1628 : MsiexecRetVal = "INVALID_TABLE"
Case 1629 : MsiexecRetVal = "DATATYPE_MISMATCH"
Case 1630 : MsiexecRetVal = "UNSUPPORTED_TYPE"
Case 1631 : MsiexecRetVal = "CREATE_FAILED"
Case 1632 : MsiexecRetVal = "INSTALL_TEMP_UNWRITABLE"
Case 1633 : MsiexecRetVal = "INSTALL_PLATFORM_UNSUPPORTED"
Case 1634 : MsiexecRetVal = "INSTALL_NOTUSED"
Case 1635 : MsiexecRetVal = "PATCH_PACKAGE_OPEN_FAILED"
Case 1636 : MsiexecRetVal = "PATCH_PACKAGE_INVALID"
Case 1637 : MsiexecRetVal = "PATCH_PACKAGE_UNSUPPORTED"
Case 1638 : MsiexecRetVal = "PRODUCT_VERSION"
Case 1639 : MsiexecRetVal = "INVALID_COMMAND_LINE"
Case 1640 : MsiexecRetVal = "INSTALL_REMOTE_DISALLOWED"
Case 1641 : MsiexecRetVal = "SUCCESS_REBOOT_INITIATED"
Case 1642 : MsiexecRetVal = "PATCH_TARGET_NOT_FOUND"
Case 1643 : MsiexecRetVal = "PATCH_PACKAGE_REJECTED"
Case 1644 : MsiexecRetVal = "INSTALL_TRANSFORM_REJECTED"
Case 1645 : MsiexecRetVal = "INSTALL_REMOTE_PROHIBITED"
Case 1646 : MsiexecRetVal = "PATCH_REMOVAL_UNSUPPORTED"
Case 1647 : MsiexecRetVal = "UNKNOWN_PATCH"
Case 1648 : MsiexecRetVal = "PATCH_NO_SEQUENCE"
Case 1649 : MsiexecRetVal = "PATCH_REMOVAL_DISALLOWED"
Case 1650 : MsiexecRetVal = "INVALID_PATCH_XML"
Case 3010 : MsiexecRetVal = "SUCCESS_REBOOT_REQUIRED"
Case Else : MsiexecRetVal = "Unknown Return Value"
End Select
End Function 'MsiexecRetVal
'=======================================================================================================
'Error codes for 2007 Office update packages (aka Microsoft Self-Extractor)
Function ExtractorRetVal(iRetVal)
On Error Resume Next
Select Case iRetVal
Case 0 : ExtractorRetVal = "Success"
Case 17301 : ExtractorRetVal = "Error: General Detection error"
Case 17302 : ExtractorRetVal = "Error: Applying patch"
Case 17303 : ExtractorRetVal = "Error: Extracting file"
Case 17021 : ExtractorRetVal = "Error: Creating temp folder"
Case 17022 : ExtractorRetVal = "Success: Reboot flag set"
Case 17023 : ExtractorRetVal = "Error: User cancelled installation"
Case 17024 : ExtractorRetVal = "Error: Creating folder failed"
Case 17025 : ExtractorRetVal = "Patch already installed"
Case 17026 : ExtractorRetVal = "Patch already installed to admin installation"
Case 17027 : ExtractorRetVal = "Installation source requires full file update"
Case 17028 : ExtractorRetVal = "No product installed for contained patch"
Case 17029 : ExtractorRetVal = "Patch failed to install"
Case 17030 : ExtractorRetVal = "Detection: Invalid CIF format"
Case 17031 : ExtractorRetVal = "Detection: Invalid baseline"
Case 17034 : ExtractorRetVal = "Error: Required patch does not apply to the machine"
Case Else : ExtractorRetVal = "Unknown Return Value"
End Select
End Function 'ExtractorRetVal
'=======================================================================================================
'Get Version Major from GUID
Function GetVersionMajor(sProductCode)
Dim iVersionMajor
On Error Resume Next
iVersionMajor = 0
If UCase(Right(sProductCode,28)) = OFFICE_2000 Then iVersionMajor = 9
If UCase(Right(sProductCode,28)) = ORK_2000 Then iVersionMajor = 9
If UCase(Right(sProductCode,28)) = PRJ_2000 Then iVersionMajor = 9
If UCase(Right(sProductCode,28)) = VIS_2002 Then iVersionMajor = 10
If UCase(Right(sProductCode,28)) = OFFICE_2002 Then iVersionMajor = 10
If UCase(Right(sProductCode,28)) = OFFICE_2003 Then iVersionMajor = 11
If UCase(Right(sProductCode,28)) = PPS_2007 Then iVersionMajor = 12
If UCase(Right(sProductCode,17)) = OFFICEID Then iVersionMajor = Mid(sProductCode,4,2)
GetVersionMajor = iVersionMajor
End Function
'=======================================================================================================
Function GetProductID (sProdId,sVersion)
Dim sReturn
Select Case sVersion
Case "2010"
Select Case sProdId
Case "000F" : sReturn = "Office Mondo"
Case "0010" : sReturn = "Web Folders"
Case "0011" : sReturn = "Office Professional Plus"
Case "0012" : sReturn = "Office Standard"
Case "0013" : sReturn = "Office Basic"
Case "0014" : sReturn = "Office Professional"
Case "0015" : sReturn = "Access"
Case "0016" : sReturn = "Excel"
Case "0017" : sReturn = "SharePoint Designer"
Case "0018" : sReturn = "PowerPoint"
Case "0019" : sReturn = "Publisher"
Case "001A" : sReturn = "Outlook"
Case "001B" : sReturn = "Word"
Case "001C" : sReturn = "Access Runtime"
Case "001F" : sReturn = "Proof"
Case "0020" : sReturn = "Office Compatibility Pack for Word, Excel, and PowerPoint 2007 File Formats"
Case "0021" : sReturn = "Visual Studio Web Authoring Component (Office Visual Web Developer)"
Case "0026" : sReturn = "Expression Web"
Case "0029" : sReturn = "Excel"
Case "002A" : sReturn = "Office 64-bit Components"
Case "002B" : sReturn = "Word"
Case "002C" : sReturn = "Proofing"
Case "002E" : sReturn = "Office Ultimate"
Case "002F" : sReturn = "Office Home and Student"
Case "0028" : sReturn = "Office IME"
Case "0030" : sReturn = "Office Enterprise"
Case "0031" : sReturn = "Office Professional Hybrid"
Case "0033" : sReturn = "Office Personal"
Case "0035" : sReturn = "Office Professional Hybrid"
Case "0037" : sReturn = "PowerPoint"
Case "003A" : sReturn = "Project Standard"
Case "003B" : sReturn = "Project Professional"
Case "003D" : sReturn = "Office Single Image"
Case "003F" : sReturn = "Excel Viewer"
Case "0043" : sReturn = "Office 32bit Components"
Case "0044" : sReturn = "InfoPath"
Case "0045" : sReturn = "Expression Web"
Case "0048" : sReturn = "Outlook Hotmail Connector"
Case "0049" : sReturn = "Office Academic"
Case "004A" : sReturn = "2003 Web Components"
Case "0051" : sReturn = "Visio Professional"
Case "0052" : sReturn = "Visio Viewer"
Case "0053" : sReturn = "Visio Standard"
Case "0054" : sReturn = "Visio MUI"
Case "0055" : sReturn = "Visio MUI"
Case "0057" : sReturn = "Visio"
Case "0061" : sReturn = "Click-to-Run"
Case "0062" : sReturn = "Click-to-Run"
Case "0066" : sReturn = "Click-to-Run"
Case "006C" : sReturn = "Click-to-Run"
Case "006D" : sReturn = "Click-to-Run"
Case "006E" : sReturn = "Office Shared"
Case "006F" : sReturn = "Office"
Case "0074" : sReturn = "Office Starter"
Case "007A" : sReturn = "Outlook Connector"
Case "007C" : sReturn = "Outlook Social Connector Provider for FaceBook"
Case "007D" : sReturn = "Outlook Social Connector Provider for Windows Live Messenger"
Case "008A" : sReturn = "Office Recent Documents Gadget"
Case "008B" : sReturn = "Office Small Business Basics"
Case "00A1" : sReturn = "OneNote"
Case "00A3" : sReturn = "OneNote Home Student"
Case "00A4" : sReturn = "Office 2003 Web Components"
Case "00A7" : sReturn = "Calendar Printing Assistant for Microsoft Office Outlook"
Case "00A9" : sReturn = "InterConnect"
Case "00AF" : sReturn = "PowerPoint Viewer"
Case "00B0" : sReturn = "Save as PDF Add-in"
Case "00B1" : sReturn = "Save as XPS Add-in"
Case "00B2" : sReturn = "Save as PDF or XPS Add-in"
Case "00B3" : sReturn = "Project Add-in for Outlook"
Case "00B4" : sReturn = "Project MUI"
Case "00B5" : sReturn = "Project MUI"
Case "00B9" : sReturn = "Application Error Reporting"
Case "00BA" : sReturn = "Groove"
Case "00BC" : sReturn = "InterConnect Outlook"
Case "00CA" : sReturn = "Office Small Business"
Case "00E0" : sReturn = "Outlook"
Case "00D1" : sReturn = "Access Connectivity Engine ACE"
Case "0100" : sReturn = "Office MUI"
Case "0101" : sReturn = "Office XMUI"
Case "0103" : sReturn = "Office Proofing Tools Kit"
Case "0114" : sReturn = "Groove Setup Metadata"
Case "0115" : sReturn = "Office Shared Setup Metadata"
Case "0116" : sReturn = "Office Shared Setup Metadata"
Case "0117" : sReturn = "Access Setup Metadata"
Case "011A" : sReturn = "Send A Smile"
Case "011D" : sReturn = "Office Professional Plus Subscription"
Case "011F" : sReturn = "Outlook Connector"
Case "1014" : sReturn = "SharePoint Foundation Core"
Case "1015" : sReturn = "SharePoint Foundation Lang Pack"
Case "101F" : sReturn = "Office Server Proof"
Case "1031" : sReturn = "Project Server Web Front End"
Case "1032" : sReturn = "Project Server Application Server"
Case "104B" : sReturn = "Office SharePoint Portal"
Case "104C" : sReturn = "User Profiles"
Case "104E" : sReturn = "Office SharePoint Portal Language Pack"
Case "107F" : sReturn = "Shared Components"
Case "1080" : sReturn = "Office Shared Coms (Srv) Language Pack"
Case "1088" : sReturn = "Slide Library"
Case "10B0" : sReturn = "Project Server Language Pack"
Case "10D7" : sReturn = "InfoPath Forms Services"
Case "10D8" : sReturn = "InfoPath Forms Services Language Pack"
Case "10EB" : sReturn = "Office Document Lifecycle Application Server Components"
Case "10EC" : sReturn = "Word Server"
Case "10ED" : sReturn = "Word Server Language Pack"
Case "10EE" : sReturn = "PerformancePoint Services"
Case "10F0" : sReturn = "PerformancePoint Services Language Pack"
Case "10F1" : sReturn = "Visio Services Language Pack"
Case "10F3" : sReturn = "Visio Services Web Front End Components"
Case "10F5" : sReturn = "Excel Services"
Case "10F6" : sReturn = "Excel Services Web Front End Components"
Case "10F7" : sReturn = "Document Lifecycle Components"
Case "10F8" : sReturn = "Excel Services Language Pack"
Case "10FB" : sReturn = "Search Server"
Case "10FC" : sReturn = "Search"
Case "10FD" : sReturn = "Search Server Language Pack"
Case "1103" : sReturn = "Office Document Lifecycle Components Language Pack"
Case "1104" : sReturn = "Office Slide Library Language Pack"
Case "1105" : sReturn = "Office Primary Interop Assemblies"
Case "110D" : sReturn = "SharePoint Server"
Case "110F" : sReturn = "Project Server"
Case "1110" : sReturn = "Windows SharePoint Services (WSS)"
Case "1121" : sReturn = "Office SharePoint Server SDK and ECM Starter Kit"
Case "1122" : sReturn = "Windows SharePoint Services Developer Resources"
Case "1123" : sReturn = "Access Services Server"
Case "1124" : sReturn = "Access Services Language Pack"
Case "1125" : sReturn = "Web Companion Web Front End Components"
Case "1127" : sReturn = "Web Companion Components Language Pack"
Case "112A" : sReturn = "Web Analytics Web Front End Components"
Case "112D" : sReturn = "Office Web Apps"
Case "1131" : sReturn = "Web Analytics Language Pack"
Case "1138" : sReturn = "Excel Mobile Viewer Components"
Case "2000" : sReturn = "Microsoft Filter Pack"
Case Else
End Select 'sProdId
Case "2007"
Select Case sProdId
Case "0010" : sReturn = "Web Folders"
Case "0011" : sReturn = "Office Professional Plus"
Case "0012" : sReturn = "Office Standard"
Case "0013" : sReturn = "Office Basic"
Case "0014" : sReturn = "Office Professional"
Case "0015" : sReturn = "Access"
Case "0016" : sReturn = "Excel"
Case "0017" : sReturn = "SharePoint Designer"
Case "0018" : sReturn = "PowerPoint"
Case "0019" : sReturn = "Publisher"
Case "001A" : sReturn = "Outlook"
Case "001B" : sReturn = "Word"
Case "001C" : sReturn = "Access Runtime"
Case "001F" : sReturn = "Proof"
Case "0020" : sReturn = "Office Compatibility Pack for Word, Excel, and PowerPoint 2007 File Formats"
Case "0021" : sReturn = "Visual Studio Web Authoring Component (Office Visual Web Developer 2007)"
Case "0026" : sReturn = "Expression Web"
Case "0029" : sReturn = "Excel"
Case "002A" : sReturn = "Office 64-bit Components"
Case "002B" : sReturn = "Word"
Case "002C" : sReturn = "Proofing"
Case "002E" : sReturn = "Office Ultimate"
Case "002F" : sReturn = "Office Home and Student"
Case "0028" : sReturn = "Office IME"
Case "0030" : sReturn = "Office Enterprise"
Case "0031" : sReturn = "Office Professional Hybrid"
Case "0033" : sReturn = "Office Personal"
Case "0035" : sReturn = "Office Professional Hybrid 2007"
Case "0038" : sReturn = "Time Zone Data Update Tool for Outlook"
Case "0037" : sReturn = "PowerPoint"
Case "003A" : sReturn = "Project Standard"
Case "003B" : sReturn = "Project Professional"
Case "003F" : sReturn = "Excel Viewer"
Case "0043" : sReturn = "Time Zone Data Update Engine for Outlook"
Case "0044" : sReturn = "InfoPath"
Case "0045" : sReturn = "Expression Web 2"
Case "0051" : sReturn = "Visio Professional"
Case "0052" : sReturn = "Visio Viewer"
Case "0053" : sReturn = "Visio Standard"
Case "0054" : sReturn = "Visio MUI"
Case "0055" : sReturn = "Visio MUI"
Case "0057" : sReturn = "Visio"
Case "006E" : sReturn = "Office Shared"
Case "008A" : sReturn = "Office Recent Documents Gadget"
Case "00A1" : sReturn = "OneNote"
Case "00A3" : sReturn = "OneNote Home Student"
Case "00A4" : sReturn = "Office 2003 Web Components"
Case "00A7" : sReturn = "Calendar Printing Assistant for Microsoft Office Outlook"
Case "00A9" : sReturn = "InterConnect"
Case "00AF" : sReturn = "PowerPoint Viewer"
Case "00B0" : sReturn = "Save as PDF Add-in for 2007 Microsoft Office programs"
Case "00B1" : sReturn = "Save as XPS Add-in for 2007 Microsoft Office programs"
Case "00B2" : sReturn = "Save as PDF or XPS Add-in for 2007 Microsoft Office programs"
Case "00B3" : sReturn = "Project Add-in for Outlook"
Case "00B4" : sReturn = "Project MUI"
Case "00B5" : sReturn = "Project MUI"
Case "00B9" : sReturn = "Application Error Reporting"
Case "00BA" : sReturn = "Groove"
Case "00BC" : sReturn = "InterConnect Outlook"
Case "00CA" : sReturn = "Office Small Business"
Case "00E0" : sReturn = "Outlook"
Case "00D1" : sReturn = "Access Connectivity Engine ACE"
Case "0100" : sReturn = "Office MUI"
Case "0101" : sReturn = "Office XMUI"
Case "0103" : sReturn = "Office Proofing Tools Kit"
Case "0114" : sReturn = "Groove Setup Metadata"
Case "0115" : sReturn = "Office Shared Setup Metadata"
Case "0116" : sReturn = "Office Shared Setup Metadata"
Case "0117" : sReturn = "Access Setup Metadata"
Case "011A" : sReturn = "Windows Live Web Folder Connector"
Case "011F" : sReturn = "Outlook Connector"
Case "1014" : sReturn = "Windows SharePoint Services 3.0 (STS)"
Case "1015" : sReturn = "Windows SharePoint Services 3.0 Lang Pack"
Case "1032" : sReturn = "Project Server Application Server"
Case "104B" : sReturn = "Office SharePoint Portal"
Case "104E" : sReturn = "Office SharePoint Portal Language Pack"
Case "107F" : sReturn = "Office Shared Components (Srv)"
Case "1080" : sReturn = "Office Shared Coms (Srv)"
Case "1088" : sReturn = "Office Slide Library"
Case "10D7" : sReturn = "InfoPath Forms Services"
Case "10D8" : sReturn = "InfoPath Forms Services Language Pack"
Case "10EB" : sReturn = "Office Document Lifecycle Application Server Components"
Case "10F5" : sReturn = "Excel Services"
Case "10F6" : sReturn = "Excel Services Web Front End Components"
Case "10F7" : sReturn = "Office Document Lifecycle Components"
Case "10F8" : sReturn = "Excel Services Language Pack"
Case "10FB" : sReturn = "Search Front End"
Case "10FC" : sReturn = "Search"
Case "10FD" : sReturn = "Search Language Pack"
Case "1103" : sReturn = "Office Document Lifecycle Components Language Pack"
Case "1104" : sReturn = "Office Slide Library Language Pack"
Case "1105" : sReturn = "Office Primary Interop Assemblies"
Case "1106" : sReturn = "Groove Management Server"
Case "1109" : sReturn = "Groove Server Relay"
Case "110D" : sReturn = "Office SharePoint Server (MOSS)"
Case "110F" : sReturn = "Project Server"
Case "1110" : sReturn = "Windows SharePoint Services 3.0 (WSS)"
Case "1121" : sReturn = "Office SharePoint Server 2007 SDK and ECM Starter Kit"
Case "1122" : sReturn = "Windows SharePoint Services Developer Resources 1.2"
Case Else
End Select 'sProdId
Case "2003"
Select Case sProdId
Case "11" : sReturn = "Office Professional Enterprise"
Case "12" : sReturn = "Office Standard"
Case "13" : sReturn = "Office Basic"
Case "14" : sReturn = "Windows SharePoint Services 2.0"
Case "15" : sReturn = "Access"
Case "16" : sReturn = "Excel"
Case "17" : sReturn = "FrontPage"
Case "18" : sReturn = "PowerPoint"
Case "19" : sReturn = "Publisher"
Case "1A" : sReturn = "Outlook Professional"
Case "1B" : sReturn = "Word"
Case "1C" : sReturn = "Access Runtime"
Case "1E" : sReturn = "Office MUI"
Case "1F" : sReturn = "Office Proofing Tools Kit"
Case "23" : sReturn = "Office MUI"
Case "24" : sReturn = "Office Resource Kit (ORK)"
Case "26" : sReturn = "Office XP Web Components"
Case "2E" : sReturn = "Office Research Service SDK"
Case "32" : sReturn = "Project Server"
Case "33" : sReturn = "Office Personal Edition"
Case "3A" : sReturn = "Project Standard"
Case "3B" : sReturn = "Project Professional"
Case "3C" : sReturn = "Project MUI"
Case "44" : sReturn = "InfoPath"
Case "48" : sReturn = "InfoPath 2003 Toolkit for Visual Studio 2005"
Case "49" : sReturn = "Office Primary Interop Assemblies"
Case "51" : sReturn = "Visio Professional"
Case "52" : sReturn = "Visio Viewer"
Case "53" : sReturn = "Visio Standard"
Case "55" : sReturn = "Visio for Enterprise Architects"
Case "5E" : sReturn = "Visio MUI"
Case "83" : sReturn = "Office HTML Viewer"
Case "84" : sReturn = "Excel Viewer"
Case "85" : sReturn = "Word Viewer"
Case "92" : sReturn = "Windows SharePoint Services 2.0 English Template Pack"
Case "93" : sReturn = "Office Web Parts and Components"
Case "A1" : sReturn = "OneNote"
Case "A4" : sReturn = "Office Web Components"
Case "A5" : sReturn = "SharePoint Migration Tool"
Case "A9" : sReturn = "InterConnect 2004"
Case "AA" : sReturn = "PowerPoint 2003 Presentation Broadcast"
Case "AB" : sReturn = "PowerPoint 2003 Template Pack 1"
Case "AC" : sReturn = "PowerPoint 2003 Template Pack 2"
Case "AD" : sReturn = "PowerPoint 2003 Template Pack 3"
Case "AE" : sReturn = "Office Organization Chart 2.0"
Case "CA" : sReturn = "Office Small Business Edition"
Case "D0" : sReturn = "Access Developer Extensions"
Case "DC" : sReturn = "Office Smart Document SDK"
Case "E0" : sReturn = "Outlook Standard"
Case "E3" : sReturn = "Office Professional Edition (with InfoPath)"
Case "F7" : sReturn = "InfoPath 2003 Toolkit for Visual Studio .NET"
Case "F8" : sReturn = "Office Remove Hidden Data Tool"
Case "FD" : sReturn = "Outlook (distributed by MSN)"
Case "FF" : sReturn = "Office Language Interface Pack"
Case Else : sReturn = ""
End Select 'ProdId
Case "2002"
Select Case sProdId
Case "11" : sReturn = "Office Professional"
Case "12" : sReturn = "Office Standard"
Case "13" : sReturn = "Office Small Business"
Case "14" : sReturn = "Office Web Server"
Case "15" : sReturn = "Access"
Case "16" : sReturn = "Excel"
Case "17" : sReturn = "FrontPage"
Case "18" : sReturn = "PowerPoint"
Case "19" : sReturn = "Publisher"
Case "1A" : sReturn = "Outlook"
Case "1B" : sReturn = "Word"
Case "1C" : sReturn = "Access Runtime"
Case "1D" : sReturn = "Frontpage MUI"
Case "1E" : sReturn = "Office MUI"
Case "1F" : sReturn = "Office Proofing Tools Kit"
Case "20" : sReturn = "System Files Update"
Case "23" : sReturn = "Office MUI Wizard"
Case "24" : sReturn = "Office Resource Kit (ORK)"
Case "25" : sReturn = "Office Resource Kit (ORK) Web Download"
Case "26" : sReturn = "Office XP Web Components"
Case "27" : sReturn = "Project"
Case "28" : sReturn = "Office Professional with FrontPage"
Case "29" : sReturn = "Office Professional Subscription"
Case "2A" : sReturn = "Office Small Business Subscription"
Case "2B" : sReturn = "Publisher Deluxe Edition"
Case "2F" : sReturn = "Office Standalone IME"
Case "30" : sReturn = "Office Media Content "
Case "32" : sReturn = "Project Web Server"
Case "33" : sReturn = "Office PIPC1 - Pre Installed PC"
Case "34" : sReturn = "Office PIPC2 - Pre Installed PC"
Case "35" : sReturn = "Office Media Content Deluxe"
Case "3A" : sReturn = "Project Standard"
Case "3B" : sReturn = "Project Professional"
Case "3C" : sReturn = "Project MUI"
Case "3D" : sReturn = "Office Standard for Students and Teachers"
Case "51" : sReturn = "Visio Professional"
Case "52" : sReturn = "Visio Viewer"
Case "53" : sReturn = "Visio Standard"
Case "54" : sReturn = "Visio Standard"
Case "91" : sReturn = "Office Professional"
Case "92" : sReturn = "Office Standard"
Case "93" : sReturn = "Office Small Business"
Case "94" : sReturn = "Office Web Server"
Case "95" : sReturn = "Access"
Case "96" : sReturn = "Excel"
Case "97" : sReturn = "FrontPage"
Case "98" : sReturn = "PowerPoint"
Case "99" : sReturn = "Publisher"
Case "9A" : sReturn = "Outlook"
Case "9B" : sReturn = "Word"
Case "9C" : sReturn = "Access Runtime"
Case Else : sReturn = ""
End Select 'ProdId
Case "2000"
Select Case CInt("&h"&sProdId)
Case 0 : sReturn = "Office Premium CD1"
Case 1 : sReturn = "Office Professional"
Case 2 : sReturn = "Office Standard"
Case 3 : sReturn = "Office Small Business"
Case 4 : sReturn = "Office Premium CD2"
Case 5 : sReturn = "Office CD2 SMALL"
Case 6 : sReturn = "Office Personal"
Case 7 : sReturn = "Word and Excel"
Case 16 : sReturn = "Access"
Case 17 : sReturn = "Excel"
Case 18 : sReturn = "FrontPage"
Case 19 : sReturn = "PowerPoint"
Case 20 : sReturn = "Publisher"
Case 21 : sReturn = "Office Server Extensions"
Case 22 : sReturn = "Outlook"
Case 23 : sReturn = "Word"
Case 24 : sReturn = "Access Runtime"
Case 25 : sReturn = "FrontPage Server Extensions"
Case 26 : sReturn = "Publisher Standalone OEM"
Case 27 : sReturn = "DMMWeb"
Case 28 : sReturn = "FP WECCOM"
Case 29 : sReturn = "Word"
Case 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47 : sReturn = "Office MUI"
Case 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63 : sReturn = "Office Proofing Tools Kit"
Case 64 : sReturn = "Publisher Trial"
Case 65 : sReturn = "Publisher Trial Web"
Case 66 : sReturn = "SBB"
Case 67 : sReturn = "SBT"
Case 68 : sReturn = "SBT CD2"
Case 69 : sReturn = "SBTART"
Case 70 : sReturn = "Office Web Components"
Case 71 : sReturn = "VP Office CD2 with LVP"
Case 72 : sReturn = "VP PUB with LVP"
Case 73 : sReturn = "VP PUB with LVP OEM"
Case 79 : sReturn = "Access 2000 SR-1 Run-Time Minimum"
Case Else : sReturn = ""
End Select 'sProdId
Case Else : sReturn = ""
End Select 'sVersion
GetProductID = sReturn
End Function
'=======================================================================================================
'Gets the release type ID from the ProductCode as integer and returns a string
Function GetReleaseType (iR)
Dim sR
Select Case iR
'Disable Case 0 to avoid noise in the output
Case 0 : sR = "Volume License"
Case 1 : sR = "Retail"
Case 2 : sR = "Trial"
Case Else : sR = ""
End Select
GetReleaseType = sR
End Function
'=======================================================================================================
'=======================================================================================================
'Get the culture info tag from LCID
Function GetCultureInfo (sLcid)
Dim sLang
Select Case UCase(Hex(CInt(sLcid)))
Case "0" : sLang = "neutral"
Case "7F" : sLang = "invariant" 'Invariant culture
Case "36" : sLang = "af" ' Afrikaans
Case "436" : sLang = "af-ZA" ' Afrikaans (South Africa)
Case "1C" : sLang = "sq" ' Albanian
Case "41C" : sLang = "sq-AL" ' Albanian (Albania)
Case "1" : sLang = "ar" ' Arabic
Case "1401" : sLang = "ar-DZ" ' Arabic (Algeria)
Case "3C01" : sLang = "ar-BH" ' Arabic (Bahrain)
Case "C01" : sLang = "ar-EG" ' Arabic (Egypt)
Case "801" : sLang = "ar-IQ" ' Arabic (Iraq)
Case "2C01" : sLang = "ar-JO" ' Arabic (Jordan)
Case "3401" : sLang = "ar-KW" ' Arabic (Kuwait)
Case "3001" : sLang = "ar-LB" ' Arabic (Lebanon)
Case "1001" : sLang = "ar-LY" ' Arabic (Libya)
Case "1801" : sLang = "ar-MA" ' Arabic (Morocco)
Case "2001" : sLang = "ar-OM" ' Arabic (Oman)
Case "4001" : sLang = "ar-QA" ' Arabic (Qatar)
Case "401" : sLang = "ar-SA" ' Arabic (Saudi Arabia)
Case "2801" : sLang = "ar-SY" ' Arabic (Syria)
Case "1C01" : sLang = "ar-TN" ' Arabic (Tunisia)
Case "3801" : sLang = "ar-AE" ' Arabic (U.A.E.)
Case "2401" : sLang = "ar-YE" ' Arabic (Yemen)
Case "2B" : sLang = "hy" ' Armenian
Case "42B" : sLang = "hy-AM" ' Armenian (Armenia)
Case "2C" : sLang = "az" ' Azeri
Case "82C" : sLang = "az-Cyrl-AZ" ' Azeri (Azerbaijan, Cyrillic)
Case "42C" : sLang = "az-Latn-AZ" ' Azeri (Azerbaijan, Latin)
Case "2D" : sLang = "eu" ' Basque
Case "42D" : sLang = "eu-ES" ' Basque (Basque)
Case "23" : sLang = "be" ' Belarusian
Case "423" : sLang = "be-BY" ' Belarusian (Belarus)
Case "2" : sLang = "bg" ' Bulgarian
Case "402" : sLang = "bg-BG" ' Bulgarian (Bulgaria)
Case "3" : sLang = "ca" ' Catalan
Case "403" : sLang = "ca-ES" ' Catalan (Catalan)
Case "C04" : sLang = "zh-HK" ' Chinese (Hong Kong SAR, PRC)
Case "1404" : sLang = "zh-MO" ' Chinese (Macao SAR)
Case "804" : sLang = "zh-CN" ' Chinese (PRC)
Case "4" : sLang = "zh-Hans" ' Chinese (Simplified)
Case "1004" : sLang = "zh-SG" ' Chinese (Singapore)
Case "404" : sLang = "zh-TW" ' Chinese (Taiwan)
Case "7C04" : sLang = "zh-Hant" ' Chinese (Traditional)
Case "1A" : sLang = "hr" ' Croatian
Case "41A" : sLang = "hr-HR" ' Croatian (Croatia)
Case "5" : sLang = "cs" ' Czech
Case "405" : sLang = "cs-CZ" ' Czech (Czech Republic)
Case "6" : sLang = "da" ' Danish
Case "406" : sLang = "da-DK" ' Danish (Denmark)
Case "65" : sLang = "dv" ' Divehi
Case "465" : sLang = "dv-MV" ' Divehi (Maldives)
Case "13" : sLang = "nl" ' Dutch
Case "813" : sLang = "nl-BE" ' Dutch (Belgium)
Case "413" : sLang = "nl-NL" ' Dutch (Netherlands)
Case "9" : sLang = "en" ' English
Case "C09" : sLang = "en-AU" ' English (Australia)
Case "2809" : sLang = "en-BZ" ' English (Belize)
Case "1009" : sLang = "en-CA" ' English (Canada)
Case "2409" : sLang = "en-029" ' English (Caribbean)
Case "1809" : sLang = "en-IE" ' English (Ireland)
Case "2009" : sLang = "en-JM" ' English (Jamaica)
Case "1409" : sLang = "en-NZ" ' English (New Zealand)
Case "3409" : sLang = "en-PH" ' English (Philippines)
Case "1C09" : sLang = "en-ZA" ' English (South Africa
Case "2C09" : sLang = "en-TT" ' English (Trinidad and Tobago)
Case "809" : sLang = "en-GB" ' English (United Kingdom)
Case "409" : sLang = "en-US" ' English (United States)
Case "3009" : sLang = "en-ZW" ' English (Zimbabwe)
Case "25" : sLang = "et" ' Estonian
Case "425" : sLang = "et-EE" ' Estonian (Estonia)
Case "38" : sLang = "fo" ' Faroese
Case "438" : sLang = "fo-FO" ' Faroese (Faroe Islands)
Case "29" : sLang = "fa" ' Farsi
Case "429" : sLang = "fa-IR" ' Farsi (Iran)
Case "B" : sLang = "fi" ' Finnish
Case "40B" : sLang = "fi-FI" ' Finnish (Finland)
Case "C" : sLang = "fr" ' French
Case "80C" : sLang = "fr-BE" ' French (Belgium)
Case "C0C" : sLang = "fr-CA" ' French (Canada)
Case "40C" : sLang = "fr-FR" ' French (France)
Case "140C" : sLang = "fr-LU" ' French (Luxembourg)
Case "180C" : sLang = "fr-MC" ' French (Monaco)
Case "100C" : sLang = "fr-CH" ' French (Switzerland)
Case "56" : sLang = "gl" ' Galician
Case "456" : sLang = "gl-ES" ' Galician (Spain)
Case "37" : sLang = "ka" ' Georgian
Case "437" : sLang = "ka-GE" ' Georgian (Georgia)
Case "7" : sLang = "de" ' German
Case "C07" : sLang = "de-AT" ' German (Austria)
Case "407" : sLang = "de-DE" ' German (Germany)
Case "1407" : sLang = "de-LI" ' German (Liechtenstein)
Case "1007" : sLang = "de-LU" ' German (Luxembourg)
Case "807" : sLang = "de-CH" ' German (Switzerland)
Case "8" : sLang = "el" ' Greek
Case "408" : sLang = "el-GR" ' Greek (Greece)
Case "47" : sLang = "gu" ' Gujarati
Case "447" : sLang = "gu-IN" ' Gujarati (India)
Case "D" : sLang = "he" ' Hebrew
Case "40D" : sLang = "he-IL" ' Hebrew (Israel)
Case "39" : sLang = "hi" ' Hindi
Case "439" : sLang = "hi-IN" ' Hindi (India)
Case "E" : sLang = "hu" ' Hungarian
Case "40E" : sLang = "hu-HU" ' Hungarian (Hungary)
Case "F" : sLang = "is" ' Icelandic
Case "40F" : sLang = "is-IS" ' Icelandic (Iceland)
Case "21" : sLang = "id" ' Indonesian
Case "421" : sLang = "id-ID" ' Indonesian (Indonesia)
Case "10" : sLang = "it" ' Italian
Case "410" : sLang = "it-IT" ' Italian (Italy)
Case "810" : sLang = "it-CH" ' Italian (Switzerland)
Case "11" : sLang = "ja" ' Japanese
Case "411" : sLang = "ja-JP" ' Japanese (Japan)
Case "4B" : sLang = "kn" ' Kannada
Case "44B" : sLang = "kn-IN" ' Kannada (India)
Case "3F" : sLang = "kk" ' Kazakh
Case "43F" : sLang = "kk-KZ" ' Kazakh (Kazakhstan)
Case "57" : sLang = "kok" ' Konkani
Case "457" : sLang = "kok-IN" ' Konkani (India)
Case "12" : sLang = "ko" ' Korean
Case "412" : sLang = "ko-KR" ' Korean (Korea)
Case "40" : sLang = "ky" ' Kyrgyz
Case "440" : sLang = "ky-KG" ' Kyrgyz (Kyrgyzstan)
Case "26" : sLang = "lv" ' Latvian
Case "426" : sLang = "lv-LV" ' Latvian (Latvia)
Case "27" : sLang = "lt" ' Lithuanian
Case "427" : sLang = "lt-LT" ' Lithuanian (Lithuania)
Case "2F" : sLang = "mk" ' Macedonian
Case "42F" : sLang = "mk-MK" ' Macedonian (Macedonia, FYROM)
Case "3E" : sLang = "ms" ' Malay
Case "83E" : sLang = "ms-BN" ' Malay (Brunei Darussalam)
Case "43E" : sLang = "ms-MY" ' Malay (Malaysia)
Case "4E" : sLang = "mr" ' Marathi
Case "44E" : sLang = "mr-IN" ' Marathi (India)
Case "50" : sLang = "mn" ' Mongolian
Case "450" : sLang = "mn-MN" ' Mongolian (Mongolia)
Case "14" : sLang = "no" ' Norwegian
Case "414" : sLang = "nb-NO" ' Norwegian (Bokmål, Norway)
Case "814" : sLang = "nn-NO" ' Norwegian (Nynorsk, Norway)
Case "15" : sLang = "pl" ' Polish
Case "415" : sLang = "pl-PL" ' Polish (Poland)
Case "16" : sLang = "pt" ' Portuguese
Case "416" : sLang = "pt-BR" ' Portuguese (Brazil)
Case "816" : sLang = "pt-PT" ' Portuguese (Portugal)
Case "46" : sLang = "pa" ' Punjabi
Case "446" : sLang = "pa-IN" ' Punjabi (India)
Case "18" : sLang = "ro" ' Romanian
Case "418" : sLang = "ro-RO" ' Romanian (Romania)
Case "19" : sLang = "ru" ' Russian
Case "419" : sLang = "ru-RU" ' Russian (Russia)
Case "4F" : sLang = "sa" ' Sanskrit
Case "44F" : sLang = "sa-IN" ' Sanskrit (India)
Case "C1A" : sLang = "sr-Cyrl-CS" ' Serbian (Serbia, Cyrillic)
Case "81A" : sLang = "sr-Latn-CS" ' Serbian (Serbia, Latin)
Case "1B" : sLang = "sk" ' Slovak
Case "41B" : sLang = "sk-SK" ' Slovak (Slovakia)
Case "24" : sLang = "sl" ' Slovenian
Case "424" : sLang = "sl-SI" ' Slovenian (Slovenia)
Case "A" : sLang = "es" ' Spanish
Case "2C0A" : sLang = "es-AR" ' Spanish (Argentina)
Case "400A" : sLang = "es-BO" ' Spanish (Bolivia)
Case "340A" : sLang = "es-CL" ' Spanish (Chile)
Case "240A" : sLang = "es-CO" ' Spanish (Colombia)
Case "140A" : sLang = "es-CR" ' Spanish (Costa Rica)
Case "1C0A" : sLang = "es-DO" ' Spanish (Dominican Republic)
Case "300A" : sLang = "es-EC" ' Spanish (Ecuador)
Case "440A" : sLang = "es-SV" ' Spanish (El Salvador)
Case "100A" : sLang = "es-GT" ' Spanish (Guatemala)
Case "480A" : sLang = "es-HN" ' Spanish (Honduras)
Case "80A" : sLang = "es-MX" ' Spanish (Mexico)
Case "4C0A" : sLang = "es-NI" ' Spanish (Nicaragua)
Case "180A" : sLang = "es-PA" ' Spanish (Panama)
Case "3C0A" : sLang = "es-PY" ' Spanish (Paraguay)
Case "280A" : sLang = "es-PE" ' Spanish (Peru)
Case "500A" : sLang = "es-PR" ' Spanish (Puerto Rico)
Case "C0A" : sLang = "es-ES" ' Spanish (Spain)
Case "380A" : sLang = "es-UY" ' Spanish (Uruguay)
Case "200A" : sLang = "es-VE" ' Spanish (Venezuela)
Case "41" : sLang = "sw" ' Swahili
Case "441" : sLang = "sw-KE" ' Swahili (Kenya)
Case "1D" : sLang = "sv" ' Swedish
Case "81D" : sLang = "sv-FI" ' Swedish (Finland)
Case "41D" : sLang = "sv-SE" ' Swedish (Sweden)
Case "5A" : sLang = "syr" ' Syriac
Case "45A" : sLang = "syr-SY" ' Syriac (Syria)
Case "49" : sLang = "ta" ' Tamil
Case "449" : sLang = "ta-IN" ' Tamil (India)
Case "44" : sLang = "tt" ' Tatar
Case "444" : sLang = "tt-RU" ' Tatar (Russia)
Case "4A" : sLang = "te" ' Telugu
Case "44A" : sLang = "te-IN" ' Telugu (India)
Case "1E" : sLang = "th" ' Thai
Case "41E" : sLang = "th-TH" ' Thai (Thailand)
Case "1F" : sLang = "tr" ' Turkish
Case "41F" : sLang = "tr-TR" ' Turkish (Turkey)
Case "22" : sLang = "uk" ' Ukrainian
Case "422" : sLang = "uk-UA" ' Ukrainian (Ukraine)
Case "20" : sLang = "ur" ' Urdu
Case "420" : sLang = "ur-PK" ' Urdu (Pakistan)
Case "43" : sLang = "uz" ' Uzbek
Case "843" : sLang = "uz-Cyrl-UZ" ' Uzbek (Uzbekistan, Cyrillic)
Case "443" : sLang = "uz-Latn-UZ" ' Uzbek (Uzbekistan, Latin)
Case "2A" : sLang = "vi" ' Vietnamese
Case "42A" : sLang = "vi-VN" ' Vietnamese (Vietnam)
Case Else : sLang = ""
End Select
GetCultureInfo = sLang
End Function'=======================================================================================================кладем файл в c:\temp\ на сервер с неработающими обновлениями.
Открываем CMD от администратора, переходим к директории c:\windows\installer
далее выполняем команду cscript.exe c:\temp\OpUtil.vbs/RepairCache/srestorelocation=c:\temp\
Open up a PowerShell window and run Get-SPProduct -local to update the farm’s configuration database.
Run psconfig.exe to update everything and now you should be ready to install your updates.
