[wpkg-users] enanched pushxml.vbs

[marco_borra at libero.it]

Hi,
this is my ameliored version of pushxml.vbs.
Automaticaly append missing nodes to [profiles.xml]

START HERE...

' Short Description: Output AD Hosts to hosts.xml file
' Original source code:  http://wpkg.
org/WPKG_with_Active_Directory#Pulling_workstation_names_to_hosts.
xml_from_Active_Directory_OUs_automatically_with_vbScript
 
' Modifed by: Marc Ozin
' Modified Date: 2010-03-02
 
' Modification:
' Hosts  generated with multiple Profile-IDs to show each sub OU the Host 
resides within.
' e.g. if Computer1 is contained within Head-Office/Finance/Payroll the 
following Profile-IDs will be generated:
' <host name="Computer1" profile-id="/root">
'  <profile id="/root/Head-Office" />
'  <profile id="/root/Head-Office/Finance" />
'  <profile id="/root/Head-Office/Finance/Payroll" />
' </host>
'
' Modifed by: Marco Borra
' Modified Date: 2010-08-23
' 
' Modification:
' Profiles insert profile-di in profiles.xml when missing
' 
  
Const ADS_SCOPE_SUBTREE = 2
Const OU_SEPARATOR = "_"
Const VBquot = """"
Const WPKGPath = "\\server.sample.org\WPKG\"
 
'*******************************************************************
'* check for profile in profiles.xml
'*******************************************************************
Function CheckFullProfile( ByRef szFullProfile ) 
   
 CheckFullProfile = False   
 
 Dim root, xmlDoc
 Set xmlDoc = CreateObject("Microsoft.XMLDOM")
 
 xmlDoc.Async = "False"
 xmlDoc.Load( WPKGPath & "profiles.xml" )
 
 
 'Set root to the root element collection.
 Set root = xmlDoc.documentElement
 
 'Walk from the root to each of its child nodes.
 For Each objNode In root.childNodes
  
  If ( StrComp(UCase( objNode.nodeName ), UCase("profile"), VBTEXTCOMPARE) = 0 
) Then
   
   ' WScript.Echo objNode.nodeName & ": " & objNode.text
   Set objNamedNodeMap = objNode.attributes
   For Each objAttribute in objNamedNodeMap
       If ( StrComp(UCase( objAttribute.name ), UCase("id"), VBTEXTCOMPARE) = 
0 ) Then
        ' WScript.Echo objNode.nodeName & ": " & objAttribute.value
        If ( StrComp(UCase( objAttribute.value ), UCase(szFullProfile), 
VBTEXTCOMPARE) = 0 ) Then
         CheckFullProfile = True
        End if
       End If
   Next
  End If
  
 Next   
      
End Function
 
'*******************************************************************
'* append profile node in profiles.xml
'*******************************************************************
Sub InsertFullProfileNode( ByRef szFullProfile, ByRef szParentProfile ) 
 
 Dim root, xmlDoc, objNode, objAttribute, objNodeParentProfile
 Set xmlDoc = CreateObject("Microsoft.XMLDOM")
 
 xmlDoc.Async = "False"
 xmlDoc.Load( WPKGPath & "profiles.xml" )
 
 'Set root to the root element collection.
 Set root = xmlDoc.documentElement
   
 Set objNode = xmlDoc.createElement("profile")
 
 xmlDoc.createAttribute("id")
 objNode.setAttribute "id", szFullProfile
 root.appendChild(objNode)
 root.insertBefore objNode, root.lastChild
 
 Set objNodeParentProfile = xmlDoc.createElement("depends")
 objNodeParentProfile.setAttribute "profile-id", szParentProfile
 objNode.appendChild(objNodeParentProfile)
 objNode.insertBefore objNodeParentProfile, objNode.lastChild
 
 xmlDoc.save( WPKGPath & "profiles.xml" )
 
End Sub
 
 
 set fs = CreateObject("Scripting.FileSystemObject")
 set textstream = fs.CreateTextFile( WPKGPath & "hosts.xml", True)
 textstream.WriteLine "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
 textstream.WriteLine "<!-- automagically generated with " & Wscript.
ScriptFullName 
 textstream.WriteLine "     Date: " & Date() & "  -->" & vbCrLf & vbCrLf
 textstream.WriteLine "<wpkg>"
 
 Set rootDSE = GetObject("LDAP://RootDSE")
 domainContainer =  rootDSE.Get("defaultNamingContext")
 
 Set objConnection = CreateObject("ADODB.Connection")
 Set objCommand =   CreateObject("ADODB.Command")
 objConnection.Provider = "ADsDSOObject"
 objConnection.Open "Active Directory Provider"
 
 Set objCOmmand.ActiveConnection = objConnection
 objCommand.CommandText = _
     "Select Name, distinguishedName from 'LDAP://" & domainContainer & "' " _
         & "Where objectClass='computer'"  
 objCommand.Properties("Page Size") = 1000
 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 Set objRecordSet = objCommand.Execute
 objRecordSet.MoveFirst
 
 Do Until objRecordSet.EOF
     'Wscript.Echo "Computer Name: " & objRecordSet.Fields("Name").Value
     'Wscript.Echo "distinguishedName: " & objRecordSet.Fields
("distinguishedName").Value
     arrPath = Split(objRecordSet.Fields("distinguishedName").Value, ",")
     strOU = ""
 
  textstream.WriteLine vbTab & "<host name="& VBquot & objRecordSet.Fields
("Name").Value & VBquot &  " profile-id=" & VBquot & "root" & VBquot & ">"
 
     for each a in arrPath
   if left(a,2) = "OU" Then
   strOU = "/" & right(a,len(a) - 3) & strOU 
   End If
  Next
 
 
  arrProfiles=Split(StrOU,"/")
  sFullProfile = "root"
  strParentProfile = sFullProfile
  iDepth=0
  for each sProfile in arrProfiles
   iDepth = iDepth + 1
   if iDepth > 1 then
    sFullProfile = sFullProfile & OU_SEPARATOR & sProfile
    sFullProfile = Replace(sFullProfile, " ", "")
    textstream.WriteLine vbTab & vbTab & "<profile id=" & VBquot & 
sFullProfile & VBquot & " />"
    If ( CheckFullProfile( sFullProfile ) = False ) Then
     InsertFullProfileNode sFullProfile, strParentProfile 
    End If
    
    strParentProfile = sFullProfile
   
   end if
    
  next
  textstream.WriteLine vbTab & "</host>"
 
 
 
     objRecordSet.MoveNext
 Loop
 
 textstream.WriteLine "</wpkg>"
 textstream.close
 Wscript.Echo "Finished..."