home *** CD-ROM | disk | FTP | other *** search
' *** ' *** ------------------------------------------------------------------------------ ' *** Filename: clsDiskProtect.vbs ' *** ------------------------------------------------------------------------------ ' *** Description: Disk Protection Class ' *** ------------------------------------------------------------------------------ ' *** Version: 1.0 ' *** Notes: ' *** ------------------------------------------------------------------------------ ' *** Copyright (C) Microsoft Corporation 2005, All Rights Reserved ' *** ------------------------------------------------------------------------------ ' *** ' ~~~ ' ~~~ Force variables to be declared and turn off script error messages unless in DEBUG mode ' ~~~ Option Explicit Class DiskProtect ' ~~~ ------------------------------------------------------------------------------ ' ~~~ declare variables and constants ' ~~~ ------------------------------------------------------------------------------ Dim oLog, bLogging, sCmd, sCmd1, sCmd2, sCmd3, sTempCmd, sArcName Dim iDiskID, iPartID, iOverlayTime, iReturn Dim bEnabled, bOverlayCreated Dim bSetLevel, bCommit, bNoCMD, bEnable, bDisable Dim ColOperatingSystems, oOS, oDisk, oDiskDrives, oPartition Dim oDiskPartitions, oLogicalDisk, oLogicalDisks, sEscapedDeviceID ' ~~~ ' ~~~ public properties ' ~~~ ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: Logging ' *** ------------------------------------------------------------------------------ ' *** Purpose: Turns on logging, property must be set to a logging object ' *** ------------------------------------------------------------------------------ ' *** Public Property Get Logging Logging = bLogging End Property Public Property Let Logging(oObject) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 If VarType(oObject) = vbObject Then bLogging = True Set oLog = oObject End If End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: Enabled ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns whether disk protection is enabled or not ' *** Property is read only ' *** ------------------------------------------------------------------------------ ' *** Public Property Get Enabled If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ default value Enabled = False ' ~~~ If the Overlay has not been created, it can not be enabled If Not(OverlayCreated) Then Exit Property ' ~~~ overlay created proceed, create object If bEnabled Then Enabled = True End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: BootCommand ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns the EWF BootCommand ' *** Property is read only. ' *** ------------------------------------------------------------------------------ ' *** Public Property Get BootCommand If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ default value BootCommand = "" ' ~~~ If the Overlay has not been created, it can not be enabled If Not(OverlayCreated) Then Exit Property ' ~~~ overlay created proceed, create object If bSetLevel Then BootCommand = "SET_LEVEL" ElseIf bCommit Then BootCommand = "COMMIT" ElseIf bNoCMD Then BootCommand = "NO_CMD" ElseIf bEnable Then BootCommand = "ENABLE" ElseIf bDisable Then BootCommand = "DISABLE" End If End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: WindowsUpdateScript ' *** ------------------------------------------------------------------------------ ' *** Purpose: Location of script file used to install files from WindowsUpdate ' *** Note: This property has different Get and Let conditions. We never ' *** want to change the value the user has set for AUOptions ' *** ------------------------------------------------------------------------------ ' *** Public Property Get WindowsUpdateScript If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 If RegRead(TOOLKITKEY & "WindowsUpdateScript") = "" Then WindowsUpdateScript = False Else WindowsUpdateScript = True End If End Property Public Property Let WindowsUpdateScript(bOn) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 If bOn Then Call RegWrite(TOOLKITKEY & "WindowsUpdateScript", GetRootFolder & "\bin\windowsupdates.vbs", "REG_SZ") Call RegWrite("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\AUOptions", 4, "REG_DWORD") Else Call RegWrite(TOOLKITKEY & "WindowsUpdateScript", "", "REG_SZ") Call RegWrite("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\AUOptions", 1, "REG_DWORD") End If End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: AVUpdateScript ' *** ------------------------------------------------------------------------------ ' *** Purpose: Location of script file used to update anti-virus signatures ' *** ------------------------------------------------------------------------------ ' *** Public Property Get AVUpdateScript If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 AVUpdateScript = RegRead(TOOLKITKEY & "AVUpdateScript") End Property Public Property Let AVUpdateScript(sScript) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Call RegWrite(TOOLKITKEY & "AVUpdateScript", sScript, "REG_SZ") End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: OtherUpdateScript ' *** ------------------------------------------------------------------------------ ' *** Purpose: Location of script file used to install other updates ' *** ------------------------------------------------------------------------------ ' *** Public Property Get OtherUpdateScript If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 OtherUpdateScript = RegRead(TOOLKITKEY & "OtherUpdateScript") End Property Public Property Let OtherUpdateScript(sScript) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Call RegWrite(TOOLKITKEY & "OtherUpdateScript", sScript, "REG_SZ") End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: CriticalUpdateDay ' *** ------------------------------------------------------------------------------ ' *** Purpose: Day(s) of the week that the critical update process is run ' *** ------------------------------------------------------------------------------ ' *** Public Property Get CriticalUpdateDay If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sDay ' ~~~ read value from registry, if not exist set as default sDay = RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\ScheduledInstallDay") If sDay = "" Then sDay = "0" CriticalUpdateDay = sDay End Property Public Property Let CriticalUpdateDay(iDay) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Call RegWrite("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\ScheduledInstallDay", iDay, "REG_DWORD") End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: CriticalUpdateTime ' *** ------------------------------------------------------------------------------ ' *** Purpose: Time that the critical update process is run ' *** ------------------------------------------------------------------------------ ' *** Public Property Get CriticalUpdateTime If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sTime ' ~~~ read value from registry, if not exist set as default sTime = RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\ScheduledInstallTime") If sTime = "" Then sTime = "3" CriticalUpdateTime = sTime End Property Public Property Let CriticalUpdateTime(iTime) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Call RegWrite("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\ScheduledInstallTime", iTime, "REG_DWORD") End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: OverlayCreated ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns the status of the disk overlay ' *** Property is read only ' *** ------------------------------------------------------------------------------ ' *** Public Property Get OverlayCreated If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 If bLogging Then oLog.Write "clsDiskProtect : OverlayCreated : Entry" OverlayCreated = False If bOverlayCreated then OverlayCreated = True If bLogging Then oLog.Write "clsDiskProtect : OverlayCreated : Exit" End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: OverlaySize ' *** ------------------------------------------------------------------------------ ' *** Purpose: Determines the size of the overlay to create. ' *** Can only be set before overlay has been created. ' *** ------------------------------------------------------------------------------ ' *** Public Property Get OverlaySize If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 OverlaySize = RegRead("HKLM\SYSTEM\CurrentControlSet\Services\EWF\FBA\OVSize") End Property Public Property Let OverlaySize(iSize) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ If Not(IsNumeric(iSize)) then iSize = 0 If OverlayCreated Then If bLogging Then oLog.Write "clsDiskProtect : OverlaySize() : Can not set overlay size. Overlay already created" Else If bLogging Then oLog.Write "clsDiskProtect : OverlaySize() : Overlay size set in registry" Call RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\EWF\FBA\OVSize", iSize, "REG_DWORD") End If End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: ForceOverlaySize ' *** ------------------------------------------------------------------------------ ' *** Purpose: Enables advanced scenario for configuring the size and location of the overlay. ' *** Can only be set before overlay has been created. ' *** ------------------------------------------------------------------------------ ' *** Public Property Get ForceOverlaySize If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ForceOverlaySize = RegRead(TOOLKITKEY & "SCTForceOverlay") If ForceOverlaySize = "" or ForceOverlaySize < 0 Then ForceOverlaySize = 0 End Property ' ~~~ ' ~~~ public methods ' ~~~ ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: WDPState ' *** ------------------------------------------------------------------------------ ' *** Purpose: Gets WDP State... minimizes oFso.GetFile calls ' *** ------------------------------------------------------------------------------ ' *** Public Sub WDPState If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim iTryAgain Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") bEnabled = False bOverlayCreated = False bSetLevel = False bCommit = False bNoCMD = False bEnable = False bDisable = False ' ~~~ ' ~~~ If the calling routine has not set a tool version number for the check, set it to zero. ' ~~~ This version # is used to handle concurrency issues with multiple tools using this class at the same time. ' ~~~ If IsEmpty(iWDPcmdVer) or IsNull(iWDPcmdVer) or NOT IsNumeric(iWDPcmdVer) Then iWDPcmdVer = 0 ' ~~~ Need to capture potential errors from the Run line below, and ignore oFso errors from concurrent wdp.cmd runs On Error Resume Next ' ~~~ Script blocking may cause a problem running WDP.cmd... if so, we want to do this loop again iTryAgain = 0 Do While (iTryAgain < 1) err.Clear ' ~~~ Call WDP.cmd with a numeric parameter... this will create several files for this particular tool Call oShell.Run(chr(34) & sAppDir & "bin\WDP.CMD" & chr(34) & iWDPcmdVer, 0, True) ' ~~~ If the above line returns an error, it may be because AntiSpyware has blocked WDP.CMD and Windows ' ~~~ stopped waiting for the Run to return. If this happens, we should error and exit the Sub If err.number <> 0 Then iTryAgain = iTryAgain + 1 MsgBox L_WDPblocked_TEXT, vbCritical, L_WDPblockedTitle_TEXT Else iTryAgain = 1 End If Loop If oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Enabled" & iWDPcmdVer & ".wdp").size <> 0 Then bEnabled = True If oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Overlay" & iWDPcmdVer & ".wdp").size <> 0 Then bOverlayCreated = True ' ~~~ Now check what the restart action is If oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Undo" & iWDPcmdVer & ".wdp").size <> 0 Then bSetLevel = True ElseIf oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Commit" & iWDPcmdVer & ".wdp").size <> 0 Then bCommit = True ElseIf oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Retain" & iWDPcmdVer & ".wdp").size <> 0 Then bNoCMD = True ElseIf oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Enable" & iWDPcmdVer & ".wdp").size <> 0 Then bEnable = True ElseIf oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Disable" & iWDPcmdVer & ".wdp").size <> 0 Then bDisable = True End If ' ~~~ If the debug flag isn't set, then delete these temporary files If NOT DEBUG Then oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Temp" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Enabled" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Overlay" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Undo" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Commit" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Retain" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Enable" & iWDPcmdVer & ".wdp") oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\Disable" & iWDPcmdVer & ".wdp") End If End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Enable ' *** ------------------------------------------------------------------------------ ' *** Purpose: Enable disk protection, returns true if successful ' *** ------------------------------------------------------------------------------ ' *** Public Sub Enable Dim iPossibleOverlaySize Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Enable() : Entry" ' ~~~ only enable if not already enabled If Not(Enabled) Then ' ~~~ if no valid overlay can be found; delete any invalid overlays and create a new one If Not(OverlayCreated) Then ' ~~~ delete any existing overlays Call oShell.Run(chr(34) & sAppDir & "bin\etprep.exe" & chr(34) & " -delete", 0, True) ' ~~~ create objects Set oDiskDrives = oWMIService.ExecQuery("Select * from Win32_DiskDrive") ' ~~~ if the user has not overridden the overlay size, autocalculate it iPossibleOverlaySize = CalcOVSize If (OverlaySize=0 or OverlaySize > iPossibleOverlaySize) and (ForceOverlaySize=0) Then OverlaySize = iPossibleOverlaySize If ForceOverlaySize > 0 Then OverlaySize = ForceOverlaySize ' ~~~ create the overlay If OverlaySize > 0 then ' ~~~ Copy EWF dlls to System32 so RunDll32.exe can fine them Call oFso.CopyFile(sAppDir & "bin\ewfinit.dll", oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\ewfinit.dll") Call oFso.CopyFile(sAppDir & "bin\ewfdll.dll", oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\ewfdll.dll") ' ~~~ Creates the Overlay! Call oShell.Run("rundll32.exe ewfinit.dll", 0, True) Call oShell.Run("rundll32.exe ewfdll.dll,ConfigureEwf", 0, True) If bLogging Then oLog.Write "clsDiskProtect : Overlay Creation Dlls called" ' ~~~ Delete EWF dlls from System32... they are only used to create Overlay Dim oEWFInitDLL, oEWFDllDLL ' ~~~ Remove all file attributes Set oEWFInitDLL = oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\ewfinit.dll") Set oEWFDllDLL = oFso.GetFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\ewfdll.dll") oEWFInitDLL.Attributes = 0 oEWFDllDLL.Attributes = 0 ' ~~~ Delete EWF dlls from System32 Call oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\ewfinit.dll") Call oFso.DeleteFile(oshell.ExpandEnvironmentStrings("%WinDir%") & "\system32\ewfdll.dll") ' ~~~ ------------------------------------------------------------------------------ ' ~~~ Records system install time ' ~~~ ------------------------------------------------------------------------------ Set colOperatingSystems = oWMIService.ExecQuery("Select * from Win32_OperatingSystem where Primary=true") For Each oOS in colOperatingSystems iOverlayTime = oOS.LocalDateTime Next Call RegWrite(TOOLKITKEY & "SCTOverlayTime", iOverlayTime, "REG_SZ") Call EWFService("restore") End If Else Call EWFCommand("enable") Call EWFService("restore") End If ' ~~~ if domain member then disable computer account password changes If DomainMember Then Call DisablePasswordChange(1) Else ' ~~~ already enabled If bLogging Then oLog.Write "clsDiskProtect : Disable() : Disk protection already enabled" End If ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Enable() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Disable ' *** ------------------------------------------------------------------------------ ' *** Purpose: Disable disk protection, returns true if successful ' *** ------------------------------------------------------------------------------ ' *** Public Sub Disable If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Disable() : Entry" ' ~~~ only if enabled If Enabled Then ' ~~~ call ewfmgr to disable Call EWFCommand("disable") Call EWFService("nocmd") ' ~~~ if domain member then enable computer account password changes If DomainMember Then Call DisablePasswordChange(0) ElseIF BootCommand = "ENABLE" Then ' ~~~ call ewfmgr to disable Call EWFCommand("nocmd") Call EWFService("nocmd") Else ' ~~~ not enabled If bLogging Then oLog.Write "clsDiskProtect : Disable() : Disk protection not enabled" End If ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Disable() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Commit ' *** ------------------------------------------------------------------------------ ' *** Purpose: Commits the changes made, leaving ewf in undo mode ' *** ------------------------------------------------------------------------------ ' *** Public Sub Commit If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Commit() : Entry" ' ~~~ only if enabled If Enabled Then Call EWFCommand("commit") Call EWFService("restore") ' ~~~ if computer is in a domain, we need to update the computer password If DomainMember Then If bLogging Then oLog.Write "clsDiskProtect : Commit() : Domain Member, reset computer account password" Call DisablePasswordChange(0) iReturn = oShell.Run(chr(34) & sAppDir & "bin\netdom.exe" & chr(34) & " reset %computername% /domain:%UserDomain%", 0, True) If bLogging Then oLog.Write "clsDiskProtect : Commit() : NetDom returned : " & iReturn Call DisablePasswordChange(1) End If Else ' ~~~ not enabled If bLogging Then oLog.Write "clsDiskProtect : Commit() : Disk protection not enabled" End If ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Commit() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: UndoChanges ' *** ------------------------------------------------------------------------------ ' *** Purpose: All changes are disgarded with every reboot ' *** ------------------------------------------------------------------------------ ' *** Public Sub UndoChanges If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : UndoChanges() : Entry" ' ~~~ only if enabled If Enabled Then Call EWFCommand("restore") Call EWFService("restore") Else ' ~~~ not enabled If bLogging Then oLog.Write "clsDiskProtect : UndoChanges() : Disk protection not enabled" End If ' ~~~~ write log If bLogging Then oLog.Write "clsDiskProtect : UndoChanges() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: RetainChanges(bOnce) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Changes are retained through one or many reboots ' *** ------------------------------------------------------------------------------ ' *** Public Sub RetainChanges(bOnce) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : RetainChanges() : Entry" ' ~~~ only if enabled If Enabled Then If bOnce Then Call EWFCommand("nocmd") Call EWFService("restore") Else Call EWFCommand("nocmd") Call EWFService("nocmd") End If Else ' ~~~ not enabled If bLogging Then oLog.Write "clsDiskProtect : RetainChanges() : Disk protection not enabled" End If ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : RetainChanges() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Reboot() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Forces a reboot of the computer ' *** ------------------------------------------------------------------------------ ' *** Public Sub Reboot If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : Reboot() : Entry" ' ~~~ Restart using SCT ForceLogoff Tool Call oShell.Run(chr(34) & sAppDir & "bin\ForceLogoff.exe" & chr(34) & " /Restart", 0, False) ' ~~~ write log - we might not get here If bLogging Then oLog.Write "clsDiskProtect : Reboot() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: EnableCriticalUpdates() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Enables the automated critical update process ' *** ------------------------------------------------------------------------------ ' *** Public Sub EnableCriticalUpdates() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sTime, sFreq Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : EnableCriticalUpdates() : Entry" ' ~~~ delete any existing tasks Call DeleteScheduleTask(sCmd1) Call DeleteScheduleTask(sCmd2) Call DeleteScheduleTask(sCmd3) Call oShell.Run(chr(34) & sAppDir & "bin\schtasks.exe" & chr(34) & " /Delete /TN SCTWakeUpPC /F", 0, True) ' ~~~ recreate tasks, if scripts have been populated If WindowsUpdateScript() or AVUpdateScript <> "" or OtherUpdateScript <> "" or DomainMember Then ' ~~~ get time & freq in to variables sTime = ConvertTimeAUtoAT(CriticalUpdateTime) Call RegWrite(TOOLKITKEY & "SCTRestart", sTime, "REG_SZ") If sTime = "000000" Then If CriticalUpdateDay > 1 and CriticalUpdateDay < 8 Then sFreq = ConvertDayAUtoAT(CriticalUpdateDay-1) ElseIf CriticalUpdateDay = 1 Then sFreq = ConvertDayAUtoAT(7) Else sFreq = ConvertDayAUtoAT(CriticalUpdateDay) End If Else sFreq = ConvertDayAUtoAT(CriticalUpdateDay) End If ' ~~~ create tasks Call CreateScheduleTask(sCmd1, TimePlus(sTime, 55), sFreq, True) Call CreateScheduleTask(sCmd2, TimePlus(sTime, 59), sFreq, True) sFreq = ConvertDayAUtoAT(CriticalUpdateDay) Call CreateScheduleTask(sCmd3, sTime, sFreq, True) ' ~~~ disables automatic updates & security center Call RegWrite("HKLM\Software\Policies\Microsoft\Windows\WindowsUpdate\AU\NoAutoUpdate", 1, "REG_DWORD") Call RegWrite("HKLM\Software\Microsoft\Security Center\UpdatesDisableNotify", 1, "REG_DWORD") End If ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : EnableCriticalUpdates() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DisableCriticalUpdates() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Disables the automated critical update process ' *** ------------------------------------------------------------------------------ ' *** Public Sub DisableCriticalUpdates() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : DisableCriticalUpdates() : Entry" Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") ' ~~~ delete tasks Call DeleteScheduleTask(sCmd1) Call DeleteScheduleTask(sCmd2) Call DeleteScheduleTask(sCmd3) Call oShell.Run(chr(34) & sAppDir & "bin\schtasks.exe" & chr(34) & " /Delete /TN SCTWakeUpPC /F", 0, True) ' ~~~ enable automatic updates & scrurity center Call RegWrite("HKLM\Software\Policies\Microsoft\Windows\WindowsUpdate\AU\NoAutoUpdate", 0, "REG_DWORD") Call RegWrite("HKLM\Software\Microsoft\Security Center\UpdatesDisableNotify", 0, "REG_DWORD") ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : DisableCriticalUpdates() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: CalcOVSize ' *** ------------------------------------------------------------------------------ ' *** Purpose: Return the size of the overlay to create in hex ' *** ------------------------------------------------------------------------------ ' *** Public Function CalcOVSize() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim iMaxUnallocated, iUnallocated, sPType, bFoundExtended, bUnformattedPartition, iPartitions Dim iTempPart, iExtSize, iExtFree, iUsedSpace, iBootPartitionSize, iPartitionCount, iEnd, sWindowsDrive If bLogging Then oLog.Write "clsDiskProtect : CalcOVSize()" ' ~~~ Determines what drive letter contains %WinDir% Set colOperatingSystems = oWMIService.ExecQuery("Select * from Win32_OperatingSystem where Primary=true") For Each oOS in colOperatingSystems If oOS.SystemDevice = oOS.BootDevice then Call RegWrite(TOOLKITKEY & "SystemBootSame", "True", "REG_SZ") Else Call RegWrite(TOOLKITKEY & "SystemBootSame", "False", "REG_SZ") End If sWindowsDrive = Left(oOS.WindowsDirectory,2) Next ' ~~~ Determines what physical disk and physical partition contains %WinDir% iDiskID = 0 iPartID = 1 Set oDiskDrives = oWMIService.ExecQuery("Select * from Win32_DiskDrive") For Each oDisk in oDiskDrives sEscapedDeviceID = Replace(oDisk.DeviceID, "\", "\\", 1, -1, vbTextCompare) Set oDiskPartitions = oWMIService.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & sEscapedDeviceID & """} WHERE AssocClass = Win32_DiskDriveToDiskPartition") For Each oPartition in oDiskPartitions iTempPart = Right(oPartition.DeviceID,1) + 1 Set oLogicalDisks = oWMIService.ExecQuery("ASSOCIATORS OF" & "{Win32_DiskPartition.DeviceID=""" & oPartition.DeviceID & """} WHERE AssocClass = Win32_LogicalDiskToPartition") ' ~~~ Collection of logical drives defined on the disk For Each oLogicalDisk In oLogicalDisks If oLogicalDisk.Name = sWindowsDrive then If IsNumeric(Right(oDisk.Name, 1)) then iDiskID = Int(Right(oDisk.Name, 1)) iPartID = iTempPart End If End If Next Next Next ' ~~~ REG_MULTI_SZ *not* supported by RegWrite method - DO NOT CHANGE! sCMD = "REG ADD HKLM\SYSTEM\CurrentControlSet\Services\EWF\FBA /f /v PVDisk /t REG_MULTI_SZ /d " & iDiskID Call oShell.Run(sCMD, 0, True) sCMD = "REG ADD HKLM\SYSTEM\CurrentControlSet\Services\EWF\FBA /f /v PVPart /t REG_MULTI_SZ /d " & iPartID Call oShell.Run(sCMD, 0, True) CalcOVSize = 0 iBootPartitionSize = 0 iUnallocated = 0 iMaxUnallocated = 0 iExtFree = 0 iExtSize = 0 iUsedSpace = 0 iPartitionCount = 0 bFoundExtended = False ' ~~~ loop through all the disk drives For Each oDisk in oDiskDrives If oDisk.Index = iDiskID Then iPartitions = oDisk.Partitions ' ~~~ new disk, reset the end pointer iEnd = 0 sPType = "" ' ~~~ get partitions associated with this disk, we need to escape the device id for the query to work sEscapedDeviceID = Replace(oDisk.DeviceID, "\", "\\", 1, -1, vbTextCompare) Set oDiskPartitions = oWMIService.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & sEscapedDeviceID & """} WHERE AssocClass = Win32_DiskDriveToDiskPartition") ' ~~~ loop through all the partitions on this disk For Each oPartition in oDiskPartitions ' ~~~ Count partitions on disk iPartitionCount = iPartitionCount + 1 ' ~~~ Determines Size of Boot Partition If oPartition.BootPartition = True or iPartID = iPartitionCount Then iBootPartitionSize = Int(oPartition.size/1024) End If ' ~~~ Determines if System and Boot Partition are one and the same ' ~~~ ignore extended partitions If sPType <> "Extended w/Extended Int 13" and sPType <> "Extended Partition" Then If oPartition.Index <> 0 Then ' ~~~ calculate the unallocated space before this partition iUnallocated = CDbl(oPartition.StartingOffset) - iEnd If iMaxUnallocated < iUnallocated Then iMaxUnallocated = iUnallocated End If Else bFoundExtended = True End If ' ~~~ Notes partition type (Primary or Extended)... do *NOT* move this up! ' ~~~ Moving this line up will affect functionality when last partition is extended. sPType = oPartition.Type iEnd = CDbl(oPartition.StartingOffset) + CDbl(oPartition.Size) Next ' ~~~ determines if last partition is an Extended Partition If sPType = "Extended w/Extended Int 13" or sPType = "Extended Partition" Then bFoundExtended = True ' ~~~ calculate the unallocated space after the last partition iUnallocated = CDbl(oDisk.Size) - iEnd If iMaxUnallocated < iUnallocated Then iMaxUnallocated = iUnallocated If iPartitionCount = 4 Then iMaxUnallocated = 0 End If Next ' ~~~ Calculate Free Space in Extended Partition If bfoundExtended = True then iPartitionCount = 0 bUnformattedPartition = False For Each oPartition in oDiskPartitions iPartitionCount = iPartitionCount + 1 ' ~~~ Enter only if the partition is extended partition If oPartition.type = "Extended w/Extended Int 13" or oPartition.type = "Extended Partition" Then iPartitionCount = iPartitionCount - 1 ' ~~~ store the total size of the extended partition iExtsize = oPartition.size ' ~~~ Use partition device id to find logical disk Set oLogicalDisks = oWMIService.ExecQuery("ASSOCIATORS OF" & "{Win32_DiskPartition.DeviceID=""" & oPartition.DeviceID & """} WHERE AssocClass = Win32_LogicalDiskToPartition") ' ~~~ Collection of logical drives in the extended partition For Each oLogicalDisk In oLogicalDisks iPartitionCount = iPartitionCount + 1 If Not(IsNull(oLogicalDisk.size)) then iUsedSpace = iUsedSpace + oLogicalDisk.size Else bUnformattedPartition = True End If Next End If iExtFree = iExtsize - iUsedSpace Next If iPartitionCount < iPartitions or bUnformattedPartition then iMaxUnallocated = 0 iExtFree = 0 End If End If ' ~~~ Clean up Set oDiskPartitions = Nothing Set oDiskDrives = Nothing ' ~~~ return the largest unallocated/Extended Free space If iMaxUnallocated > iExtFree then CalcOVSize = Int(iMaxUnallocated/1024)-1024 Else CalcOVSize = Int(iExtFree/1024)-25600 End If ' ~~~ Set to 0 if size req not met If (CalcOVSize < 1022976) or (IsNull(CalcOVSize)) then CalcOVSize = 0 ' ~~~ Ensures Overlay is not larger than Boot Partition, so as not to be wasteful If (CalcOVSize > iBootPartitionSize) and (iBootPartitionSize <> 0) then CalcOVSize = iBootPartitionSize End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DefineATCommands ' *** ------------------------------------------------------------------------------ ' *** Purpose: Defines AT commands created for WDP ' *** ------------------------------------------------------------------------------ ' *** Public Function DefineATCommands() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") ' ~~~ define schedule task commands globally because they are used by two methods sCmd1 = "wscript """ & sAppDir & "bin\banner.wsf" & Chr(34) & " /Restart" sCmd2 = "wscript """ & sAppDir & "bin\banner.wsf""" sCmd3 = "wscript """ & sAppDir & "scripts\CriticalUpdates.wsf" & Chr(34) & " /Update /PreventLogin /Restart" End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: CreateScheduleTask(sCmd, sTime, sDay, bInteractive) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Schedule a task using AT ' *** ------------------------------------------------------------------------------ ' *** Public Function CreateScheduleTask(sCmd, sTime, sDay, bInteractive) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sATCmd, ScheduleTask, sTimeZone, strComputer, oNewJob, errJobCreated, jobId ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : CreateScheduleTask() : Entry" ' ~~~ ------------------------------------------------------------------------------ ' ~~~ Records system install time ' ~~~ ------------------------------------------------------------------------------ Set colOperatingSystems = oWMIService.ExecQuery("Select * from Win32_OperatingSystem where Primary=true") For Each oOS in colOperatingSystems sTimeZone = oOS.LocalDateTime Next sTimeZone = Right(sTimeZone,4) Set oNewJob = oWMIService.Get("Win32_ScheduledJob") Select Case sDay Case 1 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 1, , bInteractive, JobId) Case 2 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 2, , bInteractive, JobId) Case 4 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 4, , bInteractive, JobId) Case 8 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 8, , bInteractive, JobId) Case 16 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 16, , bInteractive, JobId) Case 32 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 32, , bInteractive, JobId) Case 64 errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 64, , bInteractive, JobId) Case Else errJobCreated = oNewJob.Create(sCmd, "********" & sTime & ".000000" & sTimeZone, True , 1 or 2 or 4 or 8 or 16 or 32 or 64, , bInteractive, JobId) End Select ' ~~~ return result If errJobCreated <> 0 Then ScheduleTask = False Else ScheduleTask = True End If ' ~~~ Destroy Objects Set oNewJob = nothing ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : CreateScheduleTask() : Exit" End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DeleteScheduleTask() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Delete AT commands created for WDP ' *** ------------------------------------------------------------------------------ ' *** Public Sub DeleteScheduleTask(sTempCmd) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim oScheduledJobs, oJob ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : DeleteScheduleTask() : Entry" ' ~~~ use wmi to delete task Set oScheduledJobs = oWMIService.ExecQuery("Select * from Win32_ScheduledJob") For Each oJob in oScheduledJobs If oJob.Command = sTempCmd Then oJob.Delete Next If bLogging Then oLog.Write "clsDiskProtect : DeleteScheduleTask() : Delete Tasks - " & sTempCmd ' ~~~ write log If bLogging Then oLog.Write "clsDiskProtect : DeleteScheduleTask() : Exit" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: SystemBootSame ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns true System and Boot Partition are one and the same ' *** ------------------------------------------------------------------------------ ' *** Public Function SystemBootSame() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 If RegRead(TOOLKITKEY & "SystemBootSame") = "True" Then SystemBootSame = True Else SystemBootSame = False End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: GetHibernation ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns true if hibernation is enabled or returns false ' *** ------------------------------------------------------------------------------ ' *** Public Function GetHibernation() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim systemDir systemDir = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%") systemDir = Left(systemDir,2) If oFso.FileExists(systemDir & "\HIBERFIL.sys") Then ' ~~~ if hiberfil.sys exists, hibernation is enabled GetHibernation = True Else ' ~~~ if hiberfil.sys does not exist, hibernation is not enabled GetHibernation = False End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: GetStashUpperFilterKey ' *** ------------------------------------------------------------------------------ ' *** Purpose: Reads in UpperFilter key... record it in TOOLKITKEY ' *** ------------------------------------------------------------------------------ ' *** Public Sub GetStashUpperFilterKey ' ~~~ Read and record UpperFilters key in SCT registry sUpperFilter = RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Class\{71A27CDD-812A-11D0-BEC7-08002BE2092F}\UpperFilters") Call RegWrite(TOOLKITKEY & "WDPUpperFilterKey", sUpperFilter, "REG_SZ") End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: WriteUpperFilterKey ' *** ------------------------------------------------------------------------------ ' *** Purpose: Writes to UpperFilter key... updates SCTInstallTime ' *** ------------------------------------------------------------------------------ ' *** Public Sub WriteUpperFilterKey ' ~~~ Read and record UpperFilters key in SCT registry Call RegWrite("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{71A27CDD-812A-11D0-BEC7-08002BE2092F}\UpperFilters", arrUpperFilters, "REG_MULTI_SZ") Call RegWrite(TOOLKITKEY & "SCTInstallTime", iLocalDateTime, "REG_SZ") End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: UpperFilterCheck(sList) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Checks the UpperFilter registry key for incompatible filters ' *** ------------------------------------------------------------------------------ ' *** Public Function UpperFilterCheck(sList) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sUpperFilterName Dim oXml, ufXml, oProduct, oProdChildNode Select Case sList Case "BlackList" ufXml = GetRootFolder & "\xml\UpperFilterCheckBlack.xml" Set oXml = CreateObject("MSXML2.DomDocument") Call oXml.Load(ufXml) bBlackList = False If oXml.parseError.errorCode = 0 Then ' ~~~ Loop through each of the UpperFilters For Each oProduct in oXml.getElementsByTagName("Product") ' ~~~ Get the values of each product For Each oProdChildNode in oProduct.ChildNodes Select Case oProdChildNode.NodeName Case "Name" sUpperFilterName = oProdChildNode.Text End Select If InStr(UCase(sUpperFilter), ","&UCase(sUpperFilterName)&",") > 0 Then bBlackList = True End If Next Next End If Case "WhiteList" ufXml = GetRootFolder & "\xml\UpperFilterCheckWhite.xml" Set oXml = CreateObject("MSXML2.DomDocument") Call oXml.Load(ufXml) If oXml.parseError.errorCode = 0 Then ' ~~~ Loop through each of the UpperFilters bWhiteList = False arrTempArray = Split(sUpperFilter, ",") For i = LBound(arrTempArray) to UBound(arrTempArray) For Each oProduct in oXml.getElementsByTagName("Product") ' ~~~ Get the values of each product For Each oProdChildNode in oProduct.ChildNodes Select Case oProdChildNode.NodeName Case "Name" sUpperFilterName = oProdChildNode.Text End Select If arrTempArray(i+1) <> "" Then If (UCase(sUpperFilterName) = UCase(arrTempArray(i+1))) Then bWhiteList = True Exit For Else bWhiteList = False End If End If Next If Not(bWhiteList) Then Exit For Next If Not(bWhiteList) Then Exit For Next End If End Select End Function ' ~~~ ' ~~~ private methods ' ~~~ ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Class_Initialize ' *** ------------------------------------------------------------------------------ ' *** Purpose: Used internally by the class when it is created. ' *** Declared as private because it must not be called directly. ' *** ------------------------------------------------------------------------------ ' *** Private Sub Class_Initialize If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ set default values for properties bLogging = False Call WDPState Call DefineATCommands End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Class_Terminate ' *** ------------------------------------------------------------------------------ ' *** Purpose: Used internally by the class when it is destroyed. ' *** Declared as private because it must not be called directly. ' *** ------------------------------------------------------------------------------ ' *** Private Sub Class_Terminate If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: EWFCommand(sCmd) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Runs the specified EWF Command ' *** ------------------------------------------------------------------------------ ' *** Private Sub EWFCommand(sCmd) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") If bLogging Then oLog.Write "clsDiskProtect : EWFCommand(" & sCmd & ")" Call oShell.Run(chr(34) & sAppDir & "bin\ewfmgr.exe" & chr(34) & " " & Left(oshell.ExpandEnvironmentStrings("%WinDir%"),2) & " -" & sCmd, 0,True) End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: EWFService(sCmd) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Sets the service to run the EWF command on next reboot ' *** ------------------------------------------------------------------------------ ' *** Private Sub EWFService(sCmd) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sAppDir ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file. sAppDir = RegRead(TOOLKITKEY & "TargetDir") If bLogging Then oLog.Write "clsDiskProtect : EWFService(" & sCmd & ")" Call RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\WDPOperations\Parameters\Application", chr(34) & sAppDir & "bin\ewfmgr.exe" & chr(34) & " " & Left(oshell.ExpandEnvironmentStrings("%WinDir%"),2) & " -" & sCmd, "REG_SZ") End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DisablePasswordChange(iDisable) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Enables or disables computer domain account passwords ' *** iDisable = Integer, 1 = disabled, 0 = enabled ' *** ------------------------------------------------------------------------------ ' *** Private Sub DisablePasswordChange(iDisable) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 If bLogging Then oLog.Write "clsDiskProtect : DisablePasswordChange(" & iDisable & ")" Call RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\Netlogon\Parameters\DisablePasswordChange", iDisable, "REG_DWORD") End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: ConvertDayAUtoAT ' *** ------------------------------------------------------------------------------ ' *** Purpose: Converts an Automatic Updates day of the week to something that the ' *** AT command will understand ' *** ------------------------------------------------------------------------------ ' *** Private Function ConvertDayAUtoAT(iD) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Select Case iD Case 2 ConvertDayAUtoAT = "1" Case 3 ConvertDayAUtoAT = "2" Case 4 ConvertDayAUtoAT = "4" Case 5 ConvertDayAUtoAT = "8" Case 6 ConvertDayAUtoAT = "16" Case 7 ConvertDayAUtoAT = "32" Case 1 ConvertDayAUtoAT = "64" Case Else ConvertDayAUtoAT = "1248163264" End Select End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: ConvertTimeAUtoAT ' *** ------------------------------------------------------------------------------ ' *** Purpose: Converts an Automatic Updates time to something that the ' *** AT command will understand ' *** ------------------------------------------------------------------------------ ' *** Private Function ConvertTimeAUtoAT(iT) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Select Case iT Case 1 ConvertTimeAUtoAT = "010000" Case 2 ConvertTimeAUtoAT = "020000" Case 3 ConvertTimeAUtoAT = "030000" Case 4 ConvertTimeAUtoAT = "040000" Case 5 ConvertTimeAUtoAT = "050000" Case 6 ConvertTimeAUtoAT = "060000" Case 7 ConvertTimeAUtoAT = "070000" Case 8 ConvertTimeAUtoAT = "080000" Case 9 ConvertTimeAUtoAT = "090000" Case 10 ConvertTimeAUtoAT = "100000" Case 11 ConvertTimeAUtoAT = "110000" Case 12 ConvertTimeAUtoAT = "120000" Case 13 ConvertTimeAUtoAT = "130000" Case 14 ConvertTimeAUtoAT = "140000" Case 15 ConvertTimeAUtoAT = "150000" Case 16 ConvertTimeAUtoAT = "160000" Case 17 ConvertTimeAUtoAT = "170000" Case 18 ConvertTimeAUtoAT = "180000" Case 19 ConvertTimeAUtoAT = "190000" Case 20 ConvertTimeAUtoAT = "200000" Case 21 ConvertTimeAUtoAT = "210000" Case 22 ConvertTimeAUtoAT = "220000" Case 23 ConvertTimeAUtoAT = "230000" Case Else ConvertTimeAUtoAT = "000000" End Select End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: TimePlus(sTime, iMins) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Calculates the proper WDP AT command times ' *** ------------------------------------------------------------------------------ ' *** Private Function TimePlus(sTime, iMins) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sTempTime ' ~~~ Handles 12:00 AM (sTime = 000000) If Left(sTime,2) > 0 Then sTempTime = Right(sTime,5) - 10000 ' ~~~ Handles 10:00 AM & 8:00 PM (sTime = 100000 or 200000) If sTempTime < 0 Then If Left(sTime,1) = 1 Then TimePlus = "09" & iMins & Right(sTime, 2) ElseIf Left(sTime,1) = 2 Then TimePlus = "19" & iMins & Right(sTime, 2) End If Else TimePlus = Left(sTime, 1) & Left(sTempTime,1) & iMins & Right(sTime, 2) End If Else TimePlus = "23" & iMins & Right(sTime, 2) End If End Function End Class 
