'===================================================================== ' File: UpdateInstall.vbs '--------------------------------------------------------------------- ' ' Copyright (C) Microsoft Corporation. All rights reserved. ' 'THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF 'ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO 'THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A 'PARTICULAR PURPOSE. '===================================================================== Option Explicit '1. Runs Office Inventory Tool generating OfficeUpdate.MOF '2. Runs UpdateScan generating results.xml '3. Export Result XML to Result CSV '5. Export Office Update MOF to Result CSV 'environment variables Const Ver = "v1.0.57" Const vbQuote = """", vbDelim = "," Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const Force_Reboot = 6, Do_SemiSync = 48 'registry keys Const REG_SCAN = "HKLM\Software\Microsoft\Updates\UpdateScan\LastRun" Const REG_ISADMIN_POWERUSER = "HKLM\Software\IsAdminPowerUser" Const REG_ISADMIN = "HKLM\System\IsAdmin" Dim wsh, fso, net, root, xmldoc, oFile, oFileStream, i, nResult Dim szUpdate, windir, szScanDateTime, Header, system, File Dim instance, output, outputtext, szLine, szTemp, szArray Dim propertyname, propertyvalue, propertylist, CmdExe, bIsAdmin Dim username, userdomain, MachineName, DefaultCmdLine, CmdLine Dim os, csd, operatingsystem, InstallUpdate, Binary, BinaryFile Dim bDebug, bReboot, bMissing, bInstallUpdate, bNoRestart, bQuiet Dim oNodes, oNode, oChild, oItem, UpdateScanCmdLine, Authorized, szList Dim Share, Cache, Store, BinPath, IniFile, bVerbose, FileCheck Dim nMissing, nInstalled, nFailed, ScanInterval Dim comment, comments, oXML, osVer 'Code in Main function to allow for checking with VB6 IDE 'Dim Wscript Call Main '------------------------------------------------------------------------------------------------------------------------ Sub Main() On Error Resume Next Set wsh = CreateObject("Wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set instance = CreateObject("Scripting.Dictionary") Set system = CreateObject("Scripting.Dictionary") Set InstallUpdate = CreateObject("Scripting.Dictionary") Set Authorized = CreateObject("Scripting.Dictionary") Set net = CreateObject("Wscript.Network") Set xmldoc = CreateObject("Microsoft.XMLDOM") Call CheckQuit On Error GoTo 0 'default values bDebug = False: bVerbose = False: bReboot = False: bMissing = False: bInstallUpdate = False: bNoRestart = False nMissing = 0: nInstalled = 0: nFailed = 0 'command line switches to enable debug output For i = 0 To Wscript.Arguments.Count - 1 Select Case LCase(Wscript.Arguments.Item(i)) Case "/debug": bDebug = True Case "/verbose": bVerbose = True End Select Next root = Left(Wscript.ScriptFullName, InStrRev(Wscript.ScriptFullName, "\")) windir = wsh.ExpandEnvironmentStrings("%Windir%") Cache = windir & "\System32\VPCache\UpdateScan" CmdExe = windir & "\System32\cmd.exe /c " Store = root AddItem system, "UserDomain", net.userdomain AddItem system, "UserName", net.username AddItem system, "MachineName", net.ComputerName DefaultCmdLine = "/quiet /norestart" IniFile = root & "UpdateInstall.ini" If Not RegWrite(REG_ISADMIN,"True","REG_SZ") Then Wscript.Quit(-257) End If CreateFolder Cache On Error Resume Next Set outputtext = fso.CreateTextFile(Cache & "\Result.txt", True, -2): Call CheckError WriteLog system.Item("MachineName") & vbCrLf & system.Item("OperatingSystem") & vbCrLf & "Scanned at: " & Now() If Err.Number <> 0 Then Wscript.Quit (Err.Number) On Error GoTo 0 WriteLog "UpdateInstall.vbs [" & Ver & "]" 'build operating system string On Error Resume Next os = CStr(RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")) csd = CStr(RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CSDVersion")) If os = "" Then ' possible OS: Windows NT 4.0 osver = CInt(RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")) If osver = 4 Then os = "Windows NT 4.0" End If End If If csd = "" Then csd = "RTM" AddItem system, "OperatingSystem", os & " (" & csd & ")" WriteLog System.Item("OperatingSystem") On Error GoTo 0 'check if settings in configuration file If GetSetting(IniFile, "Authorized") <> "" Then szList = GetSetting(IniFile, "Authorized") WriteLog "Authorized List: " & szList If InStr(1, szList, ",") <> 0 Then For Each szTemp In Split(szList, ",") If Not Authorized.Exists(szTemp) Then AddItem Authorized, szTemp, "" Next Else AddItem Authorized, szList, "" End If Else AddItem Authorized, "ALL", "" End If If GetSetting(IniFile, "Share") <> "" Then Share = GetSetting(IniFile, "Share") If GetSetting(IniFile, "Store") <> "" Then Store = GetSetting(IniFile, "Store") If GetSetting(IniFile, "ScanInterval") <> "" Then ScanInterval = GetSetting(IniFile, "ScanInterval") If UCase(GetSetting(IniFile, "NoRestart")) = "TRUE" Then bNoRestart = True If UCase(GetSetting(IniFile, "Debug")) = "TRUE" Then bDebug = True If Not IsNumeric(ScanInterval) Or ScanInterval = "" Then ScanInterval = 7 'check if scan has already been preormed Call CheckLastTimeRun() 'command line switches will override any configuration settings For i = 0 To Wscript.Arguments.Count - 1 Select Case LCase(Wscript.Arguments.Item(i)) Case "/share": Share = Wscript.Arguments.Item(i + 1) Case "/store": Store = Wscript.Arguments.Item(i + 1) Case "/norestart": bNoRestart = True Case "/debug": bDebug = True Case "/verbose": bVerbose = True Case "/install": bInstallUpdate = True Case "/?", "/h": Wscript.Echo "WScript.exe //T:900 //B ScanWrapper.vbs /share [Share] /store [Store] {/nostart /verbose /install}": Wscript.Quit End Select Next ' Check for XML parser pre-requisites On Error Resume Next Err.Clear Set oXML = CreateObject("MSXML2.DOMDocument.3.0") If Err.Number <> 0 Then WriteLog("FATAL (PRE_REQ_0001): [Pre-Requisite] XML Parser 3.x not found in the system.") WScript.Quit End If On Error Goto 0 If Not Right(Store, 1) = "\" Then Store = Store & "\" If Share <> "" Then WriteLog "Share: " & Share If Store <> "" Then WriteLog "Store: " & Store 'level of results output If bVerbose Then propertylist = Array("BulletinID", "KB", "Product", "Title", "LocaleID", "Status", "ScanAgent", "ScanDateTime", "Type", "InfoPath", "BinPath") Else propertylist = Array("Product", "Title", "KB", "Status", "LocaleID", "Binary", "BinPath") End If 'Create CSV output On Error Resume Next Set output = fso.CreateTextFile(Cache & "\Result.csv", True, -2): Call CheckError If Err.Number <> 0 Then Wscript.Quit (Err.Number) On Error GoTo 0 Header = "MachineName,ScanDate,OperatingSystem" For Each propertyname In propertylist Header = Header & vbDelim & propertyname Next WriteCSV Header 'remove any existing temporary folder DeleteFolder Cache & "\NSHC" 'DeleteFile Cache & "\Results.xml" (Use /deleteresults instead) 'DeleteFile Cache & "\UpdateScan.Log" (UpdateScan now rolls over log) 'SyncFiles to Cache For Each File In Array("invcif.exe", "invcm.exe", "Updatescan.xml", "Updatescan.exe","offinst.exe") CopyFile root & File, Cache & "\" & File Next UpdateScanCmdLine = "/xml:Updatescan.xml /logfile:" & Cache & "\UpdateScan.log /loglevel:3 /deleteresults" If bVerbose Then UpdateScanCmdLine = Replace(UpdateScanCmdLine, "loglevel:3", "loglevel:4") 'execute the office inventory tool RunProgram CmdExe & Cache & "\invcif.exe", "/Q:A /C /T:" & vbQuote & Cache & "\NSHC" & vbQuote RunProgram CmdExe & Cache & "\invcm.exe", "/Q:A /C /T:" & vbQuote & Cache & "\NSHC" & vbQuote RunProgram CmdExe & Cache & "\NSHC\inventory.exe", "/s " & Cache & "\NSHC /o " & Cache & "\NSHC" RunProgram CmdExe & Cache & "\NSHC\convert.exe", "/d " & Cache & "\NSHC /o " & Cache & "\NSHC\OfficeUpdate.MOF /mof" RunProgram CmdExe & Cache & "\UpdateScan.exe", UpdateScanCmdLine 'load OfficeUpdate.MOF and Result.xml Call LoadMOF Call LoadXML(Cache & "\results.xml") 'install Updates If bInstallUpdate Then Call InstallUpdates() 'write summary output to RESULTS.TXT If nMissing = 0 Then WriteLog vbNewLine & "No missing updates detected" 'set scan date on no updates needed, this allows running scan twice to get compliance report 'failuires will rerun with no limit RegWrite REG_SCAN, now, "REG_SZ" Else WriteLog vbNewLine & "Installed " & nInstalled & " out of " & nMissing & " missing updates" If nFailed > 0 Then WriteLog vbNewLine & "Install failed on " & nFailed & " out of " & nMissing & " missing updates" End If 'copy results to share if path specified If Share <> "" Then 'create folder if it does not exist CreateFolder Share If FolderExists(Share) Then 'MachineName_20040917224421.txt and .csv If system.Exists("MachineName") Then CopyFile Cache & "\Result.txt", Share & "\" & system.Item("MachineName") & "_" & Left(WmiDate(), 14) & ".txt" CopyFile Cache & "\Result.csv", Share & "\" & system.Item("MachineName") & "_" & Left(WmiDate(), 14) & ".csv" End If End If End If 'remove temporary folders If Not bDebug Then 'DeleteFolder Cache & "\NSHC" 'DeleteFolder Cache & "\DLL" DeleteFolder Cache & "\PTemp" End If If bReboot Then If bNoRestart Then Wscript.Quit (3010) Else Call RestartSystem End If Else Wscript.Quit (0) End If End Sub Function StripC(str) StripC = Replace(str, ",", " ") End Function Sub LoadMOF() If FileExists(Cache & "\NSHC\OfficeUpdate.MOF") Then 'instance of Win32_PatchState '{ ' Product = "Office"; ' Title = "Office 2003 Service Pack 1 - English version"; ' LocaleID = "1033"; ' Status = "Installed"; ' ScanAgent = "Office Update Inventory Tool"; ' ScanDateTime = "20040915201801.000000+***"; ' Type = "Office"; ' InfoPath = { "http://www.microsoft.com/downloads/details.aspx?FamilyId=9C51D3A6-7CB1-4F61-837E-5F938254FC47&displaylang=en%s" }; ' BinPath = { "http://download.microsoft.com/download/1/A/9/1A9A2039-70E3-4E92-B977-756FE884F731/Office2003SP1-kb842532-client-enu.exe" }; ' Summary = "Office 2003 Service Pack 1 (SP1) provides the latest updates to Microsoft Office 2003. SP1 contains significant security enhancements, in addition to stability and performance improvements. This download applies to the following Office 2003 products: Access 2003, Access 2003 Runtime, Excel 2003, FrontPage 2003, Outlook 2003, PowerPoint 2003, Publisher 2003, Word 2003, Office 2003 Web Components and Office XP Web Components. SP1 also includes many performance and feature enhancements for InfoPath 2003." ; '}; On Error Resume Next Set oFile = fso.GetFile(Cache & "\NSHC\OfficeUpdate.MOF") If Err.Number <> 0 Or Not IsObject(oFile) Then Exit Sub Set oFileStream = oFile.OpenAsTextStream(ForReading, -2) If Err.Number <> 0 Or Not IsObject(oFileStream) Then Exit Sub On Error GoTo 0 Do While Not oFileStream.AtEndofStream szLine = Trim(oFileStream.ReadLine) 'start dictionary object over if new instance in MOF If Left(szLine, 2) = "};" Then 'if values exist from loading an instance write to result string If instance.Exists("Product") Then AddItem instance, "KB", GetID(Format(instance("Title"))) szUpdate = system.Item("MachineName") & vbDelim & WmiDate() & vbDelim & StripC(system.Item("OperatingSystem")) For Each propertyname In propertylist If system.Exists(propertyname) Then szUpdate = szUpdate & vbDelim & StripC(system.Item(propertyname)) If instance.Exists(propertyname) Then szUpdate = szUpdate & vbDelim & StripC(instance.Item(propertyname)) Next 'only report MS04-028 Office Updates If Authorized.Exists(instance.Item("KB")) Or Authorized.Exists("ALL") Then WriteCSV szUpdate 'only report missing updates in RESULTS.TXT If LCase(instance("Status")) = "applicable" Then 'add to dectionary if install flagged If bInstallUpdate Then Binary = instance("Binary") 'do not use root folder if store specified BinPath = Store & "Updates\" & instance("Product") & "\" & instance.Item("KB") & "\" & instance("LocaleID") & "\" & instance("Binary") 'since office returns a generic "product" we need more unique path for storing script (using KB-ID) 'downloads vary with office, check of client or fullfile (admin) Update. Check for language neutral (0) FileCheck = Replace(BinPath, "\" & instance("LocaleID") & "\", "\0\") If Instr(1,FileCheck,"-client-") <> 0 Then FileCheck = Replace(FileCheck, "-client-", "-fullfile-") If FileExists(FileCheck) Then 'full file language neutral AddItem InstallUpdate, Binary, FileCheck Else 'default reported path AddItem InstallUpdate, Binary, BinPath End If DebugLog "BinPath: " & instance.Item(Binary) End If 'generate missing result nMissing = nMissing + 1 If nMissing = 1 Then WriteLog vbCrLf & "Missing Software Updates" & vbCrLf & "===============================" For Each propertyname In propertylist WriteLog propertyname & ": " & instance(propertyname) Next End If End If End If instance.RemoveAll Else 'load properties If InStr(1, szLine, "=") <> 0 Then szArray = Split(Format(szLine), "=") If UBound(szArray) = 1 Then propertyname = Format(szArray(0)) propertyvalue = Format(szArray(1)) AddItem instance, propertyname, propertyvalue If propertyname = "BinPath" Then If InStr(1, propertyvalue, "/") > 0 Then AddItem instance, "Binary", Right(propertyvalue, Len(propertyvalue) - InStrRev(propertyvalue, "/")) Else AddItem instance, "Binary", "" End If End If 'DebugLog "[" & PropertyName & "],[" & PropertyValue & "]" End If End If End If Loop Else Wscript.Quit (-1) End If End Sub Sub LoadXML(ResultFile) 'if list mode, load the generated list of all possible results If FileExists(ResultFile) Then xmldoc.async = "false" xmldoc.Load (ResultFile) Set comments = xmldoc.getElementsByTagName("Comments") For Each comment In comments 'one comment WriteLog "Comments: " + comment.text Next Set oNodes = xmldoc.getElementsByTagName("Product") For Each oNode In oNodes instance.RemoveAll For Each oChild In oNode.ChildNodes Select Case LCase(oChild.NodeName) Case "productname": AddItem instance, "Product", Format(oChild.Text) Case "item" For Each oItem In oChild.ChildNodes 'Wscript.Echo oItem.NodeName Select Case LCase(oItem.NodeName) Case "bulletinid": AddItem instance, "BulletinID", Format(oItem.Text) Case "sqnumber": AddItem instance, "KB", Format(oItem.Text) Case "localeid": AddItem instance, "LocaleID", Format(oItem.Text) Case "bulletintitle": AddItem instance, "Title", Format(oItem.Text) Case "status": AddItem instance, "Status", Trim(oItem.Text) Case "bulletinurl": AddItem instance, "InfoPath", Trim(oItem.Text) Case "downloadurl": AddItem instance, "BinPath", Trim(oItem.Text) End Select Next If instance.Exists("BinPath") Then propertyvalue = instance.Item("BinPath") If InStr(1, propertyvalue, "/") > 0 Then AddItem instance, "Binary", Right(propertyvalue, Len(propertyvalue) - InStrRev(propertyvalue, "/")) Else AddItem instance, "Binary", "" End If End If szUpdate = system.Item("MachineName") & vbDelim & WmiDate() & vbDelim & StripC(system.Item("OperatingSystem")) For Each propertyname In propertylist szUpdate = szUpdate & vbDelim & StripC(instance(propertyname)) Next 'ONLY report MS04-028 Office Updates If Authorized.Exists(instance.Item("KB")) Or Authorized.Exists("ALL") Then WriteCSV szUpdate 'only report missing updates in RESULTS.TXT If LCase(instance.Item("Status")) = "applicable" Then If bInstallUpdate Then Binary = instance("Binary") 'do not use root folder if store specified BinPath = Store & "Updates\" & instance("Product") DebugLog "BinPath: " & BinPath If FileExists(BinPath & "\0\" & Binary) Then AddItem InstallUpdate, Binary, BinPath & "\0\" & Binary Else AddItem InstallUpdate, Binary, BinPath & "\" & instance("LocaleID") & "\" & Binary End If End If 'skip outputtext if list all mode nMissing = nMissing + 1 If nMissing = 1 Then WriteLog vbNewLine & vbNewLine & "Missing Software Updates" & vbCrLf & "===============================" For Each propertyname In propertylist WriteLog propertyname & ": " & instance(propertyname) Next End If End If End Select Next Next Else DebugLog "File not found " & ResultFile Wscript.Quit (-2) End If End Sub Sub InstallUpdates() Dim bOfficeUpdate If InstallUpdate.Count > 0 Then WriteLog vbNewLine & vbNewLine & "Install Software Updates" & vbCrLf & "===============================" For Each Binary In InstallUpdate.Keys bOfficeUpdate = False BinaryFile = InstallUpdate.Item(Binary) 'is this an office Update? special effort required If InStr(1, BinaryFile, "Updates\Office\") <> 0 Then bOfficeUpdate = True Else 'Workaround: manually check for syntax Select Case UCase(Left(Binary, 3)) Case "IE6": CmdLine = "/Q:A" 'IE6 Case "GDI", "JOU": CmdLine = "/Q:A /R:N" 'GDI Case "MSP": CmdLine = "/Q:A /C:" & vbQuote & "msiexec.exe /i prod2.msi /qn" & vbQuote 'producer Case "NDP", "VS6", "VS7": CmdLine = "/Q" '.NET, Visual Studio Case Else: CmdLine = DefaultCmdLine End Select End If 'check if binary exist, launch if found If FileExists(BinaryFile) Then WriteLog "Installing update: " & BinaryFile & " (" & CmdLine & ")" If InStr(1, Binary, "/") <> 0 Then Binary = Right(Binary, Len(Binary) - InStrRev(Binary, "/")) End If If bOfficeUpdate Then DebugLog "Office Update" DeleteFolder Cache & "\PTemp" nResult = RunProgram(CmdExe & vbQuote & vbQuote & BinaryFile & vbQuote, "/Q:A /C /T:" & vbQuote & Cache & "\PTemp" & vbQuote & vbQuote) If nResult = 0 Then If ConfigureOhotfix(Cache & "\PTemp\ohotfix.ini") Then 'now we have configure INI for silent install, lets run it nResult = RunProgram(CmdExe & vbQuote & Cache & "\PTemp\ohotfix.exe" & vbQuote, "") 'clean up tempory folder If nResult = 0 Or nResult = 3010 Then DeleteFolder Cache & "\PTemp" Else nResult = -255 WriteLog "Failed to configure OHOTFIX.INI, skipping install" End If Else WriteLog "Failed to extract office Update, skipping: " & nResult End If Else nResult = RunProgram(CmdExe & vbQuote & vbQuote & BinaryFile & vbQuote, CmdLine & vbQuote) End If 'log results Select Case nResult Case -255 nFailed = nFailed + 1 Case 0 WriteLog "Update was successful" nInstalled = nInstalled + 1 Case 3010: bReboot = True WriteLog "Update was successful, a system restart is required" nInstalled = nInstalled + 1 Case Else nFailed = nFailed + 1 WriteLog "Update failed with error " & nResult End Select Else nFailed = nFailed + 1 WriteLog "File not found: " & BinaryFile End If Next End If End Sub Function ConfigureOhotfix(szFile) Dim oFile, oFileStream, szLine, szReadAll, szText ConfigureOhotfix = False DebugLog "ConfigureOhotfix()" 'if package does not contain office ohotfix, extract from redist If Not FileExists(szFile) Then RunProgram CmdExe & Cache & "\offinst.exe", "/Q:A /C /T:" & vbQuote & Cache & "\PTemp" & vbQuote If Not FileExists(szFile) Then WriteLog "Unable to find ohotfix.ini" Exit Function End If End If 'crack open INI and set unattended UI levels On Error Resume Next Set oFile = fso.GetFile(szFile) If Err.Number <> 0 Then Call CheckError() : Exit Function 'get file stream Set oFileStream = oFile.OpenAsTextStream(ForReading, 0) szReadAll = oFileStream.ReadALL If Err.Number <> 0 Then Call CheckError() : Exit Function 'close file out oFileStream.Close If Err.Number <> 0 Then Call CheckError() : Exit Function 'remove temp file DeleteFile(szFile) 'make sure it is not empty If Instr(1,szReadAll,vbCrLf) = 0 Then WriteLog "Ohotfix empty, skipping update" Exit Function End If For Each szLine In Split(szReadAll,vbCrLf) DebugLog "Line: " & szLine If Err.Number <> 0 Then Call CheckError() : Exit Function 'setup UI level If InStr(1, szLine, "=") <> 0 Then Select Case Left(szLine, InStr(1, szLine, "=") - 1) Case "ShowSuccessDialog": szText = szText & vbCrLf & "ShowSuccessDialog=0" Case "OHotfixLogLevel": szText = szText & vbCrLf & "OHotfixLogLevel=v" Case "MsiLogLevel": szText = szText & vbCrLf & "MsiLogLevel=v" Case "OHotfixUILevel": szText = szText & vbCrLf & "OHotfixUILevel=q" Case "MsiUILevel": szText = szText & vbCrLf & "MsiUILevel=q" Case "RunSetupWatson": szText = szText & vbCrLf & "RunSetupWatson=0" Case Else: szText = szText & vbCrLf & szLine End Select Else szText = szText & vbCrLf & szLine End If Next 'open file to write results to text Set oFile = fso.CreateTextFile(szFile, True, 0) If Err.Number <> 0 Then Call CheckError() : Exit Function 'write results oFile.WriteLine szText oFile.Close If Err.Number <> 0 Then Call CheckError() : Exit Function ConfigureOhotfix = True End Function '---------------------------------------------------------------------------------------------- ' Functions and Subroutines '---------------------------------------------------------------------------------------------- Sub DebugLog(szText) If bDebug Then WriteLog szText End Sub Sub CheckError() If Err.Number <> 0 Then WriteLog Err.Description & " [" & Err.Number & "]" Err.Clear End If End Sub Function Format(szText) Dim Char, nLimit For Each Char In Array(vbTab, ",", ";", vbQuote, "{", "}", "(", ")") Do While InStr(1, szText, Char) <> 0 And nLimit < 100 nLimit = nLimit + 1 szText = Replace(szText, Char, "") Loop Next Format = Trim(szText) End Function Function RunProgram(szFile, szCommandLine) Dim nResult, nWindow DebugLog szFile & " " & szCommandLine If bDebug Then nWindow = 1 Else nWindow = 0 WriteLog "Command: " & szFile & " " & szCommandLine & " [" & nWindow & "]" On Error Resume Next nResult = wsh.Run(szFile & " " & szCommandLine, nWindow, True) If Err.Number <> 0 Then nResult = Err.Number On Error GoTo 0 WriteLog "Result: " & nResult RunProgram = nResult End Function Function CreateFolder(szFolderPath) Dim szSplit, i, szTempPath 'DebugLog "CreateFolder(" & szFolderPath & ")" If FolderExists(szFolderPath) Then Exit Function On Error Resume Next If InStr(1, szFolderPath, "\", vbTextCompare) = 0 Then If Not FolderExists(szFolderPath) Then fso.CreateFolder szFolderPath Else If Left(szFolderPath, 2) = "\\" Then szTempPath = Left(szFolderPath, 1) Else szTempPath = Left(szFolderPath, 2) szSplit = Split(szFolderPath, "\", -1, vbTextCompare) For i = 0 To UBound(szSplit) If Not IsEmptyNull(szSplit(i)) Then If Not szSplit(i) = szTempPath Then szTempPath = szTempPath & "\" & szSplit(i) If InStr(3, szTempPath, "\", vbTextCompare) <> 0 Then If Not FolderExists(szTempPath) Then If Not FileExists(szTempPath) Then DebugLog "Create Folder: " & szTempPath fso.CreateFolder szTempPath End If End If End If End If End If Next End If End Function Sub DeleteFile(szFile) On Error Resume Next If FileExists(szFile) Then fso.DeleteFile szFile, True End Sub Sub DeleteFolder(szFolder) On Error Resume Next If FolderExists(szFolder) Then fso.DeleteFolder szFolder, True End Sub 'Correction SUB below changed to function Function WmiDate() WmiDate = AddZero(Year(Now)) & AddZero(Month(Now)) & AddZero(Day(Now)) & _ AddZero(Hour(Now)) & AddZero(Minute(Now)) & AddZero(Second(Now)) & ".000000+***" End Function Function AddZero(szText) 'Correction: Len(szTest) changed to Len(szText) If Len(szText) = 1 Then AddZero = "0" & szText Else AddZero = szText End Function Function CopyFile(SourceFile, DestFile) Dim oSourceFile, oDestFile 'make sure the destination folder exists DebugLog "CopyFile(" & SourceFile & "," & DestFile & ")" CreateFolder Left(DestFile, InStrRev(DestFile, "\")) 'delete target folder if conflicts If FolderExists(DestFile) Then DeleteFolder DestFile On Error Resume Next 'Used by sync folder to determine file differences If FileExists(DestFile) Then Set oSourceFile = fso.GetFile(SourceFile) Set oDestFile = fso.GetFile(DestFile) 'do not copy file if it hasn't been modified If (oSourceFile.DateLastModified <> oDestFile.DateLastModified) Then fso.CopyFile SourceFile, DestFile, True: Call CheckError Else DebugLog "No change, skipping file copy" Exit Function End If Else 'copy the file fso.CopyFile SourceFile, DestFile, True: Call CheckError End If On Error GoTo 0 End Function Sub RestartSystem() Dim objOSSet, objOS WriteLog "Restarting system" On Error Resume Next Set objOSSet = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true") For Each objOS In objOSSet objOS.Reboot Exit For Next End Sub Sub WriteCSV(szLine) If bDebug Then Wscript.Echo szLine If IsObject(output) Then output.writeline szLine End If End Sub Sub WriteLog(szLine) If bDebug Then Wscript.Echo szLine If IsObject(outputtext) Then outputtext.writeline szLine End If End Sub '----------------------------------------------- ' GetSetting: Main Function '----------------------------------------------- ' Returns value to the right of Item= Function GetSetting(szFile, szKey) Dim oFile, szLine, szIndex, szTemp szTemp = "" szKey = Trim(szKey) DebugLog "GetSetting(" & szFile & "," & szKey & ")" If IsEmptyNull(szFile) Or IsEmptyNull(szKey) Then GetSetting = "": Exit Function If FileExists(szFile) Then On Error Resume Next: Err.Clear Set oFile = fso.OpenTextFile(szFile, 1, False): Call CheckError Do While oFile.AtEndofStream = False szLine = Trim(oFile.ReadLine) 'if item line, check If InStr(1, szLine, "=", vbTextCompare) <> 0 And Not Left(szLine, 1) = ";" Then If LCase(Left(szLine, Len(szKey))) = LCase(szKey) Then szIndex = Split(szLine, "=", 2, vbTextCompare) If UBound(szIndex) > 0 Then szTemp = Trim(szIndex(1)) Exit Do End If End If End If Loop 'close the file and object oFile.Close Set oFile = Nothing Else DebugLog "File not found: " & szFile End If If szTemp = "" Then DebugLog "No value found for " & szKey & " in file " & szFile Else DebugLog "GetSetting: " & szTemp End If GetSetting = Trim(szTemp) End Function Function GetID(szTitle) Dim szTemp, szValue szTemp = Right(szTitle, 6) If IsNumeric(szTemp) Then GetID = szTemp Else szTemp = Mid(szTitle, InStr(1, szTitle, " KB") + 3, 6) If IsNumeric(szTemp) Then GetID = szTemp Else For Each szValue In Array(" KB", " Q") szTemp = Mid(szTitle, InStr(1, szTitle, szValue) + Len(szValue), 6) If IsNumeric(szTemp) Then GetID = szTemp Exit For Else GetID = szTitle End If Next End If End If End Function Function FolderExists(Folder) On Error Resume Next FolderExists = False If fso.FolderExists(Folder) Then FolderExists = True End Function Function FileExists(File) On Error Resume Next FileExists = False If fso.FileExists(File) Then FileExists = True End Function Sub CheckQuit() If Err.Number <> 0 Then Wscript.Quit Err.Number End Sub Sub AddItem(ByRef Dictionary, ByVal Key, ByVal KeyValue) If Dictionary.Exists(Key) Then Dictionary.Remove (Key) Dictionary.Add Key, KeyValue End Sub Function RegRead(szRegkey) On Error Resume Next RegRead = "" If IsEmptyNull(szRegkey) Then Exit Function Err.Clear Dim szTemp: szTemp = wsh.RegRead(szRegkey) If Err.Number = &H80070002 Then DebugLog "Unable to read registry key '" & szRegkey & "', key does not exist" Err.Clear Else If Err.Number <> 0 Then DebugLog "Error reading key " & szRegkey & " " & GetLastError() Else RegRead = szTemp End If End If End Function Function RegWrite(szRegkey, szValue, szKeyType) RegWrite = False If IsEmptyNull(szRegkey) Then Exit Function WriteLog "RegWrite(" & szRegkey & "," & szValue & "," & szKeyType & ")" On Error Resume Next: Err.Clear If IsEmptyNull(szKeyType) Then szKeyType = "REG_SZ" wsh.RegWrite szRegkey, szValue, szKeyType If Err.Number <> 0 Then WriteLog "Error writing value '" & szValue & "' to key '" & szRegkey & "' of type '" & szKeyType & "' " & GetLastError() RegWrite = False Else RegWrite = True End If End Function Function GetLastError() Dim szErrorSource, szErrorDesc, szErrorNumber If Err.Number = 0 Then GetLastError = "None" Else 'load error values szErrorSource = Err.Source szErrorDesc = Err.Description szErrorDesc = Replace(szErrorDesc, vbCrLf, " ", 1, -1, vbTextCompare) If IsNumeric(Err.Number) Then szErrorNumber = Hex(Err.Number) Else szErrorNumber = Err.Number End If 'ensure values set If IsEmptyNull(szErrorSource) Then szErrorSource = "Unknown" If IsEmptyNull(szErrorDesc) Then szErrorDesc = "No description available" If IsEmptyNull(szErrorNumber) Then szErrorNumber = "Unknown" GetLastError = szErrorSource & ": " & szErrorDesc & " [" & szErrorNumber & "]" WriteLog Err.Source & ": " & Err.Description & " [" & Hex(Err.Number) & "] (" & Err.Number & ")" End If Err.Clear End Function '----------------------------------------------- ' Function: IsEmptyNull ' Purpose: Evaluates If string is Empty or Null '----------------------------------------------- Function IsEmptyNull(ByVal szCheck) Dim szMember IsEmptyNull = False If IsObject(szCheck) Then Exit Function If IsArray(szCheck) Then Exit Function If VarType(szCheck) = vbEmpty Then IsEmptyNull = True: Exit Function If VarType(szCheck) = vbNull Then IsEmptyNull = True: Exit Function If szCheck = "" Then IsEmptyNull = True End Function Sub CheckLastTimeRun() On Error Resume Next dim lastrun, diff lastrun = RegRead(REG_SCAN) If Not lastrun = "" Then diff = datediff("d", lastrun, now()) If IsNumber(diff) Then WriteLog "Last run: " & lastrun If CInt(diff) < Cint(ScanInterval) Then WriteLog "Script has already run in last " & ScanInterval & " day(s)" Wscript.Quit -256 End If End If End If End Sub