vbscript VBScript：运行本地或远程策略。

Posted 2021-05-22

On Error Resume Next
Const ignoreBlockouts = 1
Const sendIfUnchanged = 1
Const padLength = 20
Const padCharacters = "."
Const HKEY_LOCAL_MACHINE = &H80000002, HKLM = &H80000002
Dim objWSHNetwork: Set objWSHNetwork = CreateObject("WScript.Network")

' Only run using cscript
If StrComp(Right(WScript.FullName, Len("cscript.exe")), "cscript.exe", vbTextCompare) <> 0 Then
	WScript.Echo "This script can only be run using CScript.exe"
	WScript.Quit
End If

If WScript.Arguments.Unnamed.Count <> 2 Then
	WScript.StdOut.WriteLine "Invalid command line options."
	WScript.Quit
End If

Dim strComputer: strComputer = UCase(WScript.Arguments(1))
Dim strTaskGuid: strTaskGuid = UCase(WScript.Arguments(0))

If strComputer = "." Then strComputer = objWSHNetwork.ComputerName

WScript.StdOut.Write PadText(strComputer, padLength, padCharacters)

Dim PingStatusEx: PingStatusEx = PingStatus(strComputer)
If PingStatusEx <> 0 Then
	Err.Number = PingStatusEx
	Err.Description = "Network Ping FAILED. (" & GetPingStatusCode(PingStatusEx) & ")"
	WScript.StdOut.WriteLine Err.Number & " " & Err.Description
	WScript.Quit
End If

Err.Clear
Dim objAltirisAgent: Set objAltirisAgent = CreateObject("Altiris.AeXNSClient", strComputer)
If Err.Number <> 0 Then
	Err.Description = "Connection to Altiris.AeXNSClient FAILED. " & Err.Description & "."
	WScript.StdOut.WriteLine Err.Number & " " & Err.Description
	WScript.Quit
End If

Err.Clear
Dim objSWDAgent: Set objSWDAgent = objAltirisAgent.ClientPolicyMgr.ClientAgent("Altiris.SWD")
If Err.Number <> 0 Then
	Err.Description = "Connection to Altiris.SWD FAILED. " & Err.Description & "."
	WScript.StdOut.WriteLine Err.Number & " " & Err.Description
	WScript.Quit
End If

Err.Clear
If IsGuid(strTaskGuid) = False Then
	Err.Number = -1
	Err.Description = "GUID validation FAILED. Invalid Advertisement GUID provided."
	WScript.StdOut.WriteLine Err.Number & " " & Err.Description
	WScript.Quit
End If

If Left(strTaskGuid, 1) <> "{" Then strTaskGuid = "{" & strTaskGuid & "}"

