'do the work!
main
'------------------------------
sub main
Init
ReadContentSetConfig
end sub 'main
sub Init
On Error Resume Next
dim objArgs
dim szConfigurationNC
dim oPartitionsContainer
dim oCrossRef
Set objArgs = WScript.Arguments
If objArgs.Count < 2 Then 'must get the name of the content set - RG to be
wscript.echo "usage: " & APP & " DfsRoot DfsLink"
WScript.Quit 'quit program execution
end if
szDfsRoot = objArgs(0) 'DfsRoot to become RG
szDfsLink = objArgs(1) 'DfsLink to become RF
Set oDomain = GetObject("LDAP://RootDSE")
If Err <> 0 Then
wscript.echo "cannot connect to the domain - error", Err.Number, Err.Description
WScript.Quit 'quit program execution
end if
szDomainNC = oDomain.Get("defaultNamingContext")
set colForestDomains = CreateObject("Scripting.Dictionary")
set colForestDomainDns = CreateObject("Scripting.Dictionary")
'find and store all NetBIOS domain names within the forest
szConfigurationNC = oDomain.Get("configurationNamingContext")
Set oPartitionsContainer = GetObject("LDAP://CN=Partitions," & szConfigurationNC)
' Set the filter so that only crossRef objects are returned
oPartitionsContainer.Filter = Array("crossRef")
'find the right crossRef object and extract NetBIOS domain name - will be quick - we've got one domain
' we also extract the domain dns name
For Each oCrossRef in oPartitionsContainer
If oCrossRef.SystemFlags = 3 Then
colForestDomains.add oCrossRef.nCName, oCrossRef.nETBIOSName
colForestDomainDns.add oCrossRef.nCName, oCrossRef.dnsRoot
if oCrossRef.nCName = szDomainNC then
szDomainNETBIOSname = oCrossRef.nETBIOSName
szDomainRootDns = oCrossRef.dnsRoot
end if
End If
Next
end sub 'Init
sub ReadContentSetConfig
On Error Resume Next
const DFSVolumes="CN=DFS Volumes,CN=File Replication Service,CN=System"
dim oRG
dim oRF
Set oRG = GetObject("LDAP://cn=" & szDfsRoot & "," & DFSVolumes & "," & szDomainNC)
if Err <> 0 then
wscript.echo "cannot read information from AD on the DFS Root object", szDfsRoot
wscript.Quit
end if
set oRF = GetObject("LDAP://cn=" & szDfsRoot & "|" & szDfsLink & ",cn=" & szDfsRoot & "," & DFSVolumes & "," & szDomainNC)
if Err <> 0 then
wscript.echo "cannot read information from AD on the DFS Link object", szDfsLink
wscript.Quit
end if
szRFname = mid(oRF.cn, instr(oRF.cn,"|")+1) 'convention, plus get the original spelling
szRGname = oRG.cn & "_" & szRFname 'convention, also - get the original spelling
wscript.echo DFSRADMIN & "RG New /RgName:""" & szRGname & """"
wscript.echo DFSRADMIN & "RF New /RgName:""" & szRGname & """ /RfName:""" & szRFname & """"
szDfsPublishedPath = "\\" & szDomainRootDns & "\" & oRG.cn & "\" & szRFname
wscript.echo DFSRADMIN & "RF Set /RgName:""" & szRGname & """ /RfName:""" & szRFname & _
""" /RfDfsPath:""" & szDfsPublishedPath & """ /Force"
On Error Goto 0
ProcessReplicatedFolder(oRF)
end sub 'ReadContentSetConfig
' Get the DFS Target Share for the given link on
' the given server using WMI
Function GetShareNameForLink(szLinkName, szServer)
Dim objWmiService
Dim szQueryString
Dim objResultSet
Dim objTarget
Set objWmiService = GetObject("winmgmts:\\.\root\cimv2")
szQueryString = "Select * From Win32_DfsTarget Where LinkName Like '%\\" & _
szDfsRoot & "\\" & szLinkName & "'" & _
" And ServerName Like'" & szServer & "%'"
Set objResultSet = objWmiService.ExecQuery(szQueryString)
If ( IsNull(objResultSet) Or objResultSet.Count = 0 ) Then
WScript.StdErr.WriteLine "Error getting target share path for " & szLinkName & " on " & szServer
GetShareNameForLink = ""
Exit Function
End If
For Each objTarget In objResultSet
GetShareNameForLink = objTarget.ShareName
Exit Function
Next
End Function
sub ProcessReplicatedFolder(obj)
dim colRgMembers
dim colRfMembers
dim oMbr
dim szMbr
dim oConn
dim oComputer
dim strConn
dim szFileFilter, szDirFilter
dim oSubscriber
dim szComputerDomainFQDN
dim szDfsFolderPath
dim szShareName
dim blPrimarySet
blPrimarySet = False
if not isempty(obj.fRSFileFilter) then
szFileFilter = obj.fRSFileFilter
wscript.echo DFSRADMIN & "RF Set /RgName:""" & szRGname & """ /RfName:""" & szRFname & _
""" /RfFileFilter:""" & szFileFilter & """"
end if
if not isempty(obj.fRSDirectoryFilter) then
szDirFilter = obj.fRSDirectoryFilter
wscript.echo DFSRADMIN & "RF Set /RgName:""" & szRGname & """ /RfName:""" & szRFname & _
""" /RfDirFilter""" & szDirFilter & """"
end if
set colRgMembers = CreateObject("Scripting.Dictionary")
set colRfMembers = CreateObject("Scripting.Dictionary")
obj.Filter = Array("nTFRSMember")
for each oMbr in obj
colRfMembers.Add oMbr.distinguishedName, oMbr.fRSComputerReference
szComputerDomainFQDN = mid(oMbr.fRSComputerReference,instr(oMbr.fRSComputerReference,"DC="))
set oComputer = getObject("LDAP://" & oMbr.fRSComputerReference)
colRgMembers.Add oMbr.fRSComputerReference, colForestDomains.Item(szComputerDomainFQDN) & "\" & oComputer.cn
wscript.echo DFSRADMIN & "Mem New /RgName:""" & szRGname & """ /MemName:""" & colRgMembers.Item(oMbr.fRSComputerReference) & """ /Force"
set oSubscriber = getObject("LDAP://" & oMbr.fRSmemberReferenceBL)
szShareName = GetShareNameForLink(szRFname, oComputer.cn)
szDfsFolderPath = "\\" & oComputer.cn & "." & colForestDomainDns.Item(szComputerDomainFQDN) & "\" & szShareName
wscript.echo DFSRADMIN & "Membership Set /RgName:""" & szRGname & """ /RfName:""" & szRFname & _
""" /MemName:""" & colRgMembers.Item(oMbr.fRSComputerReference) & """" & _
" /LocalPath:""" & oSubscriber.fRSRootPath & """" & _
" /MembershipDFSFolder:""" & szDfsFolderPath & _
""" /MembershipEnabled:False /DisableDirectoryVerification /Force"
next
for each szMbr in colRfMembers.Keys
set oMbr = GetObject("LDAP://" & szMbr)
oMbr.Filter = Array("nTDSConnection")
for each oConn in oMbr
strConn = " /SendMem:" & colRgMembers.Item(colRfMembers.Item(oConn.fromServer)) & _
" /RecvMem:" & colRgMembers.Item(colRfMembers.Item(oMbr.distinguishedName))
wscript.echo DFSRADMIN & "Conn New /RgName:""" & szRGname & """" & strConn
wscript.echo DFSRADMIN & "Conn Set /RgName:""" & szRGname & """" & strConn & " /ConnEnabled:true"
if not isempty(oConn.schedule) then
DumpSchedule oConn.schedule, strConn
end if
next
next
'need to set the primary replica as well - obj.fRSPrimarymember points out to it, it has to be devolved using LUTs
end sub 'ProcessReplicatedFolder
sub DumpSchedule(binSchedule,strConnection)
const STARTIDX = 21 'blob start + 1, since midb counts string position from 1
dim aDaysOfWeek
dim d, h, n
dim strSched
dim aSched(187)
aDaysOfWeek = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
'schedule format determined by analysing the blob - might be wrong
'we only run if the schedule blob is 188 bytes - otherwise no clue how to intepret it
if (ubound(binSchedule) = 187) then
'remember - the schedule is in UTC!
for n = STARTIDX to 188 'copy to true array - for convenience - vbs is not very good with octet string data
aSched(n-STARTIDX) = cint(ascb(midb(binSchedule,n,1)))
next
for d = 0 to 6
if aSched(d * 24) = 0 then
strSched = "0000"
else
strSched = "ffff"
end if
for h = 1 to 23
if aSched(d * 24 + h) = 0 then
strSched = strSched & ",0000"
else
strSched = strSched & ",ffff"
end if
next
wscript.echo DFSRADMIN & " Conn Set Schedule Custom /RgName:""" & szRGname & """ " & strConnection & _
" /Day:" & aDaysOfWeek(d) & " /Schedule:" & strSched
next
wscript.echo DFSRADMIN & " Conn Set /RgName:""" & szRGname & """ " & strConnection & _
" /IsScheduleInLocalTime:False"
end if
end sub 'DumpSchedule
