Replication Performance Collection Helper (Target) Write Action

Microsoft.Windows.Server.LDS.Replication.PerfCollectionTarget.WriteAction (WriteActionModuleType)

Element properties:

Member Modules:

Overrideable Parameters:

Source Code:

<WriteActionModuleType ID="Microsoft.Windows.Server.LDS.Replication.PerfCollectionTarget.WriteAction" Accessibility="Internal" Batching="false" RunAs="LDS!Microsoft.Windows.Server.LDS.Account.LdapReadWrite">

  <Configuration>

    <xsd:element name="TimeoutSeconds" type="xsd:int"/>

    <xsd:element name="PartitionName" type="xsd:string"/>

    <xsd:element name="ManagementGroupId" type="xsd:string"/>

    <xsd:element name="LogSuccessEvent" type="xsd:boolean"/>

  </Configuration>

  <OverrideableParameters>

    <OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>

    <OverrideableParameter ID="LogSuccessEvent" Selector="$Config/LogSuccessEvent$" ParameterType="bool"/>

  </OverrideableParameters>

  <ModuleImplementation Isolation="Any">

    <Composite>

      <MemberModules>

        <WriteAction ID="Script" TypeID="Windows!Microsoft.Windows.ScriptWriteAction">

          <ScriptName>ReplicationHelper2.vbs</ScriptName>

          <Arguments>$Config/ManagementGroupId$ "$Config/PartitionName$" $Config/LogSuccessEvent$</Arguments>

          <ScriptBody><Script>

                    Option Explicit



'Event Constants

Const EVENT_TYPE_SUCCESS      = 0

Const EVENT_TYPE_ERROR        = 1

Const EVENT_TYPE_WARNING      = 2

Const EVENT_TYPE_INFORMATION  = 4



'Event ID Constants

Const EVENTID_SUCCESS         = 99

Const EVENTID_SCRIPT_ERROR    = 1000



Const SCRIPT_NAME = "ReplicationHelper2.vbs"

Const REPL_TARGET_KEY = "ReplicationPerfCollectionTargetFlag"

Const REPL_MONIT_SUBKEY = "\ADLDS Management Pack\Replication Monitoring"



Dim oAPI, oParams, oReg

Dim bParamLogSuccess

Dim strManagementGroupId, strRegStatePath, strPartitionName



Sub Main()

  Dim strRegStateRoot, strPartitionName

  

  Set oAPI = CreateObject("MOM.ScriptAPI")

  

  On Error Resume Next

  

  Set oReg = CreateObject("WScript.Shell")

   If Err &lt;&gt; 0 Then

    CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "The script '" &amp; SCRIPT_NAME &amp; _

      "' failed to create the WScript.Shell object. " &amp; GetErrorString(Err)

    Exit Sub

  End If



  ' Ensure the have the right parameters

  Set oParams = WScript.Arguments

  If oParams.Count &lt; 3 Then

    CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "The script '" &amp; SCRIPT_NAME &amp; _

      "' failed to execute. Incorrect number of parameters."

    Exit Sub

  End If



  strManagementGroupId = oParams(0)

  strPartitionName = oParams(1)

  bParamLogSuccess = CBool(oParams(2))



  ' Determine the location where we will write our performance collection settings

  strRegStateRoot = oAPI.GetScriptStateKeyPath(strManagementGroupId)

  If Err &lt;&gt; 0 Then

    CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "The script '" &amp; SCRIPT_NAME &amp; _

      "' failed to retrieve the registry state root. " &amp; GetErrorString(Err)

    Exit Sub

  End If



  ' Construct the full path to the registry state key

  strRegStatePath = "HKLM\" &amp; strRegStateRoot &amp; REPL_MONIT_SUBKEY &amp; "\" &amp; strPartitionName



  Call SetData(REPL_TARGET_KEY, "True")

  If Err &lt;&gt; 0 Then

    CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "The script '" &amp; SCRIPT_NAME &amp; _

      "' failed to set the state data. " &amp; GetErrorString(Err)

    Exit Sub

  End If

  

  If bParamLogSuccess Then

    CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, "The script '" &amp; SCRIPT_NAME &amp; _

      "' successfully set the registry state for '" &amp; strRegStatePath &amp; "\" &amp; _

      REPL_TARGET_KEY &amp; "'."

    Exit Sub

  End If

End Sub







'******************************************************************************

Sub SetData(strKey, strData)

' 

' Purpose:		To store data in a varset.  If the key exists then the data 

'             associated with that key is replaced, otherwise the key/data

'             combination is added to the varset.

'

' Arguments:	strKey, the key of the line to replace

'             strData, the data to associate with the key

'

' Returns:		Nothing



Wscript.Echo "KEY: " &amp; strRegStatePath &amp; "\" &amp; strKey

  Call oReg.RegWrite(strRegStatePath &amp; "\" &amp; strKey , strData )

End Sub





'******************************************************************************

Sub CreateEvent(lEventID, lEventType, strMessage)

'

' Purpose:      Create a new event.

' 

' Parameters:   lEventID - The numerical ID of the event to create

'               lEventType - The numerical ID of the event type

'               strMessage - The message to include in the event

'

 oAPI.LogScriptEvent "LDS Replication Helper #2", lEventID, lEventType, strMessage



End Sub





'******************************************************************************

Function GetErrorString(oErr)

'

' Purpose:      Attempts to find the description for an error if an error with 

'               no description is passed in.

' 

' Parameters:   oErr, the error object

'

' Return:       String, the description for the error.  (Includes the error code.)

'

  Dim lErr, strErr

  lErr = oErr

  strErr = oErr.Description



  On Error Resume Next

  If 0 &gt;= Len(strErr) Then

    ' If we don't have an error description, then check to see if the error

    ' is a 0x8007xxxx error.  If it is, then look it up.

    Const ErrorMask = &amp;HFFFF0000  

    Const HiWord8007 = &amp;H80070000

    Const LoWordMask = 65535          ' This is equivalent to 0x0000FFFF



    If (lErr And ErrorMask) = HiWord8007 Then

      ' Attempt to use 'net helpmsg' to get a description for the error.

      Dim oShell

      Set oShell = CreateObject("WScript.Shell")

      If Err = 0 Then

        Dim oExec 

        Set oExec = oShell.Exec("net helpmsg " &amp; (lErr And LoWordMask))



        Dim strMessage, i

        Do

          strMessage = oExec.stdout.ReadLine()

          i = i + 1

        Loop While (Len(strMessage) = 0) And (i &lt; 5)



        strErr = strMessage

      End If

    End If	

  End If



  GetErrorString = vbCrLf &amp; "The error returned was: '" &amp; strErr &amp; "' (0x" &amp; Hex(lErr) &amp; ")"

End Function





Call Main()



                  </Script></ScriptBody>

          <TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>

        </WriteAction>

      </MemberModules>

      <Composition>

        <Node ID="Script"/>

      </Composition>

    </Composite>

  </ModuleImplementation>

  <InputType>System!System.BaseData</InputType>

</WriteActionModuleType>