Dim bitLevel, ProviderArchitecture
bitLevel = GetStringValue(strComputer, HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Altiris Agent", "AgentPlatforms", 32)
If VarType(bitLevel) <> vbString Then bitLevel = GetStringValue(strComputer, HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Altiris Agent", "AgentPlatform", 64)
If VarType(bitLevel) <> vbString Then
	Err.Number = 1001
	Err.Description = "Get AgentPlatform FAILED."
	WScript.StdOut.WriteLine Err.Number & " " & Err.Description
	WScript.Quit
End If
ProviderArchitecture = 32
If CInt(Right(bitLevel, 2)) = 64 Then ProviderArchitecture = 64

Dim TaskName
TaskName = GetStringValue(strComputer, HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Altiris Agent\SMFAgent\Delivery\Policies\" & strTaskGuid, "Name", ProviderArchitecture)
If VarType(TaskName) = vbEmpty Then TaskName = "Could not retrieve task name."

Err.Clear
intRetVal = objSWDAgent.RunAdvertisement(strTaskGuid, 0)
If Err.Number = 0 And intRetVal <> 0 Then
	Err.Number = intRetVal
	Err.Description = "Internal failure."
End If
If "0x" & Hex(Err.Number) = "0x80070057" Then Err.Description = "The parameter is incorrect."
If Err.Number <> 0 Then
	Err.Description = "RunAdvertisement FAILED. " & TaskName & " " & strTaskGuid & " (" & Err.Description & ")."
	WScript.StdOut.WriteLine Err.Number & " " & Err.Description
	WScript.Quit
End If
WScript.StdOut.WriteLine "RunAdvertisement SUCCESS. " & TaskName & " " & strTaskGuid

Function PadText(ByVal Message, ByVal padLength, ByVal padCharacters)
	PadText = Message & "..."
	If Len(Message) < padLength Then PadText = Message & String(padLength - Len(Message), padCharacters)
End Function

Function PingStatus(ByVal Resource)
	' Win32_PingStatus Class, http://msdn.microsoft.com/en-us/library/aa394350%28VS.85%29.aspx
	Dim LocalNamespace_CIMv2: Set LocalNamespace_CIMv2 = GetObject("winmgmts:{impersonationlevel=impersonate}!//./root/cimv2")
	Dim LocalClass_Win32_PingStatus: Set LocalClass_Win32_PingStatus = LocalNamespace_CIMv2.Get("Win32_PingStatus.Address='" & Resource & "'")
	If ((VarType(LocalClass_Win32_PingStatus.PrimaryAddressResolutionStatus) And vbLong) = vbLong) Then PingStatus = LocalClass_Win32_PingStatus.PrimaryAddressResolutionStatus
	If ((VarType(LocalClass_Win32_PingStatus.StatusCode) And vbLong) = vbLong) Then PingStatus = LocalClass_Win32_PingStatus.StatusCode
End Function

Function GetPingStatusCode (ByVal intCode)
	Dim StatusCodes: Set StatusCodes =  CreateObject("Scripting.Dictionary")
	StatusCodes.Add 0, "Success"
	StatusCodes.Add 11001, "Buffer Too Small"
	StatusCodes.Add 11002, "Destination Net Unreachable"
	StatusCodes.Add 11003, "Destination Host Unreachable"
	StatusCodes.Add 11004, "Destination Protocol Unreachable"
	StatusCodes.Add 11005, "Destination Port Unreachable"
	StatusCodes.Add 11006, "No Resources"
	StatusCodes.Add 11007, "Bad Option"
	StatusCodes.Add 11008, "Hardware Error"
	StatusCodes.Add 11009, "Packet Too Big"
	StatusCodes.Add 11010, "Request Timed Out"
	StatusCodes.Add 11011, "Bad Request"
	StatusCodes.Add 11012, "Bad Route"
	StatusCodes.Add 11013, "TimeToLive Expired Transit"
	StatusCodes.Add 11014, "TimeToLive Expired Reassembly"
	StatusCodes.Add 11015, "Parameter Problem"
	StatusCodes.Add 11016, "Source Quench"
	StatusCodes.Add 11017, "Option Too Big"
	StatusCodes.Add 11018, "Bad Destination"
	StatusCodes.Add 11032, "Negotiating IPSEC"
	StatusCodes.Add 11050, "General Failure"
	GetPingStatusCode = intCode & " - Unknown"
	If StatusCodes.Exists(intCode) = True Then GetPingStatusCode = StatusCodes.Item(intCode)
End Function

Function IsGuid(ByVal strGUID)
	IsGuid = False
	If IsNull(strGUID) = True Then Exit Function
	Dim regExPattern
	' Guid without braces
	regExPattern = "^[A-Z0-9]{8}-[A-Z0-9]{4}-[A-Z0-9]{4}-[A-Z0-9]{4}-[A-Z0-9]{12}$"
	' Guid with braces
	If Left(strGUID, 1) = "{" Then regExPattern = "^\{[A-Z0-9]{8}-[A-Z0-9]{4}-[A-Z0-9]{4}-[A-Z0-9]{4}-[A-Z0-9]{12}\}$"
	Dim regEx: Set regEx = New RegExp
	regEx.Pattern = regExPattern
	IsGuid = regEx.Test(strGUID)
End Function

Function GetStringValue (ByVal Resource, ByVal hDefKey, ByVal sSubKeyName, ByVal sValueName, ByVal ProviderArchitecture)
	Const wbemAuthenticationLevelPktPrivacy = 6
	Const wbemImpersonationLevelImpersonate = 3
    Dim oCtx: Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
    oCtx.Add "__ProviderArchitecture", ProviderArchitecture
    oCtx.Add "__RequiredArchitecture", True
    Dim oLocator: Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
    oLocator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
    oLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
    Dim oReg: Set oReg = oLocator.ConnectServer(Resource, "root\default", "", "", , , , oCtx).Get("StdRegProv")
    Dim oInParams: Set oInParams = oReg.Methods_("GetStringValue").InParameters
    oInParams.hDefKey = hDefKey
    oInParams.sSubKeyName = sSubKeyName
    oInParams.sValueName = sValueName
    Dim oOutParams: Set oOutParams = oReg.ExecMethod_("GetStringValue", oInParams, , oCtx)
    GetStringValue = oOutParams.sValue
End Function