Boston2012
Technical User
If anyone can help, I need assitance modifying the below script to install one patch on the Controllers, the registers do not need patch. Please let me know if anyone can help. Thanks in advance!
Rookie---
Option Explicit
On Error Resume Next
' Establish global variables.
Dim g_intMain
Dim g_objFS, g_objShell, g_objCSV, g_objRegister
Dim g_strLogFolder, g_strLogFile, g_strServerName, g_strCurrentPath, g_strHosts, g_strFiletoexecute, g_strFiletoread
Dim g_strCSVTemp, g_strWinDir, g_strCSV, g_strUtils, g_strServerIPAddress, g_strEnvType, g_strPatch
Dim strNextline, strLine, strDest, objKBReg
Dim strFileCont, strFileReg, strNextL, objKBC, objKBR
Dim g_strBPS
' Constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const MinWindow = 7
Const SuccessCode = 555
Const PendingCode = 777
' Set global variables.
Set g_objFS = CreateObject("Scripting.FileSystemObject")
Set g_objShell = CreateObject("WScript.Shell")
Set g_objRegister = CreateObject("Scripting.Dictionary")
g_strServerName = g_objShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
g_strServerIPAddress = GetIPAddress(g_strServerName)
g_strCurrentPath = g_objFS.GetAbsolutePathName(".")
g_strHosts = GetOutput("type %systemroot%\system32\drivers\etc\hosts")
g_strUtils = "C:\Utils"
g_strPatch = "C:\MSPatch"
' Acquire local hosts file output for device name resolution.
g_strHosts = GetOutput("type %systemroot%\system32\drivers\etc\hosts")
' Determine Windows OS home folder.
g_strWinDir = ""
If g_objFS.FileExists("D:\XPS\xpsctrl.exe") Then
g_strWinDir = "WinNT"
ElseIf g_objFS.FileExists("C:\gstr\iSTORE\bin\DownloadProc.exe") Then
g_strWinDir = "Windows"
End If
' Check the RemoteWare Client service for administrative rights before proceeding.
If WScript.Arguments.Named.Exists("RemoteWareService") Then
Dim strRWFlag, strDoneFlag
strRWFlag = "C:\RemoteWareService.Flag"
strDoneFlag = "C:\Done.Flag"
If g_objFS.FileExists(strDoneFlag) Then
Call g_objFS.DeleteFile(strDoneFlag, True)
End If
If g_objFS.FileExists(strRWFlag) Then
Call g_objFS.DeleteFile(strRWFlag, True)
End If
If RemoteWareService() = 0 Then
Call g_objFS.CreateTextFile(strRWFlag, True)
End If
Call g_objFS.CreateTextFile(strDoneFlag, True)
WScript.Quit
End If
' Establish location for log file.
g_strLogFolder = "C:\MSPatch\"
If Not g_objFS.FolderExists(g_strLogFolder) Then
g_objFS.CreateFolder(g_strLogFolder)
End If
If Not WScript.Arguments.Named.Exists("Target") Then
g_strLogFile = g_strLogFolder & Chr(92) & g_strServerName & "_Install.log"
If g_objFS.FileExists(g_strLogFile) Then
Call g_objFS.DeleteFile(g_strLogFile, True)
End If
Else
g_strLogFile = g_strLogFolder & Chr(92) & g_strServerName & "_Install.log" & "_Target.log"
End If
' Output file to organize results.
g_strCSV = g_strLogFolder & Chr(92) & g_strServerName & "_Registers.csv"
g_strCSVTemp = g_strCSV & ".temp"
If g_objFS.FileExists(g_strCSVTemp) Then
g_objFS.DeleteFile(g_strCSVTemp)
End If
If g_objFS.FileExists(g_strCSV) Then
g_objFS.DeleteFile(g_strCSV)
End If
g_strFiletoexecute = "cmdLinesReg.txt"
g_strFiletoread = "PatchesReg.txt"
strFileCont = "C:\MSPatch\PatchesCont.txt"
strFileReg = "C:\MSPatch\PatchesReg.txt"
' Run main script.
g_intMain = Main()
' Prepare CSV file with results.
Call g_objFS.CopyFile(g_strCSVTemp, g_strCSV, True)
Call g_objFS.DeleteFile(g_strCSVTemp, True)
If WScript.Arguments.Named.Exists("Target") Then
Call g_objFS.DeleteFile(g_strCSV, True)
End If
' Exit and return result code to any calling application.
WScript.Quit(g_intMain)
' Function: The primary instructions of the script.
Function Main
' Declare function variables.
Dim intGenerateRegisters, intIndex, intResult, intDone, intTimer, intTimeOut, intSuccess
Dim strRegister, strRegisterIP, strRegisterAlias, strCommand
Dim strNow, strThen, strTool
Dim arrExec, arrResult, arrTool, arrEnvType
Dim objExec
Dim blnDone, blnEnvType, blnController
Dim objSFTP, objSSH, objData, objInstall, objResult
' Log header.
Call WriteToLog("Start of Installing Patches on Controller and Registers.")
Call WriteToLog("Target system is" & Chr(32) & Chr(34) & g_strServerName & Chr(34) & ", IP address:" & Chr(32) & g_strServerIPAddress)
If g_objFS.FileExists("C:\Temp\Patches.Flag")Then
Call g_objFS.DeleteFile("C:\Temp\Patches.Flag", True)
End If
If g_objFS.FileExists("C:\Temp\PatchCheck.Flag")Then
Call g_objFS.DeleteFile("C:\Temp\PatchCheck.Flag", True)
End If
'Controller KB File Test
Dim blnPatches
blnPatches = True
Set objKBC = g_objFS.OpenTextFile(strFileCont, ForReading)
Do Until objKBC.AtEndOfStream
strNextL = objKBC.Readline
If (g_objFS.FileExists("C:\MSPatch\Controller\" & strNextL)) Then
Call WriteToLog("Required file C:\MSPatch\Controller\" & strNextL & " exists.")
Else
blnPatches = False
Call WriteToLog("Required file C:\MSPatch\Controller\" & strNextL & " doesn't exist.")
End If
Loop
'Register KB File Test
Set objKBR = g_objFS.OpenTextFile (strFileReg, ForReading)
Do Until objKBR.AtEndOfStream
strNextL = objKBR.Readline
If (g_objFS.FileExists("C:\MSPatch\Register\" & strNextL)) Then
Call WriteToLog("Required file C:\MSPatch\Register\" & strNextL & " exists.")
Else
blnPatches = False
Call WriteToLog("Required file C:\MSPatch\Register\" & strNextL & " doesn't exist.")
End If
Loop
If blnPatches = True Then
Call g_objFS.CreateTextFile("C:\Temp\PatchCheck.Flag", True)
Call g_objFS.CreateTextFile("C:\Temp\Patches.Flag", True)
Else
Call g_objFS.CreateTextFile("C:\Temp\PatchCheck.Flag", True)
Exit Function
End If
' Create support tools folder.
If Not g_objFS.FolderExists(g_strUtils) Then
Call g_objFS.CreateFolder(g_strUtils)
End If
' Prepare support tools for batch mode.
arrTool = Array("psexec.reg", "pskill.reg")
For Each strTool In arrTool
If g_objFS.FileExists(g_strUtils & Chr(92) & strTool) Then
strCommand = "%ComSpec% /c regedit /s" & Chr(32) & g_strUtils & Chr(92) & strTool
intResult = g_objShell.Run(strCommand, MinWindow, True)
End If
Next
' Populate CSV file with Controller information.
blnController = True
Set g_objCSV = g_objFS.CreateTextFile(g_strCSVTemp, True)
g_objCSV.WriteLine(Chr(34) & g_strServerName & Chr(34) & Chr(44) &_
Chr(34) & g_strServerName & Chr(34) & Chr(44) &_
Chr(34) & g_strServerIPAddress & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34))
g_objCSV.Close
Set g_objCSV = Nothing
' Scan for all Registers.
If Not WScript.Arguments.Named.Exists("Target") Then
' Populate dictionary with all detected Registers.
Call WriteToLog("Detecting available Registers on the local network.")
intGenerateRegisters = GenerateRegisterTable()
' Populate CSV file with Register information.
If intGenerateRegisters = 0 Then
Call WriteToLog("Register detection complete," & Chr(32) & g_objRegister.Count & Chr(32) & "Register(s) detected.")
Set g_objCSV = g_objFS.OpenTextFile(g_strCSVTemp, ForAppending, False)
For Each strRegister In g_objRegister
g_objCSV.WriteLine(Chr(34) & g_strServerName & Chr(34) & Chr(44) &_
Chr(34) & strRegister & Chr(34) & Chr(44) &_
Chr(34) & g_objRegister.Item(strRegister) & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34))
Next
g_objCSV.Close
Set g_objCSV = Nothing
Else
Call WriteToLog("A problem occured during the detection process: No Registers detected.")
Call WriteToLog("Exiting installation script.")
Main = 10
Exit Function
End If
' Confirm RemoteWare service is configured properly before doing anything.
intResult = RemoteWareService()
If intResult <> 0 Then
Call WriteToLog("Error:" & Chr(32) & Chr(34) & "RemoteWare Client" & Chr(34) & Chr(32) &_
"service is not running as an administrator account.")
Call WriteToLog("Please adjust the service properties before retrying.")
Call WriteToLog("Exiting installation script.")
Main = 5
Exit Function
End If
Else ' Determine if specific Registers are targetted for the installation.
blnController = False
Dim strDeviceList, arrDevices, strDeviceName, strDeviceIP, dicTarget, strDeviceNB
Set dicTarget = CreateObject("Scripting.Dictionary")
Call WriteToLog("Register Target switch specified, applying software to select Registers.")
strDeviceList = WScript.Arguments.Named("Target")
Call WriteToLog("Arguments:" & Chr(32) & strDeviceList)
strDeviceList = Replace(strDeviceList, Chr(32), "")
arrDevices = Split(strDeviceList, ",")
For Each strDeviceName In arrDevices
strDeviceIP = ConvertToIP(strDeviceName)
strDeviceNB = ResolveIPToHostName(strDeviceIP)
If UCase(strDeviceNB) <> UCase(g_strServerName) And strDeviceName <> "127.0.0.1" And g_strServerIPAddress <> strDeviceIP Then
If strDeviceIP <> "Unknown" Then
If IsDuplicate(strDeviceIP, dicTarget) = 0 Then
Call WriteToLog("Adding device to valid target list:" & Chr(32) & strDeviceNB & Chr(32) & "(" & strDeviceIP & ").")
Call dicTarget.Add(strDeviceNB, strDeviceIP)
Else
Call WriteToLog("Warning:" & Chr(32) & strDeviceName & Chr(32) & "already in target list, skipping duplicate value.")
End If
Else
Call WriteToLog("Device" & Chr(32) & strDeviceName & Chr(32) &_
"not recognized on network, omitting from target list.")
End If
End If
Next
If dicTarget.Count > 0 Then
Set g_objRegister = dicTarget
Else
Call WriteToLog("No valid devices exist as targets, exiting script.")
Main = 7
Exit Function
End If
Set dicTarget = Nothing
End If
' Create Register hosts file for SFTP and SSH aliasing.
' Issue SFTP connectivity test to all Registers.
Call WriteToLog("Performing SFTP connectivity test to all detected Registers.")
Call WriteToLog("Killing any existing SFTP processes before proceeding.")
intResult = KillProcess("sftpg3.exe")
Call WriteToLog("Waiting for Registers to finish SFTP test.")
Set objSFTP = TestSFTP(g_objRegister)
intResult = KillProcess("sftpg3.exe")
Call WriteToLog("SFTP tests complete, proceeding.")
' Issue SSH connectivity test to all Registers.
Call WriteToLog("Performing SSH connectivity test to all detected Registers.")
Call WriteToLog("Killing any existing SSH processes before proceeding.")
intResult = KillProcess("sshg3.exe")
Call WriteToLog("Waiting for Registers to finish SSH test.")
Set objSSH = TestSSH(g_objRegister)
intResult = KillProcess("sshg3.exe")
Call WriteToLog("SSH tests complete, proceeding.")
' Report the SFTP/SSH test results.
Call WriteToLog("Register SFTP/SSH test results:")
For Each strRegister in objSFTP
Call WriteToLog("SFTP test for Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objSFTP.Item(strRegister) & ".")
Call WriteToLog("SSH test for Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objSSH.Item(strRegister) & ".")
Next
' Deliver the data.
Call WriteToLog("Delivering files to the Registers.")
Set objData = DeliverFiles(g_objRegister, objSFTP)
Call WriteToLog("Register file delivery results:")
intSuccess = 0
For Each strRegister in objData
Call WriteToLog("File delivery for Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objData.Item(strRegister) & ".")
If objData.Item(strRegister) = "True" Then
Call UpdateCSV(g_objRegister.Item(strRegister), "True", "False")
intSuccess = intSuccess + 1
End If
Next
' Install the software on Registers.
Call WriteToLog("Performing software installation on all Registers.")
Set objInstall = InstallSoftware(g_objRegister, objSSH, objData)
Call WriteToLog("Software installation Register results:")
intSuccess = 0
For Each strRegister in objInstall
Call WriteToLog("Software installation on Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objInstall.Item(strRegister) & ".")
If objInstall.Item(strRegister) = "True" Then
Call UpdateCSV(g_objRegister.Item(strRegister), "True", "True")
intSuccess = intSuccess + 1
End If
Next
Call WriteToLog(intSuccess & Chr(32) & "of" & Chr(32) & g_objRegister.Count & Chr(32) & "Registers successfully installed the software.")
intResult = intSuccess / g_objRegister.Count
Call WriteToLog(FormatPercent(intResult, 2) & Chr(32) & "of the Registers are complete.")
' Install the software on Controller.
If blnController Then
Call WriteToLog("Performing software installation on Controller" & Chr(32) & g_strServerName & ".")
strDest = "C:\Temp"
Call g_objFS.CopyFile(g_strPatch & "\cmdlinescont.txt", strDest & Chr(92) & "cmdlinescont.bat", True)
strCommand = "%ComSpec% /v
n /c (start /wait /min" & Chr(32) & strDest & "\cmdlinescont.bat) & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set objResult = g_objShell.Exec(strCommand)
strThen = Now
intTimeOut = 10 'Time-out threshold in minutes.
Do
WScript.Sleep(10000)
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
Loop Until objResult.Status = 1 Or intTimer > intTimeOut
' Process results of software installation on Controller.
If objResult.ExitCode = SuccessCode Then
Call WriteToLog("Software installation on Controller" & Chr(32) & g_strServerName & Chr(32) &_
"(" & g_strServerIPAddress & ") evaluated as True.")
Call UpdateCSV(g_strServerIPAddress, "True", "True")
intSuccess = intSuccess + 1
Else
If intTimer > intTimeOut Then
Call WriteToLog("Warning: Software installation on Controller" & Chr(32) & g_strServerName & Chr(32) &_
"(" & g_strServerIPAddress & ") exceeded the" & Chr(32) & intTimeOut & Chr(32) & "minute time-out threshold.")
End If
Call WriteToLog("Software installation on Controller" & Chr(32) & g_strServerName & Chr(32) &_
"(" & g_strServerIPAddress & ") evaluated as False.")
Call UpdateCSV(g_strServerIPAddress, "True", "False")
End If
Else
Call WriteToLog("Skipping Controller software installation.")
End If
' Report summary of the results.
If blnController Then
intResult = FormatPercent(intSuccess / (g_objRegister.Count + 1), 2)
Call WriteToLog("Summary:" & Chr(32) & intSuccess & Chr(32) & "of" & Chr(32) & (g_objRegister.Count + 1) & Chr(32) &_
"POS devices successful =" & Chr(32) & intResult)
End If
Call WriteToLog("End of Patch Installation.")
' Primary instructions finished.
Main = 0
End Function
' Function: Create an array of Registers based on the current ARP table. Return code 0 indicates at least one Register detected.
Function GenerateRegisterTable()
On Error Resume Next
GenerateRegisterTable = 999
Dim objARPStatus, arrOutput, strOutput, intCount, strDivision, intDynamic, intGRT
intCount = 0
Set objARPStatus = g_objShell.Exec("%ComSpec% /c arp -a")
Do
WScript.Sleep(500)
Loop Until objARPStatus.Status = 1
Do
strOutput = CStr(LTrim(objARPStatus.StdOut.ReadLine))
' English or French may appear in output, must consider both.
intDynamic = InStr(strOutput, "dynamic") + InStr(strOutput, "dynamique")
If intDynamic > 0 Then
Dim arrCurrentIP, strCurrentIP, strCurrentHostName, intRegNum
arrOutput = Split(strOutput, " ")
arrCurrentIP = Split(arrOutput(0),".")
strCurrentIP = arrOutput(0)
strCurrentHostName = ResolveIPToHostName(strCurrentIP)
intRegNum = RegExGetBRef(strCurrentHostName, "^([a-z]{3,4})\d{3,4}(\d{2})$", 2, True)
If UCase(Left(g_strServerName, 7)) = UCase(Left(strCurrentHostName, 7)) Then
If strCurrentHostName <> "Unknown" And PingStatus(strCurrentIP) = 0 And intRegNum <> "" And intRegNum <> "00" Then
If Right(strCurrentHostName, 2) <> "99" Then
Call g_objRegister.Add(strCurrentHostName, strCurrentIP)
intCount = intCount + 1
ElseIf Right(strCurrentHostName, 2) = "99" Then
g_strBPS = strCurrentIP
Call g_objRegister.Add(strCurrentHostName, strCurrentIP)
End If
End If
End If
End If
Loop Until objARPStatus.StdOut.AtEndOfStream
Set objARPStatus = Nothing
' Confirm at least one Register detected.
If intCount > 0 Then
intGRT = 0
' Otherwise flag a problem.
Else
intGRT = 1
End If
GenerateRegisterTable = intGRT
On Error GoTo 0
End Function
' Function: Resolve IP address to the NetBIOS hostname. Return value is the NetBIOS hostname.
Function ResolveIPToHostName(strIPAddressToResolve)
On Error Resume Next
strResolveIPToHostName = "Unknown"
Dim objNBStatus, strOutput, strPattern, intHostName, intRegNum, strResolveIPToHostName
strPattern = "<00> UNIQUE"
Set objNBStatus = g_objShell.Exec("nbtstat -A" & Chr(32) & strIPAddressToResolve)
Do
WScript.Sleep(500)
Loop Until objNBStatus.Status = 1
Do
strOutput = objNBStatus.StdOut.ReadLine
intHostName = InStr(strOutput, strPattern)
If intHostName > 0 Then
Dim arrCurrentLine
arrCurrentLine = Split(LTrim(strOutput), " ")
If Instr(arrCurrentLine, "IS~") = 0 And Instr(arrCurrentLine, "..") = 0 Then
strResolveIPToHostName = Replace(Replace(Replace(arrCurrentLine(0),"IS~",""),".",""),"<00>","")
End If
End If
Loop Until objNBStatus.StdOut.AtEndOfStream
Set objNBStatus = Nothing
ResolveIPToHostName = strResolveIPToHostName
On Error GoTo 0
End Function
Function RegExGetBRef(strString, strPattern, intBRef, blnIgnoreCase)
'
' Provide a single-line interface to use RegExp to parse a string and return a single
' backreference. intBRef is a Base-1 index (1 for the first capture, 2 for second, etc).
' If the pattern is not matched at all, or if an invalid value is passed for intBRef,
' the function will return an empty string.
'
' The RegExp search is always performed with Global mode set to false. This is for simple
' captures only.
'
' Ex: RegExGetBRef("Hello, There!", "(.*),\s*([^,]+)$", 1, True) returns "Hello", and
' RegExGetBRef("Hello, There!", "(.*),\s*([^,]+)$", 2, True) returns "There!"
RegExGetBRef = ""
Dim objRegExp
Dim colMatches, objMatch
Set objRegExp = New RegExp
objRegExp.Pattern = strPattern
objRegExp.IgnoreCase = blnIgnoreCase
objRegExp.Global = False
objRegExp.MultiLine = True
Set colMatches = objRegExp.Execute(strString)
For Each objMatch In colMatches
If ((intBRef > 0) And (intBRef <= objMatch.SubMatches.Count)) Then
RegExGetBRef = objMatch.SubMatches(intBRef - 1)
End If
Next
End Function
' Function: Confirm device is communicating by pinging it. Return code 0 means device is alive.
Function PingStatus(strDeviceToPing)
PingStatus = 9999
Dim objPingStatus
Dim strLine, intCount
Set objPingStatus = g_objShell.Exec("%ComSpec% /c ping" & Chr(32) & strDeviceToPing)
intCount = 0
Do
WScript.Sleep(500)
Loop Until objPingStatus.Status = 1
Do
strLine = objPingStatus.StdOut.ReadLine
' English or French may appear in output, must consider both.
If InStr(strLine, "Reply from") > 0 Or InStr(strLine, "ponse de") > 0 Then
intCount = intCount + 1
End If
Loop Until objPingStatus.StdOut.AtEndOfStream
' Two or more responses flag a successful ping.
If intCount >= 2 Then
PingStatus = 0
End If
Set objPingStatus = Nothing
End Function
' Function: Return output from a command.
Function GetOutput(strCommand)
On Error Resume Next
Dim objFSO, WshShell, objTempFile, strTempFile, strOutput
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
strTempFile = objFSO.GetTempName
WshShell.Run "%comspec% /c """ & strCommand & " > " & strTempFile & """", 7, True
If (Not objFSO.FileExists(strTempFile)) Then
GetOutput = ""
Else
strOutput = ""
Set objTempFile = objFSO.OpenTextFile(strTempFile, 1)
If (Not Err.Number) Then
Do While (Not objTempFile.AtEndOfStream)
strOutput = strOutput & objTempFile.ReadAll
Loop
objTempFile.Close
End If
GetOutput = strOutput
End If
objFSO.DeleteFile strTempFile, True
Set objFSO = Nothing
Set WshShell = Nothing
End Function
' Function: Return Register alias from local hosts file based on IP address lookup.
Function GetRegisterAlias(strIP)
' Search g_strHosts for a line which beings with strIP, and return the first alias defined on that line
' If no line found, return the empty string.
GetRegisterAlias = ""
Dim strLineIP
Dim strLine
For Each strLine In Split(g_strHosts, vbCrLf)
strLineIP = RegExGetBRef(strLine, "^\s*(\S+)\s*(\S+)", 1, True)
If (strLineIP = strIP) Then
GetRegisterAlias = RegExGetBRef(strLine, "(reg\d{2})(?:$|\s)", 1, True)
Exit For
End If
Next
End Function
' Function: Review status of all running jobs. Return code 0 indicates all jobs have finished.
Function ExecDone(arrResult)
On Error Resume Next
ExecDone = 999
Dim intResult, intTotal, intSum
intSum = 0
intTotal = UBound(arrResult) + 1
' The pending status previously populated should change to the actual return code or a forced error code.
For Each intResult In arrResult
If intResult <> PendingCode Then
intSum = intSum + 1
End If
Next
If intSum = intTotal Then
ExecDone = 0
Else
ExecDone = 1
End If
On Error GoTo 0
End Function
' Function: Return exact date and time to append to log file name. Return the date suffix.
Function DateSuffix
Dim strHour, strMinute, strSecond, strNow, strMonth, strDay, strYear
strNow = Now()
strHour = TwoDigit(DatePart("h", strNow))
strMinute = TwoDigit(DatePart("n", strNow))
strSecond = TwoDigit(DatePart("s", strNow))
strMonth = TwoDigit(DatePart("m", strNow))
strDay = TwoDigit(DatePart("d", strNow))
strYear = DatePart("yyyy", strNow)
'DateSuffix = strMonth & strDay & strYear & "-" & strHour & strMinute & strSecond
DateSuffix = strMonth & strDay & strYear
End Function
' Function: Ensure single-character numbers appear in two-digit format. Return the two-digit number.
Function TwoDigit(intNumber)
TwoDigit = CStr(intNumber)
If intNumber >= 0 And intNumber < 10 Then
TwoDigit = "0" & TwoDigit
End If
End Function
' Subroutine: Write information to the log file.
Sub WriteToLog(strTextIn)
Dim objLogFile
Set objLogFile = g_objFS.OpenTextFile(g_strLogFile, ForAppending, True)
objLogFile.WriteLine(CurrentTimeStamp & strTextIn & vbCrLf)
objLogFile.Close
Set objLogFile = Nothing
If TypeName(strTextIn) = "String" Then
WScript.Echo VbCrLf & strTextIn & VbCrLf
End If
End Sub
' Function: Return current date and time in a fixed format.
Function CurrentTimeStamp
Dim strMonth, strDay, strYear, strNow, strHour, strMinute, strSecond
CurrentTimeStamp = "Unknown"
strNow = Now()
strMonth = TwoDigit(DatePart("m", strNow))
strDay = TwoDigit(DatePart("d", strNow))
strYear = DatePart("yyyy", strNow)
strHour = TwoDigit(DatePart("h", strNow))
strMinute = TwoDigit(DatePart("n", strNow))
strSecond = TwoDigit(DatePart("s", strNow))
CurrentTimeStamp = strMonth & Chr(47) & strDay & Chr(47) & strYear & Chr(32) &_
strHour & Chr(58) & strMinute & Chr(58) & strSecond & Chr(32) &_
"--" & Chr(32)
End Function
' Function: Query "RemoteWare Client" service for proper service log on configuration. Return code 0 indicates expected configuration.
Function RemoteWareService()
On Error Resume Next
Dim objWMIService, colListOfServices, objService, strServiceName, intRemoteWareService
RemoteWareService = 999
intRemoteWareService = 999
strServiceName = "RemoteWare Client"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name ='" & strServiceName & "'")
intRemoteWareService = 1
For Each objService In colListOfServices
If Instr(LCase(objService.StartName), LCase("Cambridge")) > 0 Or Instr(LCase(objService.StartName), LCase("eService")) > 0 Then
intRemoteWareService = 0
End If
Next
RemoteWareService = intRemoteWareService
On Error GoTo 0
End Function
' Function: Acquire active IP address of local device. Return value is the IP address discovered.
Function GetIPAddress(strComputerName)
On Error Resume Next
GetIPAddress = "Unable to determine IP."
Dim strOutput, strLine, arrOutput, arrLine, strValue, strIPAddress
strOutput = GetOutput("arp -a")
arrOutput = Split(strOutput, vbCrLf)
strIPAddress = ""
For Each strLine In arrOutput
If Instr(LCase(strLine), LCase("Interface")) > 0 Then
arrLine = Split(strLine, Chr(32))
For Each strValue In arrLine
If IsNumeric(Left(strValue,1)) And Not Instr(strValue, "x") > 0 Then
strIPAddress = strValue
Exit For
End If
Next
End If
Next
GetIPAddress = strIPAddress
On Error GoTo 0
End Function
' Function: Confirm the SFTP connection to a device. Return a dictionary object with the results.
Function TestSFTP(arrDevice)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias
Dim arrExec, arrResult
Set dicResult = CreateObject("Scripting.Dictionary")
Set TestSFTP = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
' Initiate the SFTP test connection.
intIndex = 0
For Each strDevice In arrDevice
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strBatchFile = g_strCurrentPath & Chr(92) & g_objFS.GetTempName()
Err.Clear
Set objBatchFile = g_objFS.CreateTextFile(strBatchFile, True)
If Err.Number = 0 Then
objBatchFile.WriteLine("open Cambridge@" & strAlias)
objBatchFile.WriteLine("bye")
objBatchFile.Close
strExec = "%ComSpec% /vn /c (start /wait /min sftpg3.exe -B" & Chr(32) & Chr(34) & strBatchFile & Chr(34) &_
") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
arrResult(intIndex) = 999
End If
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish SFTP test or time-out.
intDone = 1
intTimeOut = 5 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If arrResult(intIndex) <> 999 Then
If objExec.Status = 1 Then
arrResult(intIndex) = objExec.ExitCode
End If
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with SFTP test results.
intIndex = 0
For Each strDevice In arrDevice
If arrResult(intIndex) = 0 Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set TestSFTP = dicResult
' Temporary file clean-up.
Call g_objFS.DeleteFile(g_strCurrentPath & Chr(92) & "*.tmp")
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Confirm the SSH connection to a device. Return a dictionary object with the results.
Function TestSSH(arrDevice)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias
Dim arrExec, arrResult
Set dicResult = CreateObject("Scripting.Dictionary")
Set TestSSH = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
' Initiate the SSH test connection.
intIndex = 0
For Each strDevice In arrDevice
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strExec = "cmd /vn /c (start /wait /min sshg3.exe -B cambridge@" & strAlias & Chr(32) &_
"ipconfig) & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish SSH test or time-out.
intDone = 1
intTimeOut = 5 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If objExec.Status = 1 Then
arrResult(intIndex) = objExec.ExitCode
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with SSH test results.
intIndex = 0
For Each strDevice In arrDevice
If arrResult(intIndex) = 0 Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set TestSSH = dicResult
' Temporary file clean-up.
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Deliver data over SFTP or UNC. Return a dictionary object containing the results (T or F).
Function DeliverFiles(arrDevice, objSFTP)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult, intTestWMI
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias, strSFTP
Dim arrExec, arrResult, arrRetry, strBatch
Set dicResult = CreateObject("Scripting.Dictionary")
Set DeliverFiles = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
ReDim arrRetry(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
arrRetry(intIndex) = "False"
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
'wscript.echo "starting"
' Deliver the data.
intIndex = 0
For Each strDevice In arrDevice
' SFTP delivery.
If objSFTP.Item(strDevice) = "True" Then
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strBatchFile = g_strCurrentPath & Chr(92) & g_objFS.GetTempName()
Err.Clear
Set objBatchFile = g_objFS.CreateTextFile(strBatchFile, True)
If Err.Number = 0 Then
objBatchFile.WriteLine("open Cambridge@" & strAlias)
objBatchFile.WriteLine("cd /C:/temp")
objBatchFile.WriteLine("lcd C:/MSPatch")
objBatchFile.WriteLine("sput" & Chr(32) & g_strFiletoexecute & Chr(32) & "cmdlinesreg.bat")
objBatchFile.WriteLine("lcd C:/MSPatch/Register")
Set objKBReg = g_objFS.OpenTextFile(g_strfiletoread, ForReading)
Do
strNextline = objKBReg.Readline
objBatchFile.WriteLine("put" & Chr(32) & strNextLine)
Loop Until objKBReg.AtEndOfStream
objKBReg.Close
Set objKBReg = Nothing
objBatchFile.WriteLine("bye")
objBatchFile.Close
strExec = "%ComSpec% /vn /c (start /wait /min sftpg3.exe -B" & Chr(32) & Chr(34) & strBatchFile & Chr(34) &_
") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
arrResult(intIndex) = 999
End If
' UNC delivery (xcopy).
Else
intTestWMI = TestWMI(arrDevice.Item(strDevice))
If intTestWMI = 0 Then
strBatch = ""
Set objKBReg = g_objFS.OpenTextFile(g_strfiletoread, ForReading)
Do
strNextline = objKBReg.Readline
Err.Clear
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\Register\" & strNextLine & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp) & " & strBatch
Loop Until objKBReg.AtEndOfStream
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\" & g_strFiletoexecute & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp\cmdlinesreg.bat) & " & strBatch
objKBReg.Close
Set objKBReg = Nothing
strExec = "%ComSpec% /v: on /c" & Chr(32) & strBatch & "exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
Set arrResult(intIndex) = 1234
End If
End If
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish delivering data / retry / time-out.
intDone = 1
intTimeOut = 10 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If arrResult(intIndex) = PendingCode Then
If objExec.Status = 1 Then
arrResult(intIndex) = objExec.ExitCode
If arrResult(intIndex) <> 0 And SFTPLookup(objSFTP, intIndex) = "True" And arrRetry(intIndex) = "False" Then
arrResult(intIndex) = PendingCode
arrRetry(intIndex) = "True"
End If
End If
End If
' If SFTP fails, retry with the UNC (xcopy) method.
If objExec.Status = 1 And arrResult(intIndex) = PendingCode And SFTPLookup(objSFTP, intIndex) = "True" Then
strBatch = ""
Set objKBReg = g_objFS.OpenTextFile(g_strfiletoread, ForReading)
Do
strNextline = objKBReg.Readline
Err.Clear
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\Register\" & strNextLine & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp) & " & strBatch
Loop Until objKBReg.AtEndOfStream
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\" & g_strFiletoexecute & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp\cmdlinesreg.bat) & " & strBatch
objKBReg.Close
Set objKBReg = Nothing
strExec = "%ComSpec% /v: on /c" & Chr(32) & strBatch & "exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with data delivery results.
intIndex = 0
For Each strDevice In arrDevice
If arrResult(intIndex) = 0 Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set DeliverFiles = dicResult
' Temporary file clean-up.
Call g_objFS.DeleteFile(g_strCurrentPath & Chr(92) & "*.tmp", True)
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Install software over SSH or Psexec. Return a dictionary object with the results (T or F).
Function InstallSoftware(arrDevice, objSSH, objData)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias, strSFTP
Dim arrExec, arrResult, arrRetry
Set dicResult = CreateObject("Scripting.Dictionary")
Set InstallSoftware = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
ReDim arrRetry(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
arrRetry(intIndex) = "False"
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
strBatchFile = "C:\Temp\cmdlinesreg.bat"
' Install the software.
intIndex = 0
For Each strDevice In arrDevice
If objSSH.Item(strDevice) = "True" And objData.Item(strDevice) = "True" Then
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strExec = "cmd /vn /c (start /wait /min sshg3.exe -B cambridge@" & strAlias & Chr(32) &_
strBatchFile & ") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
ElseIf objData.Item(strDevice) = "True" Then
strExec = "cmd /vn /c (start /wait /min C:\Utils\psexec.exe" & Chr(32) & "\\" & arrDevice.Item(strDevice) &_
Chr(32) & strBatchFile & ") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
arrResult(intIndex) = 888
End If
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish software installation or time-out.
intDone = 1
intTimeOut = 15 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If objExec.Status = 1 And arrResult(intIndex) <> 888 Then
arrResult(intIndex) = objExec.ExitCode
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with software installation results.
intIndex = 0
For Each strDevice In arrDevice
If intTimer > intTimeOut And arrResult(intIndex) = PendingCode Then
Call WriteToLog("Warning: " & NameLookup(intIndex) & Chr(32) & "run time exceeded the" & Chr(32) &_
intTimeOut & Chr(32) & "minute time-out threshold.")
End If
If arrResult(intIndex) = SuccessCode Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set InstallSoftware = dicResult
' Temporary file clean-up.
Call g_objFS.DeleteFile(g_strCurrentPath & Chr(92) & "*.tmp", True)
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Terminate a process. Return code 0 indicates success.
Function KillProcess(strProcessName)
On Error Resume Next
Dim objWMIConnect, colProcess, objProcess, objLoc, intProcess, strCommand, blnFound, intCommand, intSuccess
KillProcess = 99
Set objLoc = CreateObject("wbemscripting.swbemlocator")
objLoc.Security_.privileges.addasstring "sedebugprivilege", True
Set objWMIConnect = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIConnect.ExecQuery("Select * From Win32_Process")
blnFound = False
intSuccess = 0
For Each objProcess In colProcess
If Instr(LCase(strProcessName), LCase(objProcess.Caption)) > 0 Or Instr(LCase(strProcessName), LCase(objProcess.Description)) > 0 Or Instr(LCase(strProcessName), LCase(objProcess.Name)) > 0 Then
strCommand = g_strUtils & Chr(92) & "pskill.exe" & Chr(32) & strProcessName
blnFound = True
intCommand = g_objShell.Run(strCommand, MinWindow, True)
If intCommand = 0 Then
intSuccess = intSuccess + 1
End If
End If
Next
If blnFound = True And intSuccess > 0 Then
intProcess = 0
ElseIf blnFound = True And intSuccess = 0 Then
intProcess = 10
Else
intProcess = 20
End If
Set colProcess = Nothing
Set objWMIConnect = Nothing
KillProcess = intProcess
On Error GoTo 0
End Function
' Look up value in Register Name dictionary by its ordinal position. Return value is the Register IP address.
Function RegisterLookup(intIndex)
Dim intBase, strRegister
RegisterLookup = "Unknown"
intBase = 0
For Each strRegister In g_objRegister
If intBase = intIndex Then
RegisterLookup = g_objRegister.Item(strRegister)
Exit Function
End If
intBase = intBase + 1
Next
End Function
' Look up value in Register SFTP Test dictionary by its ordinal position. Return value is SFTP test result.
Function SFTPLookup(objSFTP, intIndex)
Dim intBase, strRegister
SFTPLookup = "Unknown"
intBase = 0
For Each strRegister In objSFTP
If intBase = intIndex Then
SFTPLookup = objSFTP.Item(strRegister)
Exit Function
End If
intBase = intBase + 1
Next
End Function
' Subroutine: Update the results CSV file for a given device.
Sub UpdateCSV(strDevice, strData, strInstall)
On Error Resume Next
Dim objCurrentFile, objNewFile
Dim strLine, strFile, strColumn, strText
Dim arrFile, arrRow
Dim intCount
Set objCurrentFile = g_objFS.OpenTextFile(g_strCSVTemp, ForReading)
strFile = objCurrentFile.ReadAll
objCurrentFile.Close
Set objCurrentFile = Nothing
Set objNewFile = g_objFS.CreateTextFile(g_strCSV & ".Update", True)
arrFile = Split(strFile, vbCrLF)
For Each strLine In arrFile
If Instr(strLine, strDevice) > 0 Then
arrRow = Split(strLine, Chr(44))
arrRow(3) = strData
arrRow(4) = strInstall
For intCount = 0 To UBound(arrRow) Step 1
strText = Replace(arrRow(intCount), Chr(34), "")
If intCount = UBound(arrRow) Then
objNewFile.WriteLine(Chr(34) & strText & Chr(34))
Else
objNewFile.Write(Chr(34) & strText & Chr(34) & Chr(44))
End If
Next
ElseIf Len(strLine) > 0 Then
objNewFile.WriteLine(strLine)
End If
Next
objNewFile.Close
Set objNewFile = Nothing
Call g_objFS.CopyFile(g_strCSV & ".Update", g_strCSVTemp, True)
Call g_objFS.DeleteFile(g_strCSV & ".Update", True)
On Error GoTo 0
End Sub
' Look up value in Register Name dictionary by its ordinal position. Return value is the Register computer name.
Function NameLookup(intIndex)
Dim intBase, strRegister
NameLookup = "Unknown"
intBase = 0
For Each strRegister In g_objRegister
If intBase = intIndex Then
NameLookup = strRegister
Exit Function
End If
intBase = intBase + 1
Next
End Function
' Function: Test WMI connection to a device. Return 0 for success, 1 otherwise.
Function TestWMI(strDevice)
On Error Resume Next
Dim objWMIService, intTestWMI
TestWMI = 999
' Test WMI connection, exit with 1 if unable to connect.
Err.Clear
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strDevice & "\root\cimv2")
If Err.Number = 0 Then
intTestWMI = 0
Else
intTestWMI = 1
End If
' Exit with 0 if able to establish connection.
TestWMI = intTestWMI
Set objWMIService = Nothing
On Error GoTo 0
End Function
' Function: Resolve address Host Name to an IP address.
Function ConvertToIP(strDevice)
ConvertToIP = "Unknown"
Dim objPingStatus, objShell, strLine, arrLine, strIPAddress, blnAlias
' Issue ping from the command prompt.
Set objShell = CreateObject("WScript.Shell")
Set objPingStatus = objShell.Exec("%ComSpec% /c ping" & Chr(32) & strDevice)
blnAlias = False
' Wait for command shell to finish.
Do
WScript.Sleep(1000)
Loop Until objPingStatus.Status = 1
' Test for a live device.
Do
strLine = objPingStatus.StdOut.ReadLine
If InStr(strLine, "Reply from") > 0 Or InStr(strLine, "ponse de") > 0 Then
blnAlias = True
arrLine = Split(strLine,Chr(32))
strIPAddress = Replace(arrLine(2),":","")
Exit Do
End If
Loop Until objPingStatus.StdOut.AtEndOfStream
Set objShell = Nothing
Set objPingStatus = Nothing
' Return IP address of device.
If blnAlias = True Then
ConvertToIP = strIPAddress
End If
End Function
' Make sure duplicate Registers do not exist when using the Target feature. Return 0 for no duplicate, 1 for duplicate.
Function IsDuplicate(strDevice, objDeviceList)
Dim strItem
IsDuplicate = 0
If objDeviceList.Count = 0 Then
Exit Function
End If
For Each strItem In objDeviceList
If strDevice = objDeviceList.Item(strItem) Then
IsDuplicate = 1
End If
Next
End Function
' Create a virtual Register hosts file based on the detected Registers. The hosts file with IP / alias is returned.
Function CreateVirtualHosts()
On Error Resume Next
CreateVirtualHosts = "Unknown"
Dim strVirtualHosts, strRegister, strRegNum, strIP
' Append to hosts file.
For Each strRegister In g_objRegister
strIP = g_objRegister.Item(strRegister)
strRegNum = Right(strRegister, 2)
If strRegNum = "79" And Right(strIP, 2) = ".1" Then
strRegNum = "01"
End If
strVirtualHosts = strVirtualHosts & strIP & vbTab & "reg" & strRegNum & vbCrLf
Next
CreateVirtualHosts = strVirtualHosts
On Error GoTo 0
End Function
Rookie---
Option Explicit
On Error Resume Next
' Establish global variables.
Dim g_intMain
Dim g_objFS, g_objShell, g_objCSV, g_objRegister
Dim g_strLogFolder, g_strLogFile, g_strServerName, g_strCurrentPath, g_strHosts, g_strFiletoexecute, g_strFiletoread
Dim g_strCSVTemp, g_strWinDir, g_strCSV, g_strUtils, g_strServerIPAddress, g_strEnvType, g_strPatch
Dim strNextline, strLine, strDest, objKBReg
Dim strFileCont, strFileReg, strNextL, objKBC, objKBR
Dim g_strBPS
' Constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const MinWindow = 7
Const SuccessCode = 555
Const PendingCode = 777
' Set global variables.
Set g_objFS = CreateObject("Scripting.FileSystemObject")
Set g_objShell = CreateObject("WScript.Shell")
Set g_objRegister = CreateObject("Scripting.Dictionary")
g_strServerName = g_objShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
g_strServerIPAddress = GetIPAddress(g_strServerName)
g_strCurrentPath = g_objFS.GetAbsolutePathName(".")
g_strHosts = GetOutput("type %systemroot%\system32\drivers\etc\hosts")
g_strUtils = "C:\Utils"
g_strPatch = "C:\MSPatch"
' Acquire local hosts file output for device name resolution.
g_strHosts = GetOutput("type %systemroot%\system32\drivers\etc\hosts")
' Determine Windows OS home folder.
g_strWinDir = ""
If g_objFS.FileExists("D:\XPS\xpsctrl.exe") Then
g_strWinDir = "WinNT"
ElseIf g_objFS.FileExists("C:\gstr\iSTORE\bin\DownloadProc.exe") Then
g_strWinDir = "Windows"
End If
' Check the RemoteWare Client service for administrative rights before proceeding.
If WScript.Arguments.Named.Exists("RemoteWareService") Then
Dim strRWFlag, strDoneFlag
strRWFlag = "C:\RemoteWareService.Flag"
strDoneFlag = "C:\Done.Flag"
If g_objFS.FileExists(strDoneFlag) Then
Call g_objFS.DeleteFile(strDoneFlag, True)
End If
If g_objFS.FileExists(strRWFlag) Then
Call g_objFS.DeleteFile(strRWFlag, True)
End If
If RemoteWareService() = 0 Then
Call g_objFS.CreateTextFile(strRWFlag, True)
End If
Call g_objFS.CreateTextFile(strDoneFlag, True)
WScript.Quit
End If
' Establish location for log file.
g_strLogFolder = "C:\MSPatch\"
If Not g_objFS.FolderExists(g_strLogFolder) Then
g_objFS.CreateFolder(g_strLogFolder)
End If
If Not WScript.Arguments.Named.Exists("Target") Then
g_strLogFile = g_strLogFolder & Chr(92) & g_strServerName & "_Install.log"
If g_objFS.FileExists(g_strLogFile) Then
Call g_objFS.DeleteFile(g_strLogFile, True)
End If
Else
g_strLogFile = g_strLogFolder & Chr(92) & g_strServerName & "_Install.log" & "_Target.log"
End If
' Output file to organize results.
g_strCSV = g_strLogFolder & Chr(92) & g_strServerName & "_Registers.csv"
g_strCSVTemp = g_strCSV & ".temp"
If g_objFS.FileExists(g_strCSVTemp) Then
g_objFS.DeleteFile(g_strCSVTemp)
End If
If g_objFS.FileExists(g_strCSV) Then
g_objFS.DeleteFile(g_strCSV)
End If
g_strFiletoexecute = "cmdLinesReg.txt"
g_strFiletoread = "PatchesReg.txt"
strFileCont = "C:\MSPatch\PatchesCont.txt"
strFileReg = "C:\MSPatch\PatchesReg.txt"
' Run main script.
g_intMain = Main()
' Prepare CSV file with results.
Call g_objFS.CopyFile(g_strCSVTemp, g_strCSV, True)
Call g_objFS.DeleteFile(g_strCSVTemp, True)
If WScript.Arguments.Named.Exists("Target") Then
Call g_objFS.DeleteFile(g_strCSV, True)
End If
' Exit and return result code to any calling application.
WScript.Quit(g_intMain)
' Function: The primary instructions of the script.
Function Main
' Declare function variables.
Dim intGenerateRegisters, intIndex, intResult, intDone, intTimer, intTimeOut, intSuccess
Dim strRegister, strRegisterIP, strRegisterAlias, strCommand
Dim strNow, strThen, strTool
Dim arrExec, arrResult, arrTool, arrEnvType
Dim objExec
Dim blnDone, blnEnvType, blnController
Dim objSFTP, objSSH, objData, objInstall, objResult
' Log header.
Call WriteToLog("Start of Installing Patches on Controller and Registers.")
Call WriteToLog("Target system is" & Chr(32) & Chr(34) & g_strServerName & Chr(34) & ", IP address:" & Chr(32) & g_strServerIPAddress)
If g_objFS.FileExists("C:\Temp\Patches.Flag")Then
Call g_objFS.DeleteFile("C:\Temp\Patches.Flag", True)
End If
If g_objFS.FileExists("C:\Temp\PatchCheck.Flag")Then
Call g_objFS.DeleteFile("C:\Temp\PatchCheck.Flag", True)
End If
'Controller KB File Test
Dim blnPatches
blnPatches = True
Set objKBC = g_objFS.OpenTextFile(strFileCont, ForReading)
Do Until objKBC.AtEndOfStream
strNextL = objKBC.Readline
If (g_objFS.FileExists("C:\MSPatch\Controller\" & strNextL)) Then
Call WriteToLog("Required file C:\MSPatch\Controller\" & strNextL & " exists.")
Else
blnPatches = False
Call WriteToLog("Required file C:\MSPatch\Controller\" & strNextL & " doesn't exist.")
End If
Loop
'Register KB File Test
Set objKBR = g_objFS.OpenTextFile (strFileReg, ForReading)
Do Until objKBR.AtEndOfStream
strNextL = objKBR.Readline
If (g_objFS.FileExists("C:\MSPatch\Register\" & strNextL)) Then
Call WriteToLog("Required file C:\MSPatch\Register\" & strNextL & " exists.")
Else
blnPatches = False
Call WriteToLog("Required file C:\MSPatch\Register\" & strNextL & " doesn't exist.")
End If
Loop
If blnPatches = True Then
Call g_objFS.CreateTextFile("C:\Temp\PatchCheck.Flag", True)
Call g_objFS.CreateTextFile("C:\Temp\Patches.Flag", True)
Else
Call g_objFS.CreateTextFile("C:\Temp\PatchCheck.Flag", True)
Exit Function
End If
' Create support tools folder.
If Not g_objFS.FolderExists(g_strUtils) Then
Call g_objFS.CreateFolder(g_strUtils)
End If
' Prepare support tools for batch mode.
arrTool = Array("psexec.reg", "pskill.reg")
For Each strTool In arrTool
If g_objFS.FileExists(g_strUtils & Chr(92) & strTool) Then
strCommand = "%ComSpec% /c regedit /s" & Chr(32) & g_strUtils & Chr(92) & strTool
intResult = g_objShell.Run(strCommand, MinWindow, True)
End If
Next
' Populate CSV file with Controller information.
blnController = True
Set g_objCSV = g_objFS.CreateTextFile(g_strCSVTemp, True)
g_objCSV.WriteLine(Chr(34) & g_strServerName & Chr(34) & Chr(44) &_
Chr(34) & g_strServerName & Chr(34) & Chr(44) &_
Chr(34) & g_strServerIPAddress & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34))
g_objCSV.Close
Set g_objCSV = Nothing
' Scan for all Registers.
If Not WScript.Arguments.Named.Exists("Target") Then
' Populate dictionary with all detected Registers.
Call WriteToLog("Detecting available Registers on the local network.")
intGenerateRegisters = GenerateRegisterTable()
' Populate CSV file with Register information.
If intGenerateRegisters = 0 Then
Call WriteToLog("Register detection complete," & Chr(32) & g_objRegister.Count & Chr(32) & "Register(s) detected.")
Set g_objCSV = g_objFS.OpenTextFile(g_strCSVTemp, ForAppending, False)
For Each strRegister In g_objRegister
g_objCSV.WriteLine(Chr(34) & g_strServerName & Chr(34) & Chr(44) &_
Chr(34) & strRegister & Chr(34) & Chr(44) &_
Chr(34) & g_objRegister.Item(strRegister) & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34) & Chr(44) &_
Chr(34) & "False" & Chr(34))
Next
g_objCSV.Close
Set g_objCSV = Nothing
Else
Call WriteToLog("A problem occured during the detection process: No Registers detected.")
Call WriteToLog("Exiting installation script.")
Main = 10
Exit Function
End If
' Confirm RemoteWare service is configured properly before doing anything.
intResult = RemoteWareService()
If intResult <> 0 Then
Call WriteToLog("Error:" & Chr(32) & Chr(34) & "RemoteWare Client" & Chr(34) & Chr(32) &_
"service is not running as an administrator account.")
Call WriteToLog("Please adjust the service properties before retrying.")
Call WriteToLog("Exiting installation script.")
Main = 5
Exit Function
End If
Else ' Determine if specific Registers are targetted for the installation.
blnController = False
Dim strDeviceList, arrDevices, strDeviceName, strDeviceIP, dicTarget, strDeviceNB
Set dicTarget = CreateObject("Scripting.Dictionary")
Call WriteToLog("Register Target switch specified, applying software to select Registers.")
strDeviceList = WScript.Arguments.Named("Target")
Call WriteToLog("Arguments:" & Chr(32) & strDeviceList)
strDeviceList = Replace(strDeviceList, Chr(32), "")
arrDevices = Split(strDeviceList, ",")
For Each strDeviceName In arrDevices
strDeviceIP = ConvertToIP(strDeviceName)
strDeviceNB = ResolveIPToHostName(strDeviceIP)
If UCase(strDeviceNB) <> UCase(g_strServerName) And strDeviceName <> "127.0.0.1" And g_strServerIPAddress <> strDeviceIP Then
If strDeviceIP <> "Unknown" Then
If IsDuplicate(strDeviceIP, dicTarget) = 0 Then
Call WriteToLog("Adding device to valid target list:" & Chr(32) & strDeviceNB & Chr(32) & "(" & strDeviceIP & ").")
Call dicTarget.Add(strDeviceNB, strDeviceIP)
Else
Call WriteToLog("Warning:" & Chr(32) & strDeviceName & Chr(32) & "already in target list, skipping duplicate value.")
End If
Else
Call WriteToLog("Device" & Chr(32) & strDeviceName & Chr(32) &_
"not recognized on network, omitting from target list.")
End If
End If
Next
If dicTarget.Count > 0 Then
Set g_objRegister = dicTarget
Else
Call WriteToLog("No valid devices exist as targets, exiting script.")
Main = 7
Exit Function
End If
Set dicTarget = Nothing
End If
' Create Register hosts file for SFTP and SSH aliasing.
' Issue SFTP connectivity test to all Registers.
Call WriteToLog("Performing SFTP connectivity test to all detected Registers.")
Call WriteToLog("Killing any existing SFTP processes before proceeding.")
intResult = KillProcess("sftpg3.exe")
Call WriteToLog("Waiting for Registers to finish SFTP test.")
Set objSFTP = TestSFTP(g_objRegister)
intResult = KillProcess("sftpg3.exe")
Call WriteToLog("SFTP tests complete, proceeding.")
' Issue SSH connectivity test to all Registers.
Call WriteToLog("Performing SSH connectivity test to all detected Registers.")
Call WriteToLog("Killing any existing SSH processes before proceeding.")
intResult = KillProcess("sshg3.exe")
Call WriteToLog("Waiting for Registers to finish SSH test.")
Set objSSH = TestSSH(g_objRegister)
intResult = KillProcess("sshg3.exe")
Call WriteToLog("SSH tests complete, proceeding.")
' Report the SFTP/SSH test results.
Call WriteToLog("Register SFTP/SSH test results:")
For Each strRegister in objSFTP
Call WriteToLog("SFTP test for Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objSFTP.Item(strRegister) & ".")
Call WriteToLog("SSH test for Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objSSH.Item(strRegister) & ".")
Next
' Deliver the data.
Call WriteToLog("Delivering files to the Registers.")
Set objData = DeliverFiles(g_objRegister, objSFTP)
Call WriteToLog("Register file delivery results:")
intSuccess = 0
For Each strRegister in objData
Call WriteToLog("File delivery for Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objData.Item(strRegister) & ".")
If objData.Item(strRegister) = "True" Then
Call UpdateCSV(g_objRegister.Item(strRegister), "True", "False")
intSuccess = intSuccess + 1
End If
Next
' Install the software on Registers.
Call WriteToLog("Performing software installation on all Registers.")
Set objInstall = InstallSoftware(g_objRegister, objSSH, objData)
Call WriteToLog("Software installation Register results:")
intSuccess = 0
For Each strRegister in objInstall
Call WriteToLog("Software installation on Register" & Chr(32) & strRegister & Chr(32) & "(" & g_objRegister.Item(strRegister) & ")" & Chr(32) &_
"evaluated as" & Chr(32) & objInstall.Item(strRegister) & ".")
If objInstall.Item(strRegister) = "True" Then
Call UpdateCSV(g_objRegister.Item(strRegister), "True", "True")
intSuccess = intSuccess + 1
End If
Next
Call WriteToLog(intSuccess & Chr(32) & "of" & Chr(32) & g_objRegister.Count & Chr(32) & "Registers successfully installed the software.")
intResult = intSuccess / g_objRegister.Count
Call WriteToLog(FormatPercent(intResult, 2) & Chr(32) & "of the Registers are complete.")
' Install the software on Controller.
If blnController Then
Call WriteToLog("Performing software installation on Controller" & Chr(32) & g_strServerName & ".")
strDest = "C:\Temp"
Call g_objFS.CopyFile(g_strPatch & "\cmdlinescont.txt", strDest & Chr(92) & "cmdlinescont.bat", True)
strCommand = "%ComSpec% /v
n /c (start /wait /min" & Chr(32) & strDest & "\cmdlinescont.bat) & exit !errorlevel!" & Chr(32) & "> nul 2>&1"Set objResult = g_objShell.Exec(strCommand)
strThen = Now
intTimeOut = 10 'Time-out threshold in minutes.
Do
WScript.Sleep(10000)
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
Loop Until objResult.Status = 1 Or intTimer > intTimeOut
' Process results of software installation on Controller.
If objResult.ExitCode = SuccessCode Then
Call WriteToLog("Software installation on Controller" & Chr(32) & g_strServerName & Chr(32) &_
"(" & g_strServerIPAddress & ") evaluated as True.")
Call UpdateCSV(g_strServerIPAddress, "True", "True")
intSuccess = intSuccess + 1
Else
If intTimer > intTimeOut Then
Call WriteToLog("Warning: Software installation on Controller" & Chr(32) & g_strServerName & Chr(32) &_
"(" & g_strServerIPAddress & ") exceeded the" & Chr(32) & intTimeOut & Chr(32) & "minute time-out threshold.")
End If
Call WriteToLog("Software installation on Controller" & Chr(32) & g_strServerName & Chr(32) &_
"(" & g_strServerIPAddress & ") evaluated as False.")
Call UpdateCSV(g_strServerIPAddress, "True", "False")
End If
Else
Call WriteToLog("Skipping Controller software installation.")
End If
' Report summary of the results.
If blnController Then
intResult = FormatPercent(intSuccess / (g_objRegister.Count + 1), 2)
Call WriteToLog("Summary:" & Chr(32) & intSuccess & Chr(32) & "of" & Chr(32) & (g_objRegister.Count + 1) & Chr(32) &_
"POS devices successful =" & Chr(32) & intResult)
End If
Call WriteToLog("End of Patch Installation.")
' Primary instructions finished.
Main = 0
End Function
' Function: Create an array of Registers based on the current ARP table. Return code 0 indicates at least one Register detected.
Function GenerateRegisterTable()
On Error Resume Next
GenerateRegisterTable = 999
Dim objARPStatus, arrOutput, strOutput, intCount, strDivision, intDynamic, intGRT
intCount = 0
Set objARPStatus = g_objShell.Exec("%ComSpec% /c arp -a")
Do
WScript.Sleep(500)
Loop Until objARPStatus.Status = 1
Do
strOutput = CStr(LTrim(objARPStatus.StdOut.ReadLine))
' English or French may appear in output, must consider both.
intDynamic = InStr(strOutput, "dynamic") + InStr(strOutput, "dynamique")
If intDynamic > 0 Then
Dim arrCurrentIP, strCurrentIP, strCurrentHostName, intRegNum
arrOutput = Split(strOutput, " ")
arrCurrentIP = Split(arrOutput(0),".")
strCurrentIP = arrOutput(0)
strCurrentHostName = ResolveIPToHostName(strCurrentIP)
intRegNum = RegExGetBRef(strCurrentHostName, "^([a-z]{3,4})\d{3,4}(\d{2})$", 2, True)
If UCase(Left(g_strServerName, 7)) = UCase(Left(strCurrentHostName, 7)) Then
If strCurrentHostName <> "Unknown" And PingStatus(strCurrentIP) = 0 And intRegNum <> "" And intRegNum <> "00" Then
If Right(strCurrentHostName, 2) <> "99" Then
Call g_objRegister.Add(strCurrentHostName, strCurrentIP)
intCount = intCount + 1
ElseIf Right(strCurrentHostName, 2) = "99" Then
g_strBPS = strCurrentIP
Call g_objRegister.Add(strCurrentHostName, strCurrentIP)
End If
End If
End If
End If
Loop Until objARPStatus.StdOut.AtEndOfStream
Set objARPStatus = Nothing
' Confirm at least one Register detected.
If intCount > 0 Then
intGRT = 0
' Otherwise flag a problem.
Else
intGRT = 1
End If
GenerateRegisterTable = intGRT
On Error GoTo 0
End Function
' Function: Resolve IP address to the NetBIOS hostname. Return value is the NetBIOS hostname.
Function ResolveIPToHostName(strIPAddressToResolve)
On Error Resume Next
strResolveIPToHostName = "Unknown"
Dim objNBStatus, strOutput, strPattern, intHostName, intRegNum, strResolveIPToHostName
strPattern = "<00> UNIQUE"
Set objNBStatus = g_objShell.Exec("nbtstat -A" & Chr(32) & strIPAddressToResolve)
Do
WScript.Sleep(500)
Loop Until objNBStatus.Status = 1
Do
strOutput = objNBStatus.StdOut.ReadLine
intHostName = InStr(strOutput, strPattern)
If intHostName > 0 Then
Dim arrCurrentLine
arrCurrentLine = Split(LTrim(strOutput), " ")
If Instr(arrCurrentLine, "IS~") = 0 And Instr(arrCurrentLine, "..") = 0 Then
strResolveIPToHostName = Replace(Replace(Replace(arrCurrentLine(0),"IS~",""),".",""),"<00>","")
End If
End If
Loop Until objNBStatus.StdOut.AtEndOfStream
Set objNBStatus = Nothing
ResolveIPToHostName = strResolveIPToHostName
On Error GoTo 0
End Function
Function RegExGetBRef(strString, strPattern, intBRef, blnIgnoreCase)
'
' Provide a single-line interface to use RegExp to parse a string and return a single
' backreference. intBRef is a Base-1 index (1 for the first capture, 2 for second, etc).
' If the pattern is not matched at all, or if an invalid value is passed for intBRef,
' the function will return an empty string.
'
' The RegExp search is always performed with Global mode set to false. This is for simple
' captures only.
'
' Ex: RegExGetBRef("Hello, There!", "(.*),\s*([^,]+)$", 1, True) returns "Hello", and
' RegExGetBRef("Hello, There!", "(.*),\s*([^,]+)$", 2, True) returns "There!"
RegExGetBRef = ""
Dim objRegExp
Dim colMatches, objMatch
Set objRegExp = New RegExp
objRegExp.Pattern = strPattern
objRegExp.IgnoreCase = blnIgnoreCase
objRegExp.Global = False
objRegExp.MultiLine = True
Set colMatches = objRegExp.Execute(strString)
For Each objMatch In colMatches
If ((intBRef > 0) And (intBRef <= objMatch.SubMatches.Count)) Then
RegExGetBRef = objMatch.SubMatches(intBRef - 1)
End If
Next
End Function
' Function: Confirm device is communicating by pinging it. Return code 0 means device is alive.
Function PingStatus(strDeviceToPing)
PingStatus = 9999
Dim objPingStatus
Dim strLine, intCount
Set objPingStatus = g_objShell.Exec("%ComSpec% /c ping" & Chr(32) & strDeviceToPing)
intCount = 0
Do
WScript.Sleep(500)
Loop Until objPingStatus.Status = 1
Do
strLine = objPingStatus.StdOut.ReadLine
' English or French may appear in output, must consider both.
If InStr(strLine, "Reply from") > 0 Or InStr(strLine, "ponse de") > 0 Then
intCount = intCount + 1
End If
Loop Until objPingStatus.StdOut.AtEndOfStream
' Two or more responses flag a successful ping.
If intCount >= 2 Then
PingStatus = 0
End If
Set objPingStatus = Nothing
End Function
' Function: Return output from a command.
Function GetOutput(strCommand)
On Error Resume Next
Dim objFSO, WshShell, objTempFile, strTempFile, strOutput
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
strTempFile = objFSO.GetTempName
WshShell.Run "%comspec% /c """ & strCommand & " > " & strTempFile & """", 7, True
If (Not objFSO.FileExists(strTempFile)) Then
GetOutput = ""
Else
strOutput = ""
Set objTempFile = objFSO.OpenTextFile(strTempFile, 1)
If (Not Err.Number) Then
Do While (Not objTempFile.AtEndOfStream)
strOutput = strOutput & objTempFile.ReadAll
Loop
objTempFile.Close
End If
GetOutput = strOutput
End If
objFSO.DeleteFile strTempFile, True
Set objFSO = Nothing
Set WshShell = Nothing
End Function
' Function: Return Register alias from local hosts file based on IP address lookup.
Function GetRegisterAlias(strIP)
' Search g_strHosts for a line which beings with strIP, and return the first alias defined on that line
' If no line found, return the empty string.
GetRegisterAlias = ""
Dim strLineIP
Dim strLine
For Each strLine In Split(g_strHosts, vbCrLf)
strLineIP = RegExGetBRef(strLine, "^\s*(\S+)\s*(\S+)", 1, True)
If (strLineIP = strIP) Then
GetRegisterAlias = RegExGetBRef(strLine, "(reg\d{2})(?:$|\s)", 1, True)
Exit For
End If
Next
End Function
' Function: Review status of all running jobs. Return code 0 indicates all jobs have finished.
Function ExecDone(arrResult)
On Error Resume Next
ExecDone = 999
Dim intResult, intTotal, intSum
intSum = 0
intTotal = UBound(arrResult) + 1
' The pending status previously populated should change to the actual return code or a forced error code.
For Each intResult In arrResult
If intResult <> PendingCode Then
intSum = intSum + 1
End If
Next
If intSum = intTotal Then
ExecDone = 0
Else
ExecDone = 1
End If
On Error GoTo 0
End Function
' Function: Return exact date and time to append to log file name. Return the date suffix.
Function DateSuffix
Dim strHour, strMinute, strSecond, strNow, strMonth, strDay, strYear
strNow = Now()
strHour = TwoDigit(DatePart("h", strNow))
strMinute = TwoDigit(DatePart("n", strNow))
strSecond = TwoDigit(DatePart("s", strNow))
strMonth = TwoDigit(DatePart("m", strNow))
strDay = TwoDigit(DatePart("d", strNow))
strYear = DatePart("yyyy", strNow)
'DateSuffix = strMonth & strDay & strYear & "-" & strHour & strMinute & strSecond
DateSuffix = strMonth & strDay & strYear
End Function
' Function: Ensure single-character numbers appear in two-digit format. Return the two-digit number.
Function TwoDigit(intNumber)
TwoDigit = CStr(intNumber)
If intNumber >= 0 And intNumber < 10 Then
TwoDigit = "0" & TwoDigit
End If
End Function
' Subroutine: Write information to the log file.
Sub WriteToLog(strTextIn)
Dim objLogFile
Set objLogFile = g_objFS.OpenTextFile(g_strLogFile, ForAppending, True)
objLogFile.WriteLine(CurrentTimeStamp & strTextIn & vbCrLf)
objLogFile.Close
Set objLogFile = Nothing
If TypeName(strTextIn) = "String" Then
WScript.Echo VbCrLf & strTextIn & VbCrLf
End If
End Sub
' Function: Return current date and time in a fixed format.
Function CurrentTimeStamp
Dim strMonth, strDay, strYear, strNow, strHour, strMinute, strSecond
CurrentTimeStamp = "Unknown"
strNow = Now()
strMonth = TwoDigit(DatePart("m", strNow))
strDay = TwoDigit(DatePart("d", strNow))
strYear = DatePart("yyyy", strNow)
strHour = TwoDigit(DatePart("h", strNow))
strMinute = TwoDigit(DatePart("n", strNow))
strSecond = TwoDigit(DatePart("s", strNow))
CurrentTimeStamp = strMonth & Chr(47) & strDay & Chr(47) & strYear & Chr(32) &_
strHour & Chr(58) & strMinute & Chr(58) & strSecond & Chr(32) &_
"--" & Chr(32)
End Function
' Function: Query "RemoteWare Client" service for proper service log on configuration. Return code 0 indicates expected configuration.
Function RemoteWareService()
On Error Resume Next
Dim objWMIService, colListOfServices, objService, strServiceName, intRemoteWareService
RemoteWareService = 999
intRemoteWareService = 999
strServiceName = "RemoteWare Client"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name ='" & strServiceName & "'")
intRemoteWareService = 1
For Each objService In colListOfServices
If Instr(LCase(objService.StartName), LCase("Cambridge")) > 0 Or Instr(LCase(objService.StartName), LCase("eService")) > 0 Then
intRemoteWareService = 0
End If
Next
RemoteWareService = intRemoteWareService
On Error GoTo 0
End Function
' Function: Acquire active IP address of local device. Return value is the IP address discovered.
Function GetIPAddress(strComputerName)
On Error Resume Next
GetIPAddress = "Unable to determine IP."
Dim strOutput, strLine, arrOutput, arrLine, strValue, strIPAddress
strOutput = GetOutput("arp -a")
arrOutput = Split(strOutput, vbCrLf)
strIPAddress = ""
For Each strLine In arrOutput
If Instr(LCase(strLine), LCase("Interface")) > 0 Then
arrLine = Split(strLine, Chr(32))
For Each strValue In arrLine
If IsNumeric(Left(strValue,1)) And Not Instr(strValue, "x") > 0 Then
strIPAddress = strValue
Exit For
End If
Next
End If
Next
GetIPAddress = strIPAddress
On Error GoTo 0
End Function
' Function: Confirm the SFTP connection to a device. Return a dictionary object with the results.
Function TestSFTP(arrDevice)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias
Dim arrExec, arrResult
Set dicResult = CreateObject("Scripting.Dictionary")
Set TestSFTP = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
' Initiate the SFTP test connection.
intIndex = 0
For Each strDevice In arrDevice
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strBatchFile = g_strCurrentPath & Chr(92) & g_objFS.GetTempName()
Err.Clear
Set objBatchFile = g_objFS.CreateTextFile(strBatchFile, True)
If Err.Number = 0 Then
objBatchFile.WriteLine("open Cambridge@" & strAlias)
objBatchFile.WriteLine("bye")
objBatchFile.Close
strExec = "%ComSpec% /v
n /c (start /wait /min sftpg3.exe -B" & Chr(32) & Chr(34) & strBatchFile & Chr(34) &_") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
arrResult(intIndex) = 999
End If
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish SFTP test or time-out.
intDone = 1
intTimeOut = 5 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If arrResult(intIndex) <> 999 Then
If objExec.Status = 1 Then
arrResult(intIndex) = objExec.ExitCode
End If
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with SFTP test results.
intIndex = 0
For Each strDevice In arrDevice
If arrResult(intIndex) = 0 Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set TestSFTP = dicResult
' Temporary file clean-up.
Call g_objFS.DeleteFile(g_strCurrentPath & Chr(92) & "*.tmp")
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Confirm the SSH connection to a device. Return a dictionary object with the results.
Function TestSSH(arrDevice)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias
Dim arrExec, arrResult
Set dicResult = CreateObject("Scripting.Dictionary")
Set TestSSH = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
' Initiate the SSH test connection.
intIndex = 0
For Each strDevice In arrDevice
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strExec = "cmd /v
n /c (start /wait /min sshg3.exe -B cambridge@" & strAlias & Chr(32) &_"ipconfig) & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish SSH test or time-out.
intDone = 1
intTimeOut = 5 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If objExec.Status = 1 Then
arrResult(intIndex) = objExec.ExitCode
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with SSH test results.
intIndex = 0
For Each strDevice In arrDevice
If arrResult(intIndex) = 0 Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set TestSSH = dicResult
' Temporary file clean-up.
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Deliver data over SFTP or UNC. Return a dictionary object containing the results (T or F).
Function DeliverFiles(arrDevice, objSFTP)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult, intTestWMI
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias, strSFTP
Dim arrExec, arrResult, arrRetry, strBatch
Set dicResult = CreateObject("Scripting.Dictionary")
Set DeliverFiles = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
ReDim arrRetry(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
arrRetry(intIndex) = "False"
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
'wscript.echo "starting"
' Deliver the data.
intIndex = 0
For Each strDevice In arrDevice
' SFTP delivery.
If objSFTP.Item(strDevice) = "True" Then
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strBatchFile = g_strCurrentPath & Chr(92) & g_objFS.GetTempName()
Err.Clear
Set objBatchFile = g_objFS.CreateTextFile(strBatchFile, True)
If Err.Number = 0 Then
objBatchFile.WriteLine("open Cambridge@" & strAlias)
objBatchFile.WriteLine("cd /C:/temp")
objBatchFile.WriteLine("lcd C:/MSPatch")
objBatchFile.WriteLine("sput" & Chr(32) & g_strFiletoexecute & Chr(32) & "cmdlinesreg.bat")
objBatchFile.WriteLine("lcd C:/MSPatch/Register")
Set objKBReg = g_objFS.OpenTextFile(g_strfiletoread, ForReading)
Do
strNextline = objKBReg.Readline
objBatchFile.WriteLine("put" & Chr(32) & strNextLine)
Loop Until objKBReg.AtEndOfStream
objKBReg.Close
Set objKBReg = Nothing
objBatchFile.WriteLine("bye")
objBatchFile.Close
strExec = "%ComSpec% /v
n /c (start /wait /min sftpg3.exe -B" & Chr(32) & Chr(34) & strBatchFile & Chr(34) &_") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
arrResult(intIndex) = 999
End If
' UNC delivery (xcopy).
Else
intTestWMI = TestWMI(arrDevice.Item(strDevice))
If intTestWMI = 0 Then
strBatch = ""
Set objKBReg = g_objFS.OpenTextFile(g_strfiletoread, ForReading)
Do
strNextline = objKBReg.Readline
Err.Clear
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\Register\" & strNextLine & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp) & " & strBatch
Loop Until objKBReg.AtEndOfStream
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\" & g_strFiletoexecute & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp\cmdlinesreg.bat) & " & strBatch
objKBReg.Close
Set objKBReg = Nothing
strExec = "%ComSpec% /v: on /c" & Chr(32) & strBatch & "exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
Set arrResult(intIndex) = 1234
End If
End If
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish delivering data / retry / time-out.
intDone = 1
intTimeOut = 10 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If arrResult(intIndex) = PendingCode Then
If objExec.Status = 1 Then
arrResult(intIndex) = objExec.ExitCode
If arrResult(intIndex) <> 0 And SFTPLookup(objSFTP, intIndex) = "True" And arrRetry(intIndex) = "False" Then
arrResult(intIndex) = PendingCode
arrRetry(intIndex) = "True"
End If
End If
End If
' If SFTP fails, retry with the UNC (xcopy) method.
If objExec.Status = 1 And arrResult(intIndex) = PendingCode And SFTPLookup(objSFTP, intIndex) = "True" Then
strBatch = ""
Set objKBReg = g_objFS.OpenTextFile(g_strfiletoread, ForReading)
Do
strNextline = objKBReg.Readline
Err.Clear
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\Register\" & strNextLine & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp) & " & strBatch
Loop Until objKBReg.AtEndOfStream
strBatch = "(copy /Y /V" & Chr(32) & g_strPatch & "\" & g_strFiletoexecute & Chr(32) & "\\" & arrDevice.Item(strDevice) & "\C$\Temp\cmdlinesreg.bat) & " & strBatch
objKBReg.Close
Set objKBReg = Nothing
strExec = "%ComSpec% /v: on /c" & Chr(32) & strBatch & "exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with data delivery results.
intIndex = 0
For Each strDevice In arrDevice
If arrResult(intIndex) = 0 Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set DeliverFiles = dicResult
' Temporary file clean-up.
Call g_objFS.DeleteFile(g_strCurrentPath & Chr(92) & "*.tmp", True)
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Install software over SSH or Psexec. Return a dictionary object with the results (T or F).
Function InstallSoftware(arrDevice, objSSH, objData)
On Error Resume Next
Dim objExec, objBatchFile, dicResult
Dim intTimeOut, intTimer, intDone, intIndex, intResult
Dim strExec, strBatchFile, strNow, strThen, strDevice, strAlias, strSFTP
Dim arrExec, arrResult, arrRetry
Set dicResult = CreateObject("Scripting.Dictionary")
Set InstallSoftware = dicResult
' Dimension arrays.
ReDim arrExec(arrDevice.Count - 1)
ReDim arrResult(arrDevice.Count - 1)
ReDim arrRetry(arrDevice.Count - 1)
' Populate status array with pending result code.
intIndex = 0
Do
arrResult(intIndex) = PendingCode
arrRetry(intIndex) = "False"
intIndex = intIndex + 1
Loop Until intIndex > UBound(arrResult)
strBatchFile = "C:\Temp\cmdlinesreg.bat"
' Install the software.
intIndex = 0
For Each strDevice In arrDevice
If objSSH.Item(strDevice) = "True" And objData.Item(strDevice) = "True" Then
strAlias = GetRegisterAlias(arrDevice.Item(strDevice))
If strAlias = "" Then
strAlias = arrDevice.Item(strDevice)
End If
strExec = "cmd /v
n /c (start /wait /min sshg3.exe -B cambridge@" & strAlias & Chr(32) &_strBatchFile & ") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
ElseIf objData.Item(strDevice) = "True" Then
strExec = "cmd /v
n /c (start /wait /min C:\Utils\psexec.exe" & Chr(32) & "\\" & arrDevice.Item(strDevice) &_Chr(32) & strBatchFile & ") & exit !errorlevel!" & Chr(32) & "> nul 2>&1"
Set arrExec(intIndex) = g_objShell.Exec(strExec)
Else
arrResult(intIndex) = 888
End If
intIndex = intIndex + 1
WScript.Sleep(1000)
Next
' Wait for all Registers to finish software installation or time-out.
intDone = 1
intTimeOut = 15 'Time-out threshold in minutes.
strThen = Now
Do
intIndex = 0
WScript.Sleep(1000)
For Each objExec In arrExec
If objExec.Status = 1 And arrResult(intIndex) <> 888 Then
arrResult(intIndex) = objExec.ExitCode
End If
intIndex = intIndex + 1
Next
strNow = Now
intTimer = DateDiff("n", strThen, strNow)
intDone = ExecDone(arrResult)
Loop Until intDone = 0 Or intTimer > intTimeOut
' Populate dictionary with software installation results.
intIndex = 0
For Each strDevice In arrDevice
If intTimer > intTimeOut And arrResult(intIndex) = PendingCode Then
Call WriteToLog("Warning: " & NameLookup(intIndex) & Chr(32) & "run time exceeded the" & Chr(32) &_
intTimeOut & Chr(32) & "minute time-out threshold.")
End If
If arrResult(intIndex) = SuccessCode Then
Call dicResult.Add(strDevice, "True")
Else
Call dicResult.Add(strDevice, "False")
End If
intIndex = intIndex + 1
Next
' Return the dictionary object.
Set InstallSoftware = dicResult
' Temporary file clean-up.
Call g_objFS.DeleteFile(g_strCurrentPath & Chr(92) & "*.tmp", True)
Set dicResult = Nothing
On Error GoTo 0
End Function
' Function: Terminate a process. Return code 0 indicates success.
Function KillProcess(strProcessName)
On Error Resume Next
Dim objWMIConnect, colProcess, objProcess, objLoc, intProcess, strCommand, blnFound, intCommand, intSuccess
KillProcess = 99
Set objLoc = CreateObject("wbemscripting.swbemlocator")
objLoc.Security_.privileges.addasstring "sedebugprivilege", True
Set objWMIConnect = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIConnect.ExecQuery("Select * From Win32_Process")
blnFound = False
intSuccess = 0
For Each objProcess In colProcess
If Instr(LCase(strProcessName), LCase(objProcess.Caption)) > 0 Or Instr(LCase(strProcessName), LCase(objProcess.Description)) > 0 Or Instr(LCase(strProcessName), LCase(objProcess.Name)) > 0 Then
strCommand = g_strUtils & Chr(92) & "pskill.exe" & Chr(32) & strProcessName
blnFound = True
intCommand = g_objShell.Run(strCommand, MinWindow, True)
If intCommand = 0 Then
intSuccess = intSuccess + 1
End If
End If
Next
If blnFound = True And intSuccess > 0 Then
intProcess = 0
ElseIf blnFound = True And intSuccess = 0 Then
intProcess = 10
Else
intProcess = 20
End If
Set colProcess = Nothing
Set objWMIConnect = Nothing
KillProcess = intProcess
On Error GoTo 0
End Function
' Look up value in Register Name dictionary by its ordinal position. Return value is the Register IP address.
Function RegisterLookup(intIndex)
Dim intBase, strRegister
RegisterLookup = "Unknown"
intBase = 0
For Each strRegister In g_objRegister
If intBase = intIndex Then
RegisterLookup = g_objRegister.Item(strRegister)
Exit Function
End If
intBase = intBase + 1
Next
End Function
' Look up value in Register SFTP Test dictionary by its ordinal position. Return value is SFTP test result.
Function SFTPLookup(objSFTP, intIndex)
Dim intBase, strRegister
SFTPLookup = "Unknown"
intBase = 0
For Each strRegister In objSFTP
If intBase = intIndex Then
SFTPLookup = objSFTP.Item(strRegister)
Exit Function
End If
intBase = intBase + 1
Next
End Function
' Subroutine: Update the results CSV file for a given device.
Sub UpdateCSV(strDevice, strData, strInstall)
On Error Resume Next
Dim objCurrentFile, objNewFile
Dim strLine, strFile, strColumn, strText
Dim arrFile, arrRow
Dim intCount
Set objCurrentFile = g_objFS.OpenTextFile(g_strCSVTemp, ForReading)
strFile = objCurrentFile.ReadAll
objCurrentFile.Close
Set objCurrentFile = Nothing
Set objNewFile = g_objFS.CreateTextFile(g_strCSV & ".Update", True)
arrFile = Split(strFile, vbCrLF)
For Each strLine In arrFile
If Instr(strLine, strDevice) > 0 Then
arrRow = Split(strLine, Chr(44))
arrRow(3) = strData
arrRow(4) = strInstall
For intCount = 0 To UBound(arrRow) Step 1
strText = Replace(arrRow(intCount), Chr(34), "")
If intCount = UBound(arrRow) Then
objNewFile.WriteLine(Chr(34) & strText & Chr(34))
Else
objNewFile.Write(Chr(34) & strText & Chr(34) & Chr(44))
End If
Next
ElseIf Len(strLine) > 0 Then
objNewFile.WriteLine(strLine)
End If
Next
objNewFile.Close
Set objNewFile = Nothing
Call g_objFS.CopyFile(g_strCSV & ".Update", g_strCSVTemp, True)
Call g_objFS.DeleteFile(g_strCSV & ".Update", True)
On Error GoTo 0
End Sub
' Look up value in Register Name dictionary by its ordinal position. Return value is the Register computer name.
Function NameLookup(intIndex)
Dim intBase, strRegister
NameLookup = "Unknown"
intBase = 0
For Each strRegister In g_objRegister
If intBase = intIndex Then
NameLookup = strRegister
Exit Function
End If
intBase = intBase + 1
Next
End Function
' Function: Test WMI connection to a device. Return 0 for success, 1 otherwise.
Function TestWMI(strDevice)
On Error Resume Next
Dim objWMIService, intTestWMI
TestWMI = 999
' Test WMI connection, exit with 1 if unable to connect.
Err.Clear
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strDevice & "\root\cimv2")
If Err.Number = 0 Then
intTestWMI = 0
Else
intTestWMI = 1
End If
' Exit with 0 if able to establish connection.
TestWMI = intTestWMI
Set objWMIService = Nothing
On Error GoTo 0
End Function
' Function: Resolve address Host Name to an IP address.
Function ConvertToIP(strDevice)
ConvertToIP = "Unknown"
Dim objPingStatus, objShell, strLine, arrLine, strIPAddress, blnAlias
' Issue ping from the command prompt.
Set objShell = CreateObject("WScript.Shell")
Set objPingStatus = objShell.Exec("%ComSpec% /c ping" & Chr(32) & strDevice)
blnAlias = False
' Wait for command shell to finish.
Do
WScript.Sleep(1000)
Loop Until objPingStatus.Status = 1
' Test for a live device.
Do
strLine = objPingStatus.StdOut.ReadLine
If InStr(strLine, "Reply from") > 0 Or InStr(strLine, "ponse de") > 0 Then
blnAlias = True
arrLine = Split(strLine,Chr(32))
strIPAddress = Replace(arrLine(2),":","")
Exit Do
End If
Loop Until objPingStatus.StdOut.AtEndOfStream
Set objShell = Nothing
Set objPingStatus = Nothing
' Return IP address of device.
If blnAlias = True Then
ConvertToIP = strIPAddress
End If
End Function
' Make sure duplicate Registers do not exist when using the Target feature. Return 0 for no duplicate, 1 for duplicate.
Function IsDuplicate(strDevice, objDeviceList)
Dim strItem
IsDuplicate = 0
If objDeviceList.Count = 0 Then
Exit Function
End If
For Each strItem In objDeviceList
If strDevice = objDeviceList.Item(strItem) Then
IsDuplicate = 1
End If
Next
End Function
' Create a virtual Register hosts file based on the detected Registers. The hosts file with IP / alias is returned.
Function CreateVirtualHosts()
On Error Resume Next
CreateVirtualHosts = "Unknown"
Dim strVirtualHosts, strRegister, strRegNum, strIP
' Append to hosts file.
For Each strRegister In g_objRegister
strIP = g_objRegister.Item(strRegister)
strRegNum = Right(strRegister, 2)
If strRegNum = "79" And Right(strIP, 2) = ".1" Then
strRegNum = "01"
End If
strVirtualHosts = strVirtualHosts & strIP & vbTab & "reg" & strRegNum & vbCrLf
Next
CreateVirtualHosts = strVirtualHosts
On Error GoTo 0
End Function