Const ACTEXEC_CMD_ABORTSCAN = "abortscan"
Const ACTEXEC_CMD_APPLY_CCSETTS = "apply_cc_settings"
Const ACTEXEC_CMD_SCAN = "scan"
Const ACTEXEC_CMD_START_AMSERVICE = "start_service"
Const ACTEXEC_CMD_UNKNOWN = "unknown command"
Const ACTEXEC_CMD_UPDATE = "update"
Const AM_POLICY_BLOCKALL_INBOUND_TRAFFIC = "BlockAllInboundTraffic"
Const AM_POLICY_DEFAULTINBOUND_ACTION_ISDENY = "DefaultInboundActionIsDeny"
Const AM_POLICY_DISABLEBEHAVIOUR = "DisableBehaviorMonitoring"
Const AM_POLICY_DISABLEINBOUND_NOTIFICATIONS = "DisableInboundNotifications"
Const AM_POLICY_DISABLEONACCESSPROTECTION = "DisableOnAccessProtection"
Const AM_POLICY_DISABLERTM = "DisableRealtimeMonitoring"
Const AM_POLICY_DISABLESCRIPTSCANNING = "DisableScriptScanning"
Const AM_POLICY_DISABLE_IPS = "DisableIntrusionPreventionSystem"
Const AM_POLICY_ENABLEFIREWALL = "EnableFirewall"
Const AM_POLICY_REGKEY_ROOT = "SOFTWARE\Policies\Microsoft\Microsoft Antimalware"
Const AM_POLICY_RTSDIRECTION = "RealTimeScanDirection"
Const AM_POLICY_SIGNATURE_UPD_CATCHUP_INTERVAL = "SignatureUpdateCatchupInterval"
Const AM_POLICY_SIGNATURE_UPD_INTERVAL = "SignatureUpdateInterval"
Const AM_REGKEY_CLIENT_INSTKEY = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Microsoft Security Client"
Const AM_REGKEY_EXCLUDED_EXTS = "\Exclusions\Extensions"
Const AM_REGKEY_EXCLUDED_PATHS = "\Exclusions\Paths"
Const AM_REGKEY_EXCLUDED_PROCESSES = "\Exclusions\Processes"
Const AM_REGKEY_FULL_SIGNATURE_UPDATES = "SOFTWARE\Policies\Microsoft\Microsoft Antimalware\Signature Updates"
Const AM_REGKEY_POLICY_RTP = "SOFTWARE\Policies\Microsoft\Microsoft Antimalware\Real-Time Protection"
Const AM_REGKEY_ROOT = "SOFTWARE\Microsoft\Microsoft Antimalware"
Const AM_REGKEY_SCAN = "\Scan"
Const AM_REGKEY_SIGNATURE_UPDATES = "\Signature Updates"
Const AM_REGKEY_SIG_UPDATES_POLICY = "SOFTWARE\Policies\Microsoft\Microsoft Antimalware\Signature Updates"
Const AM_REGVALUE_CLIENT_CONFIGPOLICY = "ConfigSecurityPolicy.exe"
Const AM_REGVALUE_CLIENT_INSTDATE = "InstallDate"
Const AM_REGVALUE_CLIENT_INSTLOCATION = "InstallLocation"
Const AM_REGVALUE_CLIENT_MPCMDRUN = "MpCmdRun.exe"
Const AM_REGVALUE_CLIENT_NAME = "DisplayName"
Const AM_REGVALUE_CLIENT_VERSION = "DisplayVersion"
Const AM_REGVALUE_SCANPARAMETERS = "ScanParameters"
Const AM_REGVALUE_SCHEDULEDAY = "ScheduleDay"
Const AM_REGVALUE_SCHEDULETIME = "ScheduleTime"
Const AM_REGVALUE_SCHEDULE_QUICK_SCAN_TIME = "ScheduleQuickScanTime"
Const AM_REGVALUE_SIGNATURE_DOWNLOAD_LOC = "FallbackOrder"
Const AM_RTPSTATUS_OFF = "Off"
Const AM_RTPSTATUS_ON = "On"
Const AM_RTS_DIRECTION_BOTH = "Both incoming and outgoing"
Const AM_RTS_DIRECTION_INCOMING = "Incoming"
Const AM_RTS_DIRECTION_OUTCOMING = "Outgoing"
Const AM_RTS_DIRECTION_UNKNOWN = "Unknown"
Const AM_SERVICE_NAME = "MsMpSvc"
Const AM_STATUS_DISABLED = "Disabled"
Const AM_STATUS_ENABLED = "Enabled"
Const AM_WMI_HEALTH_STATUS_QUERY = "Select * from AntimalwareHealthStatus"
Const AM_WMI_INFECT_STATUS_QUERY = "SELECT * FROM AntimalwareInfectionStatus"
Const AM_WMI_NAMESPACE = "winmgmts:\\.\root\Microsoft\SecurityClient"
Const CIMV2_WMI_NAMESPACE = "winmgmts:\\.\root\cimv2"
Const CLIENT_REGKEY_ROOT = "SOFTWARE\Microsoft\Microsoft Security Client"
Const DEPLOY_FAILED_HRESULT_CANCEL = "0x8004FF0A"
Const DEPLOY_FAILED_HRESULT_RESTART = "0x0004FF00"
Const DEPLOY_FAILED_HRESULT_RESTART2 = "0x8004FF25"
Const DEPLOY_FAILED_HRESULT_SUCCESS = "0x00000000"
Const DEPLOY_FAILED_MONITOR_CRITICAL = 3
Const DEPLOY_FAILED_MONITOR_HEALTHY = 1
Const DEPLOY_FAILED_MONITOR_WARNING = 2
Const DEPLOY_FAIL_ERROR_CODE_NAME = "DeploymentErrorCode"
Const DEPLOY_FAIL_INFO_NAME = "DeploymentInfo"
Const DEPLOY_FAIL_RESULT_NAME = "DeploymentResult"
Const DEPLOY_FAIL_STATE_NAME = "DeploymentState"
Const EVTLOG_MW_DETECTION_WMI_QUERY = "Select * from Win32_NTLogEvent WHERE Logfile = 'System' AND SourceName='Microsoft Antimalware' AND (EventCode='1119' OR EventCode='1118' OR EventCode='1117')"
Const FAILED_POLICY_DATE_REGKEY = "LastFailedToApplyPolicyTimeUTC"
Const FAILED_POLICY_ERR_DESC_REGKEY = "LastPolicyErrorMessage"
Const FAILED_POLICY_NAME_REGKEY = "LastFailedToApplyPolicy"
Const FEP_DEPLOYMENT_REBOOT_IS_NOT_REQUIRED = "No"
Const FEP_DEPLOYMENT_REBOOT_IS_REQUIRED = "Yes"
Const FEP_DEPLOY_ERROR_FILE_NAME = "EppSetupResult.ini"
Const FEP_DEPLOY_STATUS_FAILED = "Installation Failed"
Const FEP_DEPLOY_STATUS_INSTALLED = "Installed"
Const FEP_DEPLOY_STATUS_NO_INSTALL_DETECTED = "Never Installed"
Const FEP_DEPLOY_STATUS_REBOOT_REQUIRED = "Restart Required"
Const FEP_DEPLOY_STATUS_UNINSTALLED = "Uninstalled"
Const FEP_DEPLOY_STATUS_USER_CANCELED = "User Canceled Installation"
Const FEP_SUPPRT_DIR_PATH = "%ProgramData%\Microsoft\Microsoft Security Client\Support"
Const FEP_SUPPRT_XP_DIR_PATH = "%ALLUSERSPROFILE%\Application Data\Microsoft\Microsoft Security Client\Support"
Const FULL_SCAN = "Full scan"
Const FW_GENERIC_QUERY = "Select * from "
Const FW_POLICY_CLASS_PROF_DOMAIN = "Firewall_Profile_Domain"
Const FW_POLICY_CLASS_PROF_PRIVATE = "Firewall_Profile_Private"
Const FW_POLICY_CLASS_PROF_PUBLIC = "Firewall_Profile_Public"
Const FW_REGKEY_ROOT = "Root\Microsoft\PolicyPlatform\WindowsFirewallConfiguration"
Const FW_STATUS_OFF = "Off"
Const FW_STATUS_ON = "On"
Const FW_STATUS_UNINSTALLED = "Uninstalled"
Const FW_WMI_NAMESPACE = "winmgmts:{impersonationLevel=impersonate}!\\.\Root\Microsoft\PolicyPlatform\WindowsFirewallConfiguration"
Const FW_WMI_QUERY = "Select * from FirewallState"
Const LOG_REGKEY = "SOFTWARE\Microsoft\FEPS\Log"
Const LOG_REGVALUE_ENABLED = "Enabled"
Const LOG_SUBFOLDER_NAME = "FEP 2010 Security MP"
Const MPCMDRUN_CMD_FULLSCAN = " -scan -scantype 2"
Const MPCMDRUN_CMD_QUICKSCAN = " -scan -scantype 1"
Const MPCMDRUN_CMD_SIGUPDATE = " -SignatureUpdate"
Const NIS_STATUS_NOT_SUPPORTED = "Not Supported"
Const NIS_STATUS_NOT_UNKNOWN = "Unknown"
Const NIS_STATUS_OFF = "Off"
Const NIS_STATUS_ON = "On"
Const OS_REGKEY_ARCHITECTURE = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
Const OS_REGVALUE_ARCHITECTURE = "PROCESSOR_ARCHITECTURE"
Const POLICY_DATE_REGKEY = "LastSuccessfullyAppliedPolicyTimeUTC"
Const POLICY_LOCAL_SETTINGS_OVERRIDE_PREFIX = "LocalSettingOverride"
Const POLICY_NAME = "SCOM applied FEP-S Policy"
Const POLICY_NAME_REGKEY = "LastSuccessfullyAppliedPolicy"
Const POLICY_SECTION_AM = "FEP.AmPolicy"
Const POLICY_SECTION_FW = "FEP.HostFirewallPolicy"
Const QUICK_SCAN = "Quick scan"
Const REG_VALUE_APPLIED_POLICY = "LastSuccessfullyAppliedPolicy"
Const REG_WMICLASS_PROVIDERNAME = "StdRegProv"
Const REG_WMI_NAMESPACE = "root\default"
Const RETRIEVAL_TITLE_ANTIMALWARE_ENGINE = "Antimalware Engine"
Const RETRIEVAL_TITLE_ANTISPYWARE_DEFINITIONS_AGE = "Antispyware Definitions Age (days)"
Const RETRIEVAL_TITLE_ANTISPYWARE_DEFINITIONS_VERSION = "Antispyware Definitions Version"
Const RETRIEVAL_TITLE_ANTISPYWARE_DEFINITIONS__DATE = "Antispyware Definitions Creation (GMT)"
Const RETRIEVAL_TITLE_ANTIVIRUS_DEFINITIONS_AGE = "Antivirus Definitions Age (days)"
Const RETRIEVAL_TITLE_ANTIVIRUS_DEFINITIONS_DATE = "Antivirus Definitions Creation (GMT)"
Const RETRIEVAL_TITLE_ANTIVIRUS_DEFINITIONS_VERSION = "Antivirus Definitions Version"
Const RETRIEVAL_TITLE_CLIENT_VERSION = "Client Version"
Const RETRIEVAL_TITLE_DOWNLOAD_LOCATION = "Definitions Download Location"
Const RETRIEVAL_TITLE_EXCLUDED_EXTENTIONS = "Excluded Extensions"
Const RETRIEVAL_TITLE_EXCLUDED_FOLDERS = "Excluded Folders"
Const RETRIEVAL_TITLE_EXCLUDED_PROCESSES = "Excluded Processes"
Const RETRIEVAL_TITLE_FAILED_POLICY_DATE = "Failed Policy Date"
Const RETRIEVAL_TITLE_FAILED_POLICY_DETAIL = "Policy Failure Details"
Const RETRIEVAL_TITLE_FAILED_POLICY_NAME = "Failed Policy Name"
Const RETRIEVAL_TITLE_FIREWALL = "Windows Firewall"
Const RETRIEVAL_TITLE_FULL_AGE = "Last Full Scan Age (days)"
Const RETRIEVAL_TITLE_FULL_END = "Last Full Scan End (GMT)"
Const RETRIEVAL_TITLE_FULL_START = "Last Full Scan Start (GMT)"
Const RETRIEVAL_TITLE_NIS = "NIS"
Const RETRIEVAL_TITLE_NIS_DEFINITIONS_VERSION = "NIS Definitions Version"
Const RETRIEVAL_TITLE_POLICY_DATE = "Policy Date"
Const RETRIEVAL_TITLE_POLICY_NAME = "Policy Name"
Const RETRIEVAL_TITLE_QUICK_AGE = "Last Quick Scan Age (days)"
Const RETRIEVAL_TITLE_QUICK_END = "Last Quick Scan End (GMT)"
Const RETRIEVAL_TITLE_QUICK_START = "Last Quick Scan Start (GMT)"
Const RETRIEVAL_TITLE_RTP = "Real-time Protection"
Const RETRIEVAL_TITLE_RTP_DIRECTION = "Real-time Protection Scan Direction"
Const RETRIEVAL_TITLE_SCAN_SCHDULE = "Scan schedule"
Const RETRIEVAL_TITLE_UPDATE_SCHEDULE = "Antimalware definitions update schedule"
Const SCHEDULE_DAILY = "Daily"
Const SCHEDULE_SCAN_SCHEDULE_STRING = "{0} around {1} ({2})"
Const SCHEDULE_SCAN_SCHEDULE_WITH_QUICK_STRING = "{0} around {1} ({2}); Quick scan daily around {3}"
Const SCHEDULE_UNDEFINED = "undefined"
Const TASK_ERROR_ABORT_SCAN_FAILED = "The Stop Scan task has failed. Error (0x{1:X}) {2}. Unable to stop the scan running by the process ID {0}. Log on to the computer and confirm that the FEP2010 client is installed and operating properly."
Const TASK_ERROR_APPLY_SETTINGS = "The task has failed to change settings. Error 0x{0:x}. Log on to the computer and confirm that the FEP2010 client is installed and operating properly, and then change settings locally."
Const TASK_ERROR_NOT_LSA = "This task must be run using a Local System account."
Const TASK_ERROR_NOT_SUPPORTED = "This FEP2010 client version is not supported."
Const TASK_ERROR_OPERATION_FAILED = "The task has failed. Error 0x{0:x}."
Const TASK_ERROR_SCAN_ABORTED = "The scan was stopped."
Const TASK_ERROR_SCAN_FAILED = "The Scan task has failed. Error 0x{0:X}. Log on to the computer and confirm that the FEP2010 client is installed and operating properly, and then launch a scan locally."
Const TASK_ERROR_SCAN_IN_PROGRESS = "A scan is already in progress."
Const TASK_ERROR_START_SERVICE = "The Enable Real-time Protection task has failed. Log on to the computer and confirm that the FEP2010 client is installed and operating properly, and then start the service locally."
Const TASK_ERROR_UPDATE_ERROR = "The Update Antimalware Definitions task has failed. Error 0x{0:X}. Log on to the computer and attempt to run the update locally. If updates fail, verify that WSUS is running and that the client computer has connectivity to Windows Update."
Const TASK_ERROR_UPDATE_ERROR_FOR_OPTION = "The Update Antimalware Definitions task with option {0} has failed. Error 0x{1:X}."
Const TASK_WARNING_ABORT_SCAN_NO_SCAN = "There is no scan in progress."
Const WIN32OS_WMI_QUERY = "select * from Win32_OperatingSystem"
Const WIN32PROCSTUP_WMICLASS_PROVIDERNAME = "Win32_ProcessStartup"
Const WIN32PROC_BYID_WMI_QUERY = "Select * from Win32_Process Where ID = {0}"
Const WIN32PROC_BYNAME_WMI_QUERY = "Select * from Win32_Process Where Name = '{0}'"
Const WIN32PROC_WMICLASS_PROVIDERNAME = "Win32_Process"
Const WIN32PROC_WMI_NAMESPACE = "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"
Const WIN32SERV_BYNAME_WMI_QUERY = "Select * from Win32_Service Where Name = '{0}'"
Dim g_strAMRegKey
Dim g_strClientInstallationRegKey
Dim g_strClientRootRegKey
Dim g_strAMPolicyRegKey
Dim g_strAMRegValue
Dim g_strAMScanTool
Dim g_strCSPTool
Dim g_strClientSupportDirPath
Dim g_strClientXPSupportDirPath
' This is the minimum version for Tasks
const C_MinVersionSupported = "2.0.457.0"
If Err.Number <> 0 Then
g_objLog.WriteLog "UTCTimeToDate", LOG_ERROR, "Wrong format of data"
UTCTimeToDate = Null
Exit Function
Err.Clear
End If
End Function
Function CommonClientTimeToDate(strDateTime)
Dim objDate, strTmpDate
' Format of the input string: "20100429" meaning 29/04/2010
On Error Resume Next
If IsNull(strDateTime) or IsEmpty(strDateTime) Then
strDateTime = ""
End If
If Len(strDateTime) <> 8 Then
CommonClientTimeToDate = Null
Exit Function
End If
' Check that this is a valid date
strTmpDate = Left(strDateTime, 6) + "-" + Right(strDateTime, 2)
strTmpDate = Left(strTmpDate, 4) + "-" + Right(strTmpDate, 5)
objDate = CDate(strTmpDate)
If Err.Number <> 0 Then
g_objLog.WriteLog "CommonClientTimeToDate", LOG_ERROR, "Wrong format of data"
CommonClientTimeToDate = Null
Exit Function
Err.Clear
End If
' Get the date right
CommonClientTimeToDate = Right(strDateTime, 2) + "/" + Mid(strDateTime, 5, 2) + "/" + Left(strDateTime, 4)
End Function
Function IsError(value)
If Err.Number <> 0 Or TypeName(value) = "Nothing" Or TypeName(value) = "Null" Then
IsError = True
Else
IsError = False
End If
End Function
Function IsOS64Bit()
Dim strOSArchitecture
strOSArchitecture = GetOSArchitecture()
If Not IsNull(strOSArchitecture) Then
If InStr(strOSArchitecture, "64") <> 0 Then
IsOS64Bit = True
Else
IsOS64Bit = False
End If
Else
IsOS64Bit = Null
End If
End Function
Function IsStringHollow(strVal)
If Not IsNull(strVal) and (strVal <> "") and Not IsEmpty (strVal) and (strVal <> "-1") Then
IsStringHollow = false
Else
IsStringHollow = true
End If
End Function
Function GetValidStringValue(strVal)
' Empty string is not accepted by SCOM as part of the discovery, it will throw away the entire discovery and nothing will be shown in SCOM.
' If we won't fill out at all the fields we do not have a value for them, SCOM will keep the old discovered value which will cause wrong information to be shown in the UI.
' Only possibility is to fill out a white space to "delete" the old value by an empty space.
If Not IsStringHollow(strVal) Then
GetValidStringValue = strVal
Else
GetValidStringValue = " "
End If
End Function
Function GetValidDateString(dateVal)
If Not IsNull(dateVal) And TypeName(dateVal) = "Date" Then
GetValidDateString = CStr(dateVal)
Else
GetValidDateString = " "
End If
End Function
Function GetValidNumberValue(nValue, nDefault)
If IsNull(nValue) Or Not IsNumeric(nValue) Or Len(nValue) = 0 Then
GetValidNumberValue = nDefault
Else
GetValidNumberValue = CInt(nValue)
End If
End Function
Function GetOSArchitecture()
Dim strArchitecture
strArchitecture = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", OS_REGKEY_ARCHITECTURE, OS_REGVALUE_ARCHITECTURE, "String", False)
If IsNull(strArchitecture) Then
g_objLog.WriteLog "GetOSArchitecture", LOG_FATALERROR, "Cannot retrieve OS architecture"
End If
GetOSArchitecture = strArchitecture
End Function
Class OSInfo
Public m_strName
Public m_strVersion
Public m_strServicePack
Public m_iProductType ' 1- Desktop, 2 - DC, 3 - Server
Public m_strBuildNumber
End Class
Function GetWindowsInfo()
On Error Resume Next
Dim strComputername, objWMIService, objQrySetting, objOS, objOSInfo
strComputername = "." ' Local computer
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputername & "\root\cimv2")
If Err.Number <> 0 Then
Set GetWindowsInfo = Null
g_objLog.WriteLog "GetWindowsInfo", LOG_ERROR, "Cannot create WMI error=" + CStr(Err.Number)
Err.Clear
Exit Function
End If
Set objQrySetting = objWMIService.ExecQuery(WIN32OS_WMI_QUERY)
If Not IsObject(objQrySetting) Then
Set GetWindowsInfo = Null
g_objLog.WriteLog "GetWindowsInfo", LOG_ERROR, "Error query execution:" + CStr(Err.Number)
Err.Clear
Exit Function
End If
Set objOSInfo = new OSInfo
For Each objOS In objQrySetting
If Not IsObject(objOS) Then
Set GetWindowsInfo = Null
g_objLog.WriteLog "GetWindowsInfo", LOG_ERROR, "Error query execution:" + CStr(Err.Number)
Err.Clear
Exit Function
End If
If Not IsObject(objOSInfo) Then
GetOS = Null
g_objLog.WriteLog "GetOS", LOG_ERROR, "invalid object:" + CStr(Err.Number)
Err.Clear
Exit Function
End If
Dim verArray, osMajorVersion
verArray = Split(objOSInfo.m_strVersion, ".", -1, 1)
osMajorVersion = verArray(0) + "." + verArray(1)
If (objOSInfo.m_iProductType = "3") Then
' 3 is server OS
If (osMajorVersion = "6.1") Then
GetOS = Windows_2008R2
ElseIf (osMajorVersion = "6.0") Then
GetOS = Windows_2008
ElseIf (osMajorVersion = "5.2") Then
GetOS = Windows_2003
Else
GetOS = Null
End If
ElseIf (objOSInfo.m_iProductType = "1") Then
' 1 is desktop OS
If (osMajorVersion = "6.1") Then
GetOS = Windows_Windows7
ElseIf (osMajorVersion = "6.0") Then
GetOS = Windows_Vista
ElseIf ((osMajorVersion = "5.1") or (osMajorVersion = "5.2")) Then
GetOS = Windows_XP
Else
GetOS = Null
End If
Else
GetOS = Null
End If
Private Function CreateWMIRegProvider(bIs64Bit)
Dim objReg, objCtx, objLocator, objServices
On Error Resume Next
Err.Clear
Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
If Err.Number <> 0 Then
g_objLog.WriteLog "CreateWMIRegProvider", LOG_ERROR, "Cannot create object WbemScripting.SWbemNamedValueSet, error=" + CStr(Err.Number)
CreateWMIRegProvider = Null
Err.Clear
Exit Function
End If
If bIs64Bit Then
objCtx.Add "__ProviderArchitecture", 64
Else
objCtx.Add "__ProviderArchitecture", 32
End If
Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
If Err.Number <> 0 Then
g_objLog.WriteLog "CreateWMIRegProvider", LOG_ERROR, "Cannot create object WbemScripting.SWbemLocator, error=" + CStr(Err.Number)
CreateWMIRegProvider = Null
Err.Clear
Exit Function
End If
Set objServices = objLocator.ConnectServer("", REG_WMI_NAMESPACE,"","",,,,objCtx)
Set objReg = objServices.Get(REG_WMICLASS_PROVIDERNAME)
If Err.Number = 0 Then
Set CreateWMIRegProvider = objReg
Else
g_objLog.WriteLog "CreateWMIRegProvider", LOG_ERROR, "Cannot create WMI registry provider, error=" + CStr(Err.Number)
Set CreateWMIRegProvider = Null
Err.Clear
End If
End Function
Private Function DecodeHive(strHive)
Dim lHive
If strHive = "HKEY_CLASSES_ROOT" Then
lHive = HKEY_CLASSES_ROOT
ElseIf strHive = "HKEY_CURRENT_USER" Then
lHive = HKEY_CURRENT_USER
ElseIf strHive = "HKEY_LOCAL_MACHINE" Then
lHive = HKEY_LOCAL_MACHINE
ElseIf strHive = "HKEY_USERS" Then
lHive = HKEY_USERS
ElseIf strHive = "HKEY_CURRENT_CONFIG" Then
lHive = HKEY_CURRENT_CONFIG
Else
g_objLog.WriteLog "DecodeHive", LOG_ERROR, "Can't decode hive value " + strHive
lHive = Null
End If
DecodeHive = lHive
End Function
Private Function ReadEnumRegistryValue(strHive, strKey, strValueType, bIs64Bit)
Dim objReg, lHive, iValue, strWholeValue, strValue, strValueName, dwValue, abValue(), astrValue(), arrValueNames, arrValueTypes, i
Const C_Delimiter = ";"
On Error Resume Next
Err.Clear
lHive = DecodeHive(strHive)
If IsNull(lHive) Then
ReadEnumRegistryValue = Null
Exit Function
End If
Set objReg = CreateWMIRegProvider(bIs64Bit)
If IsNull(objReg) Then
ReadEnumRegistryValue = Null
Exit Function
End If
strWholeValue = ""
objReg.EnumValues lHive, strKey, arrValueNames, arrValueTypes
If Err.Number <> 0 Then
g_objLog.WriteLog "ReadEnumRegistryValue", LOG_ERROR, "Cannot enumerate registry key: " + strKey
ReadEnumRegistryValue = Null
Err.Clear
Exit Function
End If
If IsNull(arrValueNames) Or IsNull(arrValueTypes) Then
ReadEnumRegistryValue = strWholeValue
Exit Function
End If
For i=0 To UBound(arrValueNames)
strValueName = arrValueNames(i)
If strValueType = "*" Then
AddToDelimitedString strWholeValue, strValueName, C_Delimiter
Else
Select Case arrValueTypes(i)
Case REG_SZ
If strValueType = "String" Then
objReg.GetStringValue lHive,strKey,strValueName,strValue
If Err.Number <> 0 Then
g_objLog.WriteLog "ReadEnumRegistryValue", LOG_ERROR, "Cannot read registry key: " + strKey + ", value name: " + strValueName + ", type: " + strValueType
ReadEnumRegistryValue = Null
Err.Clear
Exit Function
End If
AddToDelimitedString strWholeValue, strValueName, C_Delimiter
End If
Case REG_DWORD
If strValueType = "DWORD" Then
objReg.GetDWORDValue lHive,strKey,strValueName,strValue
If Err.Number <> 0 Then
g_objLog.WriteLog "ReadEnumRegistryValue", LOG_ERROR, "Cannot read registry key: " + strKey + ", value name: " + strValueName + ", type: " + strValueType
ReadEnumRegistryValue = Null
Err.Clear
Exit Function
End If
AddToDelimitedString strWholeValue, strValueName, C_Delimiter
End If
End Select
End If
Next
ReadEnumRegistryValue = strWholeValue
End Function
Private Function ReadRegistryValue(strHive, strKey, strValueName, strValueType, bIs64Bit)
Dim objReg, lHive, strComputer, strValue, dwValue, abValue(), astrValue(), dwError
On Error Resume Next
Const ERROR_ACCESS_DENIED = 5 ' The only error code that will be translated as an error for logging
Err.Clear
If strValueName = "*" Then
ReadRegistryValue = ReadEnumRegistryValue(strHive, strKey, strValueType, bIs64Bit)
Exit Function
End If
lHive = DecodeHive(strHive)
If IsNull(lHive) Then
ReadRegistryValue = Null
Exit Function
End If
Set objReg = CreateWMIRegProvider(bIs64Bit)
If IsNull(objReg) Then
ReadRegistryValue = Null
Exit Function
End If
ReadRegistryValue = Null
If strValueType = "String" Then
dwError = objReg.GetStringValue( lHive,strKey,strValueName,strValue )
If dwError <> 0 Then
g_objLog.WriteLog "ReadRegistryValue", ConditionHelper(ERROR_ACCESS_DENIED=dwError, LOG_ERROR, LOG_INFO), FormatString4("Cannot read registry key: {0}, value name: {1}, type: {2}, error: {3}", strKey, strValueName, strValueType, dwError)
ReadRegistryValue = Null
Err.Clear
Exit Function
End If
ElseIf strValueType = "MultiString" Then
dwError = objReg.GetMultiStringValue( lHive,strKey,strValueName,astrValue )
If dwError <> 0 Then
g_objLog.WriteLog "ReadRegistryValue", ConditionHelper(ERROR_ACCESS_DENIED=dwError, LOG_ERROR, LOG_INFO), FormatString4("Cannot read registry key: {0}, value name: {1}, type: {2}, error: {3}", strKey, strValueName, strValueType, dwError)
ReadRegistryValue = Null
Err.Clear
Exit Function
End If
If Not IsNull(astrValue) Then
strValue = astrValue
Else
strValue = Null
End If
ElseIf strValueType = "ExpandedString" Then
dwError = objReg.GetExpandedStringValue( lHive,strKey,strValueName,strValue )
If dwError <> 0 Then
g_objLog.WriteLog "ReadRegistryValue", ConditionHelper(ERROR_ACCESS_DENIED=dwError, LOG_ERROR, LOG_INFO), FormatString4("Cannot read registry key: {0}, value name: {1}, type: {2}, error: {3}", strKey, strValueName, strValueType, dwError)
ReadRegistryValue = Null
Err.Clear
Exit Function
End If
ElseIf strValueType = "DWORD" Then
dwError = objReg.GetDWORDValue( lHive,strKey,strValueName,dwValue )
If dwError <> 0 Then
g_objLog.WriteLog "ReadRegistryValue", ConditionHelper(ERROR_ACCESS_DENIED=dwError, LOG_ERROR, LOG_INFO), FormatString4("Cannot read registry key: {0}, value name: {1}, type: {2}, error: {3}", strKey, strValueName, strValueType, dwError)
ReadRegistryValue = Null
Err.Clear
Exit Function
End If
If Not IsNull(dwValue) Then
strValue = CLng(dwValue)
Else
strValue = Null
End If
ElseIf strValueType = "QWORD" Then
dwError = objReg.GetQWORDValue( lHive,strKey,strValueName,dwValue )
If dwError <> 0 Then
g_objLog.WriteLog "ReadRegistryValue", ConditionHelper(ERROR_ACCESS_DENIED=dwError, LOG_ERROR, LOG_INFO), FormatString4("Cannot read registry key: {0}, value name: {1}, type: {2}, error: {3}", strKey, strValueName, strValueType, dwError)
ReadRegistryValue = Null
Err.Clear
Exit Function
End If
If Not IsNull(dwValue) Then
strValue = CStr(dwValue)
Else
strValue = Null
End If
ElseIf strValueType = "Binary" Then
dwError = objReg.GetBinaryValue( lHive,strKey,strValueName,abValue )
If dwError <> 0 Then
g_objLog.WriteLog "ReadRegistryValue", ConditionHelper(ERROR_ACCESS_DENIED=dwError, LOG_ERROR, LOG_INFO), FormatString4("Cannot read registry key: {0}, value name: {1}, type: {2}, error: {3}", strKey, strValueName, strValueType, dwError)
ReadRegistryValue = Null
Err.Clear
Exit Function
End If
If Not IsNull(abValue) Then
strValue = abValue
Else
strValue = Null
End If
Else
strValue = Null
End If
If Err.Number = 0 Then
ReadRegistryValue = strValue
Else
ReadRegistryValue = Null
Err.Clear
End If
End Function
Public Function ReadValue(strHive, strKey, strValueName, strValueType, bIs64Bit)
ReadValue = ReadRegistryValue(strHive, strKey, strValueName, strValueType,bIs64Bit)
End Function
Public Sub WriteValue(strHive, strKey, strValueName, strValueData, strValueType, bIs64Bit)
Dim objReg, lHive
Set objReg = CreateWMIRegProvider(bIs64Bit)
lHive = DecodeHive(strHive)
If IsNull(lHive) Then
g_objLog.WriteLog "WriteValue", LOG_ERROR, "Cannot decode a hive name: " + strHive
Exit Sub
End If
If strValueType = "String" Then
objReg.SetStringValue lHive,strKey,strValueName,strValueData
If Err.Number <> 0 Then
g_objLog.WriteLog "WriteValue", LOG_ERROR, "Cannot write registry key: " + strKey + ", value name: " + strValueName + ", type: " + strValueType
Exit Sub
End If
ElseIf strValueType = "DWORD" Then
objReg.SetDWORDValue lHive,strKey,strValueName,strValueData
If Err.Number <> 0 Then
g_objLog.WriteLog "WriteValue", LOG_ERROR, "Cannot write registry key: " + strKey + ", value name: " + strValueName + ", type: " + strValueType
Exit Sub
End If
Else
Err.Raise 87, "CRegistry", "Unsupported type: " + strValueType, "", ""
End If
End Sub
Function DeleteValue(strHive, strKey, strValueName, bIs64Bit)
Dim objReg, lHive
Set objReg = CreateWMIRegProvider(bIs64Bit)
lHive = DecodeHive(strHive)
If IsNull(lHive) Then
g_objLog.WriteLog "DeleteValue", LOG_ERROR, "Cannot decode a hive name: " + strHive
DeleteValue = 87 ' Invalid parameter
Exit Function
End If
DeleteValue = objReg.DeleteValue(lHive,strKey,strValueName)
End Function
End Class
iEnabled = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", strRootRegKey, LOG_REGVALUE_ENABLED, "DWORD", g_bIs64Bit)
If Not IsNull(iEnabled) Then
If iEnabled = 1 Then
m_bEnabled = True
End If
End If
m_iMaxLogSize = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", strRootRegKey, "max_size", "DWORD", g_bIs64Bit)
If IsNull(m_iMaxLogSize) Then
m_iMaxLogSize = 1000000
Else
m_iMaxLogSize = m_iMaxLogSize
End If
If m_bEnabled = True Then
InitializeScriptingAPI()
Set m_objFSO = CreateObject("Scripting.FileSystemObject")
If Err.Number <> 0 Then
g_objLog.WriteLog "CLog.Init", LOG_ERROR, "Cannot initialize"
Init = False
Err.Clear
Exit Function
End If
If m_objFSO.FileExists(m_strFName) Then
Set objLogFile = m_objFSO.GetFile(m_strFName)
If Err.Number <> 0 Then
g_objLog.WriteLog "CLog.Init", LOG_ERROR, "Cannot get log file"
Init = False
Err.Clear
Exit Function
End If
If objLogFile.Size > m_iMaxLogSize Then
m_objFSO.DeleteFile m_strFName
End If
If Err.Number <> 0 Then
g_objLog.WriteLog "CLog.Init", LOG_ERROR, "Cannot delete file"
Init = False
Err.Clear
Exit Function
End If
End If
End If
Function InitializeScriptingAPI()
On Error Resume Next
Err.Clear
Set m_objAPI = CreateObject("MOM.ScriptAPI")
If Err.Number = 0 Then
m_bAPIEnabled = True
Else
Err.Clear
m_bAPIEnabled = False
End If
End Function
Public Function IsFatalErrorIssued()
IsFatalErrorIssued = m_bIsFatalErrorIssued
End Function
Public Sub WriteLog(strFuncName, iSeverity, strMessage)
Dim objShell, strFmtMessage, strErrSeverityMessage, iLogSeverity, strEntityMsg
Dim iEffort, strTime
If m_bAPIEnabled Then 'Write to ops manager log as well
m_objAPI.LogScriptEvent "Forefront Endpoint Protection", 1000, iLogSeverity, strFmtMessage
End If
End If
End Sub
Public Function SaveLogToDisk()
On Error Resume Next
Dim objTextFile
Dim iEffort
If m_bEnabled = False Then
Exit Function
End If
SaveLogToDisk = False
For iEffort = 0 To m_iEffortCount
If Not m_objFSO.FolderExists(m_strLogLocation) Then
m_objFSO.CreateFolder m_strLogLocation
End If
Err.Clear
Set objTextFile = m_objFSO.OpenTextFile (m_strFName, 8, True, 0)
If Err.Number = 0 Then
objTextFile.WriteLine(m_strMessageBuffer)
objTextFile.Close
If Err.Number = 0 Then
SaveLogToDisk = True
Exit For
End If
End If
Next
End Function
End Class
Const SW_HIDE = 0
Class CWmiProcess
Private m_bIsInitialized
Private m_objWMIService
Public Sub Class_Initialize
m_bIsInitialized = False
Set m_objWMIService = GetObject(WIN32PROC_WMI_NAMESPACE)
If Err.Number <> 0 Then
g_objLog.WriteLog "CWmiProcess::Class_Initialize", LOG_ERROR, "Cannot create object WScript.Shell, error=" + CStr(Err.Number)
Err.Clear
Exit Sub
End If
m_bIsInitialized = True
End Sub
Public Function Execute(strCmdLine, bWaitExit, dwTimeout)
Const WBEM_S_TIMEDOUT = &H40004
Const WBEM_PROCESS_CREATE_INVALID_PARAMETER = 21
Dim strProcessName, dwExitCode, objProcess, objStartup, objConfig, intProcessID
On Error Resume Next
Err.Clear
If Not m_bIsInitialized Then
Execute = WBEM_PROCESS_CREATE_INVALID_PARAMETER
Exit Function
End If
Set objStartup = m_objWMIService.Get(WIN32PROCSTUP_WMICLASS_PROVIDERNAME)
Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = SW_HIDE
Set objProcess = m_objWMIService.Get("Win32_Process")
Execute = objProcess.Create(strCmdLine, Null, objConfig, intProcessID)
If Execute <> 0 Then
g_objLog.WriteLog "CWmiProcess::Execute", LOG_ERROR, "Cannot create process, error=" + Execute
Err.Clear
Exit Function
End If
If Not bWaitExit Then
Exit Function
End If
Do While DoesProcessRunByID(intProcessID) And dwTimeout > 0
WScript.Sleep 1
dwTimeout = dwTimeout - 1
Loop
If DoesProcessRunByID(intProcessID) Then
g_objLog.WriteLog "CWmiProcess::Execute", LOG_ERROR, "TimeOut exceeded"
Execute = WBEM_S_TIMEDOUT ' Play with WMI's agenda
Err.Clear
Exit Function
End If
End Function
Public Function GetProcess(strProcessName)
Dim objProcess, objcolProcess
On Error Resume Next
Err.Clear
If Not m_bIsInitialized Then
Set GetProcess = Nothing
Exit Function
End If
Set objcolProcess = m_objWMIService.ExecQuery (FormatString1(WIN32PROC_BYNAME_WMI_QUERY, strProcessName))
Set GetProcess = objcolProcess
If Err.Number <> 0 Then
g_objLog.WriteLog "CWmiProcess::GetProcess", LOG_ERROR, "Cannot enumerate processes, error=" + CStr(Err.Number)
Err.Clear
Exit Function
End If
End Function
Public Function GetProcessByID(intProcessID)
Dim objProcess, objcolProcess
On Error Resume Next
Err.Clear
If Not m_bIsInitialized Then
Set GetProcessByID = Nothing
Exit Function
End If
Set objcolProcess = m_objWMIService.ExecQuery _
(WIN32PROC_BYID_WMI_QUERY, CStr(intProcessID))
Set GetProcessByID = objcolProcess
If Err.Number <> 0 Then
g_objLog.WriteLog "CWmiProcess::GetProcessByID", LOG_ERROR, "Cannot enumerate processes, error=" + CStr(Err.Number)
Err.Clear
Exit Function
End If
End Function
Public Function DoesProcessRunByID(intProcessID)
On Error Resume Next
Err.Clear
Dim objProcess, objcolProcess
If Not m_bIsInitialized Then
DoesProcessRunByID = False
Exit Function
End If
Set objcolProcess = GetProcessByID(intProcessID)
If IsError(objcolProcess) Then
DoesProcessRunByID = False
Exit Function
End If
For Each objProcess In objcolProcess
DoesProcessRunByID = True
Next
If Err.Number <> 0 Then
g_objLog.WriteLog "CWmiProcess::DoesProcessRunByID", LOG_ERROR, "DoesProcessRunByID failed, error=" + CStr(Err.Number)
DoesProcessRunByID = False
Err.Clear
End If
End Function
Public Function KillProcess(strProcessName)
On Error Resume Next
Dim objProcess, objcolProcess
If Not m_bIsInitialized Then
KillProcess = False
Exit Function
End If
Set objcolProcess = GetProcess(strProcessName)
If IsError(objcolProcess) Then
g_objLog.WriteLog "CWmiProcess::DoesProcessRun", LOG_WARNING, "processes doesn't run:" + strProcessName
KillProcess = False
Exit Function
End If
For Each objProcess In objcolProcess
objProcess.Terminate()
Next
If Err.Number <> 0 Then
g_objLog.WriteLog "CWmiProcess::KillProcess", LOG_ERROR, "KillProcess failed, error=" + CStr(Err.Number)
KillProcess = False
Err.Clear
Exit Function
End If
KillProcess = True
End Function
End Class
' Partial simulation of String.Format method
' Supports {n}, {n:x} and {n:X} where n is a place holder for the paramter position number
Function FormatString1(strFormat, param1)
FormatString1 = FormatString(strFormat, Array(param1))
End Function
Function FormatString2(strFormat, param1, param2)
FormatString2 = FormatString(strFormat, Array(param1, param2))
End Function
Function FormatString3(strFormat, param1, param2, param3)
FormatString3 = FormatString(strFormat, Array(param1, param2, param3))
End Function
Function FormatString4(strFormat, param1, param2, param3, param4)
FormatString4 = FormatString(strFormat, Array(param1, param2, param3, param4))
End Function
Function FormatString5(strFormat, param1, param2, param3, param4, param5)
FormatString5 = FormatString(strFormat, Array(param1, param2, param3, param4, param5))
End Function
' Most generic version which accepts Array
Function FormatString(strFormat, arrayParams)
Dim param, i
FormatString = strFormat
i = 0
For Each param in arrayParams
Dim paramToOutput
If IsNull(param) Then
paramToOutput = "null"
Else
paramToOutput = param
End If
If TypeName(param)="Byte" Or TypeName(param)="Integer" Or TypeName(param)="Long" Or TypeName(param)="Decimal" Then
' Try x formating
FormatString = Replace(FormatString, "{" & CStr(i) & ":x}", LCase(Hex(paramToOutput)), 1, -1, vbBinaryCompare)
' Try X formating (Hex returns upper case string by default)
FormatString = Replace(FormatString, "{" & CStr(i) & ":X}", Hex(paramToOutput), 1, -1, vbBinaryCompare)
End If
FormatString = Replace(FormatString, "{" & CStr(i) & "}", CStr(paramToOutput), 1, -1, vbTextCompare)
i = i + 1
Next
End Function
Function IsVersionSupported(strMinVersion, strVersion)
Dim aMinVer, aVer, cMinVer, cVer, cMin, i
If strMinVersion = strVersion Then
IsVersionSupported = True
End If
If IsNull(strMinVersion) Or IsNull(strVersion) Or Len(strMinVersion)=0 Or Len(strVersion)=0 Then
IsVersionSupported = False
End If
aMinVer = Split(strMinVersion,".")
aVer = Split(strVersion,".")
cMinVer = UBound(aMinVer)
cVer = UBound(aVer)
If cVer>cMinVer Then
cMin = cMinVer
Else
cMin = cVer
End If
For i=0 To cMin
If aMinVer(i)<aVer(i) Then
Exit For
End If
If aMinVer(i)>aVer(i) Then
IsVersionSupported = False
Exit Function
End If
Next
If cVer>=cMinVer Then
IsVersionSupported = True
Exit Function
End If
If cVer<cMinVer Then
For i=cMin+1 To cMinVer
If aMinVer(i) <> 0 Then
IsVersionSupported = False
Exit Function
End If
Next
IsVersionSupported = True
Exit Function
End If
IsVersionSupported = False
End Function
Function ConditionHelper(cond, op1, op2)
If cond Then
ConditionHelper = op1
Else
ConditionHelper = op2
End If
End Function
Sub AddToDelimitedString(ByRef strDelimitedString, strNewValue, strDelimiter)
If Len(strDelimitedString) > 0 Then
strDelimitedString = strDelimitedString & strDelimiter
End If
strDelimitedString = strDelimitedString & strNewValue
End Sub
const FEP_POLICYTYPE_NORMAL = 0
const FEP_POLICYTYPE_OVERRIDEABLE = 1
Class CFepPolicy
Public m_strParameterName
Public m_strValue
Public m_nPolicyType
End Class
Function Create_Policy(m_strParameterName)
Set Create_Policy = New CFepPolicy
Create_Policy.m_strParameterName = m_strParameterName
Create_Policy.m_strValue = Empty
Create_Policy.m_nPolicyType = FEP_POLICYTYPE_NORMAL
End Function
Function Create_PolicyEx(m_strParameterName, nPolicyType)
Set Create_PolicyEx = Create_Policy(m_strParameterName)
Create_PolicyEx.m_nPolicyType = nPolicyType
End Function
Class CFepWmiPolicyClass
Public m_strClass
Public m_strInstanceIdentifier
Public m_aPolicies
Public Function GetXML
Dim strXML
strXML = ""
' Enumerate all policies
Dim Policy
For Each Policy in m_aPolicies
If Not IsEmpty(Policy.m_strValue) And Not IsNull(Policy.m_strValue) Then
strXML = strXML & String(6," ") & "<SetProperty Name=""" & _
Policy.m_strParameterName & """>" & Policy.m_strValue & "</SetProperty>" & vbCrLf
End If
Next
If Len(strXML) Then
If Not IsWindowsXPor2003() Or m_strClass <> "Firewall_Profile_Public" Then
GetXML = String(4," ") & "<Class Name=""" & m_strClass & """>" & vbCrLf & _
String(5," ") & "<Instance Identifier=""" & m_strInstanceIdentifier & """>" & vbCrLf & strXML & _
String(5," ") & "</Instance>" & vbCrLf & _
String(4," ") & "</Class>" & vbCrLf
End If
Else
GetXML = ""
End If
End Function
End Class
Function IsWindowsXPor2003()
IsWindowsXPor2003 = false
Dim objOSInfo
Set objOSInfo = GetWindowsInfo()
If Not IsObject(objOSInfo) Then
g_objLog.WriteLog "IsWindowsXPor2003", LOG_ERROR, "cannot retieve OS Info. Error: " + CStr(Err.Number)
Err.Clear
Exit Function
End If
Dim strOSVersion
strOSVersion = GetOS(objOSInfo)
If ((strOSVersion = Windows_XP) or (strOSVersion = Windows_2003)) Then
IsWindowsXPor2003 = True
End If
End Function
Function Create_WmiPolicyClass(m_strClass, m_strInstanceIdentifier, m_aPolicies)
Set Create_WmiPolicyClass = New CFepWmiPolicyClass
Create_WmiPolicyClass.m_strClass = m_strClass
Create_WmiPolicyClass.m_strInstanceIdentifier = m_strInstanceIdentifier
Create_WmiPolicyClass.m_aPolicies = m_aPolicies
End Function
Class CFepWmiPolicy
Public m_strNameSpace
Public m_aWmiClasses
Public Function GetXML
Dim strXML
strXML = ""
' Enumerate all WMI policy classes
Dim PolicyClass
Dim PolicyXML
For Each PolicyClass in m_aWmiClasses
PolicyXML = PolicyClass.GetXML
If Len(PolicyXML)>0 Then
strXML = strXML & PolicyXML
End If
Next
If Len(strXML) Then
GetXML = String(3," ") & "<Namespace Name=""" & m_strNameSpace & """>" & vbCrLf & _
strXML & _
String(3," ") & "</Namespace>" & vbCrLf
Else
GetXML = ""
End If
End Function
End Class
Function Create_WmiPolicy(m_strNameSpace, m_aWmiClasses)
Set Create_WmiPolicy = New CFepWmiPolicy
Create_WmiPolicy.m_strNameSpace = m_strNameSpace
Create_WmiPolicy.m_aWmiClasses = m_aWmiClasses
End Function
' Three override states (used by CFepRegistryPolicy)
' 1. Already in override mode
' 2. Should be in override mode (add override value to the XML)
' 3. No overrides
Const OVERRIDE_MODE_ALREADY = 1
Const OVERRIDE_MODE_SHOULDBE = 2
Const OVERRIDE_MODE_NONE = 3
Class CFepRegistryPolicy
Public m_strKeyName
Public m_aPolicies
Function GetOverrideMode(Policy)
GetOverrideMode = OVERRIDE_MODE_NONE
If Policy.m_nPolicyType = FEP_POLICYTYPE_OVERRIDEABLE Then
' Check for the policy value existence
Dim dwPolicyValue, dwPolicyOverrideValue
dwPolicyValue = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", m_strKeyName, Policy.m_strParameterName, "DWORD", g_bIs64Bit)
dwPolicyOverrideValue = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", m_strKeyName, _
POLICY_LOCAL_SETTINGS_OVERRIDE_PREFIX & Policy.m_strParameterName, "DWORD", g_bIs64Bit)
If IsNull(dwPolicyOverrideValue) Then
If IsNull(dwPolicyValue) Then
GetOverrideMode = OVERRIDE_MODE_SHOULDBE
End If
ElseIf dwPolicyOverrideValue = 1 Then
GetOverrideMode = OVERRIDE_MODE_ALREADY
End If
End If
End Function
Public Function GetXML
Dim strXML
strXML = ""
' Enumerate all policies
Dim Policy
For Each Policy in m_aPolicies
If Not IsEmpty(Policy.m_strValue) And Not IsNull(Policy.m_strValue) Then
Dim PolicyOverride
PolicyOverride = GetOverrideMode(Policy)
' Currently we support only REG_DWORD policies
strXML = strXML & String(4," ") & "<AddValue Name=""" & Policy.m_strParameterName
strXML = strXML & """ Type=""REG_DWORD"">" & Policy.m_strValue & "</AddValue>" & vbCrLf
' Add override policy if needed
If PolicyOverride = OVERRIDE_MODE_SHOULDBE Then
strXML = strXML & String(4," ") & "<AddValue Name=""" & POLICY_LOCAL_SETTINGS_OVERRIDE_PREFIX & Policy.m_strParameterName
strXML = strXML & """ Type=""REG_DWORD"">1</AddValue>" & vbCrLf
End If
' Delete local setting if necessary (to allow fallback to overrideable policy)
If PolicyOverride <> OVERRIDE_MODE_NONE Then
Dim dwResult
dwResult = g_objRegistry.DeleteValue("HKEY_LOCAL_MACHINE", Replace(m_strKeyName, "\Policies\", "\", 1, -1, vbTextCompare), Policy.m_strParameterName, g_bIs64Bit)
If dwResult <> 0 Then
g_objLog.WriteLog "DeleteValue", LOG_ERROR, "Cannot delete local settings for: " + Policy.m_strParameterName
End If
If dwResult = 5 Then
' It may happen only if action account is not LSA
Err.Raise dwResult
End if
End If
End If
Next
If Len(strXML) Then
GetXML = String(3," ") & "<AddKey Name=""" & m_strKeyName & """>" & vbCrLf & strXML & String(3," ") & _
"</AddKey>" & vbCrLf
Else
GetXML = ""
End If
End Function
End Class
Function Create_RegistryPolicy(m_strKeyName, m_aPolicies)
Set Create_RegistryPolicy = New CFepRegistryPolicy
Create_RegistryPolicy.m_strKeyName = m_strKeyName
Create_RegistryPolicy.m_aPolicies = m_aPolicies
End Function
Class CFepPolicySection
Public m_strName
Public m_aPolicyClasses
Public Function GetXML
Dim strRegistryXML
Dim strWmiXML
Dim bIsRegPolicyExist
strRegistryXML = ""
strWmiXML = ""
bIsRegPolicyExist = False
' Enumerate all policy classes
Dim PolicyClass
Dim PolicyXML
For Each PolicyClass in m_aPolicyClasses
PolicyXML = PolicyClass.GetXML
If TypeName(PolicyClass)="CFepRegistryPolicy" Then
bIsRegPolicyExist = True
End If
If Len(PolicyXML)<>0 Then
If TypeName(PolicyClass)="CFepRegistryPolicy" Then
strRegistryXML = strRegistryXML & PolicyXML
Else
strWmiXML = strWmiXML & PolicyXML
End If
End If
Next
If Len(strRegistryXML)>0 Then
strRegistryXML = String(2," ") & "<LocalGroupPolicySettings>" & vbCrLf &_
strRegistryXML & String(2," ") & "</LocalGroupPolicySettings>" & vbCrLf
End If
If Len(strWmiXML)>0 Then
strWmiXML = String(2," ") & "<WmiPropertySettings>" & vbCrLf & strWmiXML &_
String(2," ") & "</WmiPropertySettings>" & vbCrLf
End If
If Len(strWmiXML)>0 Or Len(strRegistryXML)>0 Or bIsRegPolicyExist Then
GetXML = String(1," ") & "<PolicySection Name=""" & m_strName & """>" & vbCrLf &_
strRegistryXML & strWmiXML & String(1," ") & "</PolicySection>" & vbCrLf
Else
GetXML = ""
End If
End Function
End Class
Class CFepSecurityPolicy
Public m_aPolicySections
Public Function GetXML
Dim strXML
strXML = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf
strXML = strXML & "<SecurityPolicy xmlns=""http://forefront.microsoft.com/FEP/2010/01/PolicyData"">" & vbCrLf
' Enumerate all policy sections
Dim PolicySection
Dim PolicyXML
Dim bEmpty
bEmpty = True
For Each PolicySection in m_aPolicySections
PolicyXML = PolicySection.GetXML
If Len(PolicyXML)<>0 Then
strXML = strXML & PolicyXML
bEmpty = False
End If
Next
If bEmpty Then
GetXML = ""
Else
GetXML = strXML & "</SecurityPolicy>"
End If
End Function
Public Function EnumPolicies
Dim PolicySection
Dim i
Dim Count
Dim Policies()
' On the first iteration (i) we count the number of policies and allocate the array.
' On the second we fill the array
' Policies may repeat (e.g. in case of firewall), but it does not impact the logic correctness
For i=0 To 1
Count = 0
For Each PolicySection in m_aPolicySections
Dim PolicyClass
For Each PolicyClass in PolicySection.m_aPolicyClasses
Dim Policy
If TypeName(PolicyClass)="CFepRegistryPolicy" Then
For Each Policy in PolicyClass.m_aPolicies
If i=1 Then
Set Policies(Count) = Policy
End If
Count = Count + 1
Next
Else
Dim WmiClass
For Each WmiClass in PolicyClass.m_aWmiClasses
For Each Policy in WmiClass.m_aPolicies
If i=1 Then
Set Policies(Count) = Policy
End If
Count = Count + 1
Next
Next
End If
Next
Next
If i=0 Then
ReDim Policies(Count-1)
End If
Next
EnumPolicies = Policies
End Function
End Class
Class FepPolicyManager
Private m_SecurityPolicy
' Adding support for new policies should be added to the next Sub
Sub Class_Initialize
Dim FepAMPolicySection, FepHostFirewallPolicySection, aFwPolicies
Set FepAMPolicySection = New CFepPolicySection
FepAMPolicySection.m_strName = POLICY_SECTION_AM
FepAMPolicySection.m_aPolicyClasses = Array(_
Create_RegistryPolicy(AM_REGKEY_POLICY_RTP ,_
Array(Create_PolicyEx(AM_POLICY_DISABLERTM, FEP_POLICYTYPE_OVERRIDEABLE),_
Create_PolicyEx(AM_POLICY_RTSDIRECTION, FEP_POLICYTYPE_OVERRIDEABLE),_
Create_Policy(AM_POLICY_DISABLESCRIPTSCANNING),_
Create_Policy(AM_POLICY_DISABLEONACCESSPROTECTION),_
Create_Policy(AM_POLICY_DISABLEBEHAVIOUR),_
Create_PolicyEx(AM_POLICY_DISABLE_IPS, FEP_POLICYTYPE_OVERRIDEABLE))),_
Create_RegistryPolicy(AM_REGKEY_SIG_UPDATES_POLICY,_
Array(Create_Policy(AM_POLICY_SIGNATURE_UPD_INTERVAL),_
Create_Policy(AM_POLICY_SIGNATURE_UPD_CATCHUP_INTERVAL)))_
)
Set FepHostFirewallPolicySection = New CFepPolicySection
' Currently all policies are chosen by registry value name or WMI property name
' If different policies will have the same name it will be a problem
' Currently there is only one case (FW policies) which is OK, because we work with all
' profiles at once.
aFwPolicies = Array(Create_Policy(AM_POLICY_ENABLEFIREWALL), _
Create_Policy(AM_POLICY_BLOCKALL_INBOUND_TRAFFIC), _
Create_Policy(AM_POLICY_DEFAULTINBOUND_ACTION_ISDENY), _
Create_Policy(AM_POLICY_DISABLEINBOUND_NOTIFICATIONS))
Set m_SecurityPolicy = New CFepSecurityPolicy
m_SecurityPolicy.m_aPolicySections = Array(FepAMPolicySection, FepHostFirewallPolicySection)
End Sub
Public Function SetPolicies(strPolicies)
' Delete extra spaces
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "\s+"
strPolicies = regEx.Replace(strPolicies, " ")
regEx.Pattern = "^\s+"
strPolicies = regEx.Replace(strPolicies, "")
regEx.Pattern = "\s+$"
strPolicies = regEx.Replace(strPolicies, "")
' Split to array single policy settings
Dim aStrPolicies
Dim strPolicyPair
aStrPolicies = Split(strPolicies," ")
Dim aPolicies
aPolicies = m_SecurityPolicy.EnumPolicies
Dim Policy
' Reset current values
For Each Policy in aPolicies
Policy.m_strValue = Empty
Next
' Look for the policies and set values
For Each strPolicyPair in aStrPolicies
Dim aNameValuePair
Dim bFound
bFound = False
aNameValuePair = Split(strPolicyPair,"=")
For Each Policy in aPolicies
If StrComp(aNameValuePair(0), Policy.m_strParameterName, vbTextCompare) = 0 Then
Policy.m_strValue = aNameValuePair(1)
bFound = True
Exit For
End If
Next
' If not found - log an error and exit
If Not bFound Then
g_objLog.WriteLog "FepPolicyManager.SetPolicies", LOG_ERROR, "Policy not defined: " & aNameValuePair(0)
SetPolicies = False
Exit Function
End If
Next
SetPolicies = True
End Function
Public Function GetXML
GetXML = m_SecurityPolicy.GetXML
End Function
End Class
Class CShellOperator
Private m_bIsInitialized
Public ErrorCode
Public ErrorDescription
Public Function Execute(strCmdLine, objLog)
Execute = ExecuteEx(strCmdLine, objLog, null, null)
End Function
Public Function ExecuteEx(strCmdLine, objLog, ByRef strStdOutput, ByRef strStdError)
On Error Resume Next
Err.Clear
ErrorCode = 0
ErrorDescription = ""
Dim objShell, objScriptExec, strStdOut, strStdErr
Const WshRunning = 0
Set objShell = CreateObject("WScript.Shell")
If IsError(objShell) Then
ErrorCode = Err.number
ErrorDescription = Err.Description
ExecuteEx = ErrorCode
objLog.WriteLog "CShellOperator.ExecuteEx", LOG_ERROR, "Failed to create WScript.Shell object: " & ErrorDescription & " (0x" & hex(ErrorCode) & ")"
Exit Function
End If
objLog.WriteLog "CShellOperator.ExecuteEx", LOG_INFO, "Executing: " & strCmdLine
Set objScriptExec = objShell.Exec(strCmdLine)
If IsError(objScriptExec) Then
ErrorCode = Err.number
ErrorDescription = Err.Description
ExecuteEx = ErrorCode
objLog.WriteLog "CShellOperator.ExecuteEx", LOG_ERROR, "Failed to invoke command: '" & strCmdLine & "': " & ErrorDescription & " (0x" & hex(ErrorCode) & ")"
Exit Function
End If
Public Sub Class_Initialize
Dim iBackSlashInd, fso
m_bIsInitialized = False
m_strCollectUpdateErrors = Null
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.Class_Initialize", LOG_ERROR, "Scripting.FileSystemObject creation error:" + CStr(Err.Number)
Err.Clear
Exit Sub
End If
Set m_ShellOperator = New CShellOperator
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.Class_Initialize", LOG_ERROR, "CShellOperator creation error:" + CStr(Err.Number)
Err.Clear
Exit Sub
End If
Set m_WmiProcess = New CWmiProcess
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.Class_Initialize", LOG_ERROR, "CWmiProcess creation error:" + CStr(Err.Number)
Err.Clear
Exit Sub
End If
g_objLog.WriteLog "CAMOperator.Class_Initialize", LOG_INFO, "Started"
m_strScanExePath = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", g_strAMRegKey, g_strAMRegValue, "String", g_bIs64Bit)
If Not IsError(m_strScanExePath) Then
m_strCSPPath = m_strScanExePath + g_strCSPTool
If fso.FileExists(m_strCSPPath) Then
m_strCSPPath = """" + fso.BuildPath(m_strScanExePath, g_strCSPTool) + """"
Else
m_strCSPPath = """" + fso.BuildPath(m_strScanExePath, "..\" + g_strCSPTool) + """"
End If
m_strScanExePath = """" + fso.BuildPath(m_strScanExePath, g_strAMScanTool) + """"
g_objLog.WriteLog "CAMOperator.Class_Initialize", LOG_INFO, "succeeded"
m_bIsInitialized = True
Else
g_objLog.WriteLog "CAMOperator.Class_Initialize", LOG_INFO, "failed"
m_bIsInitialized = False
End If
End Sub
Private Function BuildErrorOutput(strStdOut, strStdErr)
' GetValidStringValue looks slightly different therefore we perform our own check for an empty or null value
If IsNull(strStdErr) Or Len(strStdErr) = 0 Then
If IsNull(strStdOut) Or Len(strStdOut) = 0 Then
BuildErrorOutput = "None"
Else
BuildErrorOutput = strStdOut
End If
Else
BuildErrorOutput = strStdErr
End If
End Function
Private Sub PrintErrorOutput(strStdOut, strStdErr)
WScript.StdErr.WriteLine BuildErrorOutput(strStdOut, strStdErr)
End Sub
Private Sub ReportUpdateError(dwErrorCode, strParam, strStdOut, strStdErr)
Dim strOutput
strOutput = Empty
If IsEmpty(strParam) Then
strOutput = FormatString1(TASK_ERROR_UPDATE_ERROR, dwErrorCode)
Else
strOutput = FormatString2(TASK_ERROR_UPDATE_ERROR_FOR_OPTION, strParam, dwErrorCode)
End If
strOutput = strOutput + vbCrLf + BuildErrorOutput(strStdOut, strStdErr)
' If m_strCollectUpdateErrors is Null then UpdateSignatures is called only once
' (not True, True call) and this is the last change to push the error to the standard error output
If IsNull(m_strCollectUpdateErrors) Then
WScript.StdErr.WriteLine strOutput
Else
m_strCollectUpdateErrors = m_strCollectUpdateErrors + vbCrLf + strOutput
End If
End Sub
Public Function IsInitialized()
IsInitialized = m_bIsInitialized
End Function
Public Function RunScan(bQuick)
Dim strCmdLine
If Not m_bIsInitialized Then
g_objLog.WriteLog "CAMOperator.RunScan", LOG_FATALERROR, "class not initialized"
RunScan = ERROR_APP_INIT_FAILURE
Exit Function
End If
If bQuick Then
g_objLog.WriteLog "CAMOperator.RunScan", LOG_INFO, "Quick Started"
strCmdLine = m_strScanExePath + MPCMDRUN_CMD_QUICKSCAN
Else
g_objLog.WriteLog "CAMOperator.RunScan", LOG_INFO, "Full Started"
strCmdLine = m_strScanExePath + MPCMDRUN_CMD_FULLSCAN
End If
' Run asynchronously
RunScan = m_WmiProcess.Execute(strCmdLine, false, 0)
If RunScan = 0 Then
g_objLog.WriteLog "CAMOperator.RunScan", LOG_INFO, "succeeded"
Else
g_objLog.WriteLog "CAMOperator.RunScan", LOG_ERROR, "failed"
WScript.StdErr.WriteLine FormatString1(TASK_ERROR_SCAN_FAILED, RunScan)
End If
End Function
Public Function AbortScan()
Dim objProcess, objcolProcess
On Error Resume Next
Err.Clear
If Not m_bIsInitialized Then
g_objLog.WriteLog "CAMOperator.AbortScan", LOG_FATALERROR, "class not initialized"
AbortScan = ERROR_APP_INIT_FAILURE
Exit Function
End If
Set objcolProcess = g_objShellOperator.GetProcess(g_strAMScanTool)
If IsError(objcolProcess) Then
g_objLog.WriteLog "CAMOperator.AbortScan", LOG_ERROR, "can't get scan process"
WScript.Echo TASK_WARNING_ABORT_SCAN_NO_SCAN
AbortScan = 0
Exit Function
End If
For Each objProcess In objcolProcess
Dim strCmdLine
strCmdLine = objProcess.CommandLine
If InStr(strCmdLine, "-scan") > 0 Then
objProcess.Terminate(E_ABORT)
If Err.Number <> 0 Then
WScript.StdErr.WriteLine FormatString3(TASK_ERROR_ABORT_SCAN_FAILED, objProcess.ProcessId, Err.Number, Err.Description)
End If
End If
Next
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.AbortScan", LOG_ERROR, "Error:" + CStr(Err.Number)
AbortScan = Err.Number
Err.Clear
Exit Function
End If
AbortScan = 0
End Function
Public Function UpdateSignatures(bMMPC, bUNC)
Dim strCmdLine, strParam
If Not m_bIsInitialized Then
UpdateSignatures = ERROR_APP_INIT_FAILURE
g_objLog.WriteLog "CAMOperator.UpdateSignatures", LOG_FATALERROR, "class not initialized"
Exit Function
End If
strParam = Empty
If bMMPC Or bUNC Then
If bMMPC And bUNC Then
' Avoid error output, because it will fail the task
m_strCollectUpdateErrors = Empty
' Calls itself twice, because both MMPC and UNC cannot be passed together to MpCmpRun
UpdateSignatures = UpdateSignatures(True, False)
' Or operation still executes the second operand in any case; therefore another "If" is needed
If UpdateSignatures<>0 Then
UpdateSignatures = UpdateSignatures(False, True)
End If
' If it failed again then print the error output; otherwise write it to the standard output
If UpdateSignatures<>0 Then
' Report common error message
WScript.StdErr.WriteLine FormatString1(TASK_ERROR_UPDATE_ERROR, UpdateSignatures)
' Report errors for each option if any
WScript.StdErr.WriteLine m_strCollectUpdateErrors
ElseIf Not IsNull(m_strCollectUpdateErrors) And Not IsEmpty(m_strCollectUpdateErrors) Then
WScript.Echo m_strCollectUpdateErrors
End If
Exit Function
Else
If bMMPC Then
strParam = " -MMPC"
Else
strParam = " -UNC"
End If
End If
End If
Dim strStdOut, strStdErr
UpdateSignatures = m_ShellOperator.ExecuteEx(strCmdLine, g_objLog, strStdOut, strStdErr)
If UpdateSignatures = 0 Then
g_objLog.WriteLog "CAMOperator.UpdateSignatures " + strParam, LOG_INFO, "succeeded"
WScript.StdOut.WriteLine FormatString1("Updating definitions with option {0} succeeded", strParam)
Else
If IsNull(strStdErr) Or IsEmpty(strStdErr) Then
If Not IsNull(m_ShellOperator.ErrorDescription) And Not IsEmpty(m_ShellOperator.ErrorDescription) Then
strStdErr = m_ShellOperator.ErrorDescription
Else
strStdErr = FormatString1(TASK_ERROR_UPDATE_ERROR, UpdateSignatures)
End If
End If
g_objLog.WriteLog "CAMOperator.UpdateSignatures " + strParam, LOG_ERROR, "failed with error: " + CStr(UpdateSignatures)
g_objLog.WriteLog "CAMOperator.UpdateSignatures " + strParam, LOG_ERROR, "Error output: " + strStdErr
ReportUpdateError UpdateSignatures, strParam, strStdOut, strStdErr
End If
End Function
Public Function ApplyCCSettings(strCommand, dwTimeout)
On Error Resume Next
Dim strCmdLine
Dim strXML
If Not m_bIsInitialized Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "class not initialized"
ApplyCCSettings = ERROR_APP_INIT_FAILURE
Exit Function
End If
Dim strVersion
strVersion = g_objRegistry.ReadValue("HKEY_LOCAL_MACHINE", g_strClientInstallationRegKey, AM_REGVALUE_CLIENT_VERSION, "String", g_bIs64Bit)
If Not IsVersionSupported(C_MinVersionSupported, strVersion) Then
g_objLog.WriteLog "Init", LOG_FATALERROR, TASK_ERROR_NOT_SUPPORTED
WScript.StdErr.WriteLine TASK_ERROR_NOT_SUPPORTED
ApplyCCSettings = ERROR_FUNCTION_FAILED
Exit Function
End If
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_INFO, "Entering with command line: " + strCommand
' Generation of the XML
Dim FepPolicyManager
Set FepPolicyManager = New FepPolicyManager
Dim bSetPolicy
Err.Clear
bSetPolicy = FepPolicyManager.SetPolicies(strCommand)
strXML = FepPolicyManager.GetXML
' The only error that may be raised by GetXML is connected to the fact that we are probably not running as LSA
If bSetPolicy And Len(strXML)>0 And Err.Number=0 Then
' Write it to a temp file
Dim fso, fileXml, folderTemp, strXmlFilename, strXmlFullpath
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "Scripting.FileSystemObject creation error:" + CStr(Err.Number)
ApplyCCSettings = Err.Number
Err.Clear
Exit Function
End If
Set folderTemp = fso.GetSpecialFolder(2)
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "GetSpecialFolder(2) error:" + CStr(Err.Number)
ApplyCCSettings = Err.Number
Err.Clear
Exit Function
End If
strXmlFilename = fso.GetTempName
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "GetTempName error:" + CStr(Err.Number)
ApplyCCSettings = Err.Number
Err.Clear
Exit Function
End If
Set fileXml = folderTemp.CreateTextFile(strXmlFilename, True)
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "CreateTextFile error:" + CStr(Err.Number)
ApplyCCSettings = Err.Number
Err.Clear
Exit Function
End If
fileXml.Write(strXML)
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "XML write error:" + CStr(Err.Number)
ApplyCCSettings = Err.Number
Err.Clear
fso.DeleteFile(strXmlFullpath)
Exit Function
End If
fileXml.Close
If Err.Number <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "XML file close error:" + CStr(Err.Number)
ApplyCCSettings = Err.Number
Err.Clear
fso.DeleteFile(strXmlFullpath)
Exit Function
End If
Set fileXml = Nothing
' Execute the CSP
strCmdLine = FormatString2("{0} {1} /lsa", m_strCSPPath, strXmlFullpath)
Dim strStdOut, strStdErr
ApplyCCSettings = m_ShellOperator.ExecuteEx(strCmdLine, g_objLog, strStdOut, strStdErr)
' We must wait because otherwise the file named strXmlFullpath will be deleted prematurely
If ApplyCCSettings <> 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_ERROR, "Execute error (" & strCmdLine &"):" + CStr(ApplyCCSettings)
If ApplyCCSettings = CO_E_LAUNCH_PERMSSION_DENIED Then
WScript.StdErr.WriteLine TASK_ERROR_NOT_LSA
Else
WScript.StdErr.WriteLine FormatString1(TASK_ERROR_APPLY_SETTINGS, ApplyCCSettings)
PrintErrorOutput strStdOut, strStdErr
End If
End If
' Delete the temp file
fso.DeleteFile(strXmlFullpath)
Else
If Err.Number=5 Then ' Thrown by DeleteValue in FEP policy manager when doesn't have enough permissions
ApplyCCSettings = CO_E_LAUNCH_PERMSSION_DENIED
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, ERROR_INVALID_DATA
WScript.StdErr.WriteLine TASK_ERROR_NOT_LSA
Else
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_FATALERROR, "The policy XML was not generated for: " + strCommand
ApplyCCSettings = ERROR_INVALID_DATA
End If
End If
If ApplyCCSettings = 0 Then
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_INFO, "succeeded"
Else
g_objLog.WriteLog "CAMOperator.ApplyCCSettings", LOG_ERROR, "failed"
End If
End Function
Private Function GetService(objWMIService, strName)
Dim objServiceCol, objService
On Error Resume Next
Err.Clear
Set objServiceCol = objWMIService.ExecQuery _
(FormatString1(WIN32SERV_BYNAME_WMI_QUERY, strName))
If Err.Number <> 0 Then
Set GetService = Nothing
g_objLog.WriteLog "CAMOperator::GetService", LOG_ERROR, "Cannot get service: " + strName + " error=" + CStr(Err.Number)
Err.Clear
Exit Function
End If
Set GetService = Nothing
For Each objService In objServiceCol
Set GetService = objService
Next
End Function
Public Function StartService()
Dim objWMIService, objService, dwTimeOut, dwStartTrialNum, dwStartTrialCount
On Error Resume Next
Err.Clear
If Not m_bIsInitialized Then
StartService = ERROR_APP_INIT_FAILURE
Exit Function
End If
Set objWMIService = GetObject(WIN32PROC_WMI_NAMESPACE)
If Err.Number <> 0 Then
StartService = Err.Number
g_objLog.WriteLog "CAMOperator:StartService", LOG_ERROR, "Cannot create object WScript.Shell, error=" + CStr(Err.Number)
Err.Clear
Exit Function
End If
Set objService = GetService(objWMIService, AM_SERVICE_NAME)
If Not IsObject(objService) Then
StartService = ERROR_SERVICE_NOT_FOUND
g_objLog.WriteLog "CAMOperator:StartService", LOG_ERROR, "Cannot get AM service"
Err.Clear
Exit Function
End If
If objService.StartMode <> "Auto" Then
g_objLog.WriteLog "CAMOperator:StartService", LOG_INFO, "set start mode to auto"
objService.ChangeStartMode "Automatic"
End If
if objService.State = "Running" Then
StartService = 0
Err.Clear
g_objLog.WriteLog "CAMOperator:StartService", LOG_INFO, "Service is already running"
Exit Function
End If
' Run AM service only when it is stopped (we don't change state when service is in pending states).
' Notice that AM service doesn't support pause state
If objService.State = "Stopped" Then
objService.StartService()
If Err.Number <> 0 Then
g_objLog.WriteLog "CWmiProcess::StartService", LOG_ERROR, "Cannot start AM service, error=" + Err.Description
Err.Clear
StartService = Err.Number
Exit Function
End If
Else
g_objLog.WriteLog "CWmiProcess::StartService", LOG_ERROR, "unsupported state of AM service, state=" + objService.State
Err.Clear
End If
' check
dwStartTrialCount = g_dwTimeOut * 10
For dwStartTrialNum = 0 To dwStartTrialCount
Set objService = GetService(objWMIService, AM_SERVICE_NAME)
If Not IsObject(objService) Then
StartService = ERROR_SERVICE_NOT_FOUND
g_objLog.WriteLog "CAMOperator:StartService", LOG_ERROR, "Cannot get AM service"
Err.Clear
Exit Function
End If
If objService.State = "Running" Then
Exit For
End If
WScript.Sleep 100
Next
If objService.State = "Running" Then
StartService = 0
Else
WScript.StdErr.WriteLine TASK_ERROR_START_SERVICE
StartService = ERROR_FUNCTION_FAILED
End If
End Function
End Class
SetLocale("en-us")
Dim g_iResult, g_objLog, g_objRegistry
Dim g_bIs64Bit
Dim g_dwTimeOut
Dim g_objAMOPerator
Dim g_objShellOperator
Dim g_strAMInstallDir
If IsError(g_bIs64Bit) Or Not bLogInitialized Or Not g_objAMOperator.IsInitialized() Then
g_objLog.WriteLog "Init", LOG_FATALERROR, FormatString3(_
"Cannot initialize: IsError(g_bIs64Bit)={0}, bLogInitialized={1}, g_objAMOperator.IsInitialized()={2}",_
IsError(g_bIs64Bit), bLogInitialized, g_objAMOperator.IsInitialized())
Init = False
Else
g_objLog.WriteLog "Init", LOG_INFO, "Initialized successfully"
Init = True
End If
End Function
' ActionExecutor function is a main entry to write actions
' Parameters:
' 0 - operation
' 1 - timeout
' 2 - param1
' 3 - param2
Function ActionExecutor(aCommand)
On Error Resume Next
Dim strMsg
If aCommand.Count < 2 Then
g_objLog.WriteLog "ActionTaskExecutor", LOG_ERROR, FormatString1("failed: wrong arguments count for scan - {0}", aCommand.Count)
ActionExecutor = ERROR_INVALID_PARAMETER
Exit Function
End If
g_objLog.WriteLog "ActionTaskExecutor", LOG_INFO, FormatString1("Action is {0}", aCommand(0))
g_dwTimeOut = CLng(aCommand(1))
If aCommand(0) = ACTEXEC_CMD_SCAN Then
If aCommand.Count = 3 Then
If aCommand(2) = "1" Then
ActionExecutor = g_objAMOperator.RunScan(True)
ElseIf aCommand(2) = "0" Then
ActionExecutor = g_objAMOperator.RunScan(False)
Else
strMsg = "wrong scan type - " + aCommand(2)
ActionExecutor = ERROR_INVALID_PARAMETER
End If
Else
strMsg = "wrong arguments count for scan"
ActionExecutor = ERROR_INVALID_PARAMETER
End If
ElseIf aCommand(0) = ACTEXEC_CMD_UPDATE Then
Dim UNC, MMPC ' No "b" prefix because we parse the parameter using Execute
MMPC = False
UNC = False
If aCommand.Count >= 3 Then
Execute aCommand(2)
End If
ActionExecutor = g_objAMOperator.UpdateSignatures(MMPC, UNC)
ElseIf aCommand(0) = ACTEXEC_CMD_ABORTSCAN Then
ActionExecutor = g_objAMOperator.AbortScan
ElseIf aCommand(0) = ACTEXEC_CMD_START_AMSERVICE Then
ActionExecutor = g_objAMOperator.StartService
ElseIf aCommand(0) = ACTEXEC_CMD_APPLY_CCSETTS Then
' All parameters starting from index 2 are policies
If aCommand.Count > 2 Then
Dim i
Dim strPolicies
strPolicies = ""
For i = 2 To aCommand.Count - 1
strPolicies = strPolicies & " " & aCommand(i)
g_objLog.WriteLog "ActionExecutor: apply_cc_settings", LOG_INFO, "Command line option(" + CStr(i) + ") = " + aCommand(i)
Next
ActionExecutor = g_objAMOperator.ApplyCCSettings(strPolicies, aCommand(1))
Else
strMsg = "wrong number of messages for apply_cc_settings action " + CStr(aCommand.Count)
ActionExecutor = ERROR_INVALID_PARAMETER
End If
Else
strMsg = ACTEXEC_CMD_UNKNOWN
ActionExecutor = ERROR_INVALID_PARAMETER
End If
If ActionExecutor = 0 Then
g_objLog.WriteLog "ActionTaskExecutor", LOG_INFO, "succeeded"
Else
g_objLog.WriteLog "ActionTaskExecutor", LOG_ERROR, "failed: " + strMsg
End If
End Function
'main
On Error Resume Next
Const C_ScriptName = "ActionTaskExecutor.vbs"
g_iResult = 0
Do
If Init() Then
g_objLog.WriteLog C_ScriptName, LOG_INFO, "started"
Else
g_iResult = ERROR_BAD_ENVIRONMENT
Exit Do
End If
' get arguments
g_iResult = ActionExecutor(WScript.Arguments)
If g_iResult <> 0 Then
Exit Do
End If
Loop While (False)
Dim objAPI
Set objAPI = CreateObject("MOM.ScriptAPI")
Const Error_event = 1
Const Information_event = 0
If g_iResult = 0 Then
g_objLog.WriteLog C_ScriptName, LOG_INFO, "succeeded"
Call objAPI.LogScriptEvent(C_ScriptName, 4001, Information_event, "succeeded")
Else
WScript.StdErr.WriteLine FormatString1(TASK_ERROR_OPERATION_FAILED, g_iResult)
g_objLog.WriteLog C_ScriptName, LOG_ERROR, "failed"
Call objAPI.LogScriptEvent(C_ScriptName, 4001, Error_event, "failed")
End If
g_objLog.SaveLogToDisk
' Return zero instead of the error code because otherwise all our error messages won't be shown the error dump
' SCOM fail the task if there is an error output or error code is not zero. It includes in the dump only the cause
' why it failed the task. Non-zero error code always wins over non-empty error output. Therefore if we return non-zero
' error code then it will be reported instead of more informative error message.
WScript.Quit 0
Home
ENU 
Show References: