Someone asked last week for some help with a WebDAV script that shows public folders replicas. Now this is one of the cool things you can do using PfdavAdmin which also uses WebDAV to do the same thing. So this makes it rife for scripting the thing to remember when you want to change these types of settings that pfdavadmin is modifying is that you need to use the Administrative Virtual Root .
The property that holds the replica list is http://schemas.microsoft.com/mapi/proptag/0x66980102 which when you working in WebDAV is Base64 encoded null terminated strings. So to successfully display the replicas in the list you first need to decode the base 64 and then parse out and replace the null terminators so it can be something meaning in VB. The method I’ve used is just to replace the nulls with Line Feeds this makes it firstly easy to display the value and also the Line Feeds can also act as placeholders when you need to build the new replica list to post back to the server when you want to add or remove replicas.
There are a few different subs and functions in this script which all perform different tasks the flow of the script itself works like this.
You run it from the command-line with 3 command-line parameters the first is the action you want to take the valid actions are display, add or remove. The next parameter you need is the server you want to add or remove the replica from and the third parameter is the folder path from the root. So say you want to add a replica of the folder “Shared/Company Info” to the server called server1 you would use cscript pubrep.vbs add server1 “Shared/Company Info”. The one thing that you do need to change to make this script work properly is the path to the administrative virtual root which is in the following line
admnamefold = "http://" & servername & "/ExAdmin/Admin/YouDomain.com /public folders/" & foldername & "/"
The domain name should be your default SMTP domain in your default Recipient policy. The other easy way to find this out is have a look at ExAdmin directory with IIS Admin on any mail server (or use Pfdavadmin and the property editior)
The Octenttostring function takes the base64 encoded value decodes into one string variable also removing the null termination characters and replacing them with Line feeds.
The Repaction sub then runs and look at the action requested if its display it just outputs the replica’s. If its add or remove it then calls the add or remove sub. The add and remove subs work essentially the same way they build the new replica list be either adding or removing a public store from it.
Because an Exchange server can have multiple public stores but only one MAPI Public Folder tree the Publicfolder function take the netbios name of the server and finds DN of the server in the configuration partition. It then finds the default MAPI folder tree by querying for all the PF folder trees with the msExchPFTreeType property = 1. These two pieces of information are then used to find the public folder store in the configuration partition for that server that hosts the MAPI Public Folder tree and then retrieves the Exchange legacy DN of this store which is needed to construct or remove the server from the replica list. The rest of the sub either removes or adds the new public folder MDB url to replica list replaces the LF with nulls again and then calls the proppatchrep function which first does a few tricks to encode the new replica list in base64 it first does a binary conversion using an ADODB.Stream (thanks to Paul Randall who I picked this up from) and then uses a temporary XML document to do the base64 encoding. I could have used the XML document to create the XML for the Proppatch but at the end of the day its simpler just to use construct a string manually.
The only other thing to note about using the administrative Virtual Root is that you need to have admin rights to use it. I’ve posted a download copy of the script here the code look like.
action = wscript.arguments(0)
servername = wscript.arguments(1)
foldername = wscript.arguments(2)
public admnamefold
admnamefold = "http://" & servername & "/ExAdmin/Admin/domain.com/public
folders/" & foldername & "/"
Set objX = CreateObject("Microsoft.XMLHTTP")
objX.Open "PROPFIND", admnamefold, FALSE, "", ""
strR = "<?xml version='1.0'?>"
strR = strR & "<a:propfind xmlns:a='DAV:' xmlns:e='http://schemas.microsoft.com/mapi/proptag/'>"
strR = strR & "<a:prop><e:x66980102/></a:prop></a:propfind>"
objX.SetRequestHeader "Content-type:", "text/xml"
objX.SetRequestHeader "Depth", "0"
objX.send(strR)
set docback = objX.responseXML
Dim objNodeList
Set objNodeList = docback.getElementsByTagName("d:x66980102")
For i = 0 TO (objNodeList.length -1)
Set objNode = objNodeList.nextNode
strrep = Octenttostring(objNode.nodeTypedValue)
call Repaction(strrep,action,servername)
Next
sub Repaction(strrep,action,servername)
select case action
case "display" wscript.echo "Current Replica's"
wscript.echo
wscript.echo strrep
case "add" call addrep(strrep,servername)
case "remove" call deleterep(strrep,servername)
case else Wscript.echo "Invalid Commmand use add,remove or display"
end select
end sub
sub addrep(strrep,servername)
aexist = 0
reparray = split(strrep,chr(10),-1,1)
pubfolderLDN = PublicfolderLDN(Servername)
for i = lbound(reparray) to ubound(reparray)
if ucase(reparray(i)) = ucase(pubfolderLDN) then aexist = 1
next
if aexist = 1 then
wscript.echo "Replica already Exist for this server"
call Repaction(strrep,"display",servername)
else
strrep = replace(strrep,chr(10),chr(0)) & pubfolderLDN & chr(0)
call proppatchrep(strrep)
end if
end sub
sub deleterep(strrep,servername)
aexist = 0
nstr = ""
reparray = split(strrep,chr(10),-1,1)
pubfolderLDN = PublicfolderLDN(Servername)
if ubound(reparray) > 1 then
for i = lbound(reparray) to ubound(reparray)-1
if ucase(reparray(i)) = ucase(pubfolderLDN) then
aexist = 1
else
nstr = reparray(i) & chr(0)
end if
next
else
Wscript.echo "You cant delete the only replica of this folder !"
end if
if aexist = 1 then
call proppatchrep(nstr)
else
wscript.echo "NO Replica Exists for this server"
call Repaction(strrep,"display",servername)
end if
end sub
sub proppatchrep(strrep)
set convobj = CreateObject("Msxml2.DOMDocument.4.0")
Set oRoot = convobj.createElement("test")
oRoot.dataType = "bin.base64"
OriginalLocale = SetLocale(1033)
set stm = CreateObject("ADODB.Stream")
stm.Type = 2
stm.Charset = "x-ansi"
stm.Open
stm.WriteText strrep
stm.Position = 0
stm.Type = 1
oRoot.nodeTypedValue = stm.Read
SetLocale(OriginalLocale)
xmlstring = "<?xml version=""1.0"" encoding=""utf-8""?>"
xmlstring = xmlstring & "<d:propertyupdate xmlns:d=""DAV:""
xmlns:m=""http://schemas.microsoft.com/mapi/proptag/""" _
& " xmlns:b=""urn:schemas-microsoft-com:datatypes/"">" & vbcrlf & "<d:set>" &
vbcrlf & "<d:prop>" & vbcrlf & "<m:0x66980102 b:dt=""bin.base64"">"
xmlstring = xmlstring & oRoot.text & vbcrlf
xmlstring = xmlstring & "</m:0x66980102>" & vbcrlf & "</d:prop>" & vbcrlf &
"</d:set>" & vbcrlf & "</d:propertyupdate>"
Set xmlReq = CreateObject("Microsoft.XMLHTTP")
xmlReq.open "PROPPATCH",admnamefold, False
xmlReq.setRequestHeader "Content-Type", "text/xml"
xmlReq.send xmlstring
If xmlReq.status >= 500 Then
wscript.echo "Status: " & xmlReq.status
wscript.echo "Status text: An error occurred on the server."
ElseIf xmlReq.status = 207 Then
wscript.echo "Replica Set sussessfully"
Else
wscript.echo "Status: " & xmlReq.status
wscript.echo "Status text: " & xmlReq.statustext
wscript.echo "Response text: " & xmlReq.responsetext
End If
end sub
Function Octenttostring(OctenArry)
ReDim aOut(UBound(OctenArry))
For i = 1 to UBound(OctenArry) + 1
if ascb(midb(OctenArry,i,1)) <> 0 then
aOut(i-1) = chr(ascb(midb(OctenArry,i,1)))
else
aOut(i-1) = chr(10)
end if
Next
Octenttostring = join(aOUt,"")
End Function
function PublicfolderLDN(Servername)
set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
set conn1 = createobject("ADODB.Connection")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
svcQuery = "<LDAP://" & strNameingContext &
">;(&(objectCategory=msExchExchangeServer)(cn=" & Servername &
"));cn,name,distinguishedName,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = svcQuery
Set Rs = Com.Execute
while not rs.eof
defpf = "(&(objectCategory=msExchPFTree)(msExchPFTreeType=1))"
strQuery = "<LDAP://" & strNameingContext & ">;" & defpf &
";distinguishedName;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs1 = Com.Execute
while not rs1.eof
snameq = "(&(&(objectCategory=msExchPublicMDB)(msExchOwningPFTree=" &
rs1.fields("distinguishedName") _
& ")(msExchOwningServer=" & rs.fields("distinguishedName") & ")))"
strQuery = "<LDAP://" & strNameingContext & ">;" & snameq &
";distinguishedName,legacyExchangeDN;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs2 = Com.Execute
while not rs2.eof
PublicfolderLDN = rs2.fields("legacyExchangeDN")
rs2.movenext
wend
rs1.movenext
wend
rs.movenext
wend
end function
The property that holds the replica list is http://schemas.microsoft.com/mapi/proptag/0x66980102 which when you working in WebDAV is Base64 encoded null terminated strings. So to successfully display the replicas in the list you first need to decode the base 64 and then parse out and replace the null terminators so it can be something meaning in VB. The method I’ve used is just to replace the nulls with Line Feeds this makes it firstly easy to display the value and also the Line Feeds can also act as placeholders when you need to build the new replica list to post back to the server when you want to add or remove replicas.
There are a few different subs and functions in this script which all perform different tasks the flow of the script itself works like this.
You run it from the command-line with 3 command-line parameters the first is the action you want to take the valid actions are display, add or remove. The next parameter you need is the server you want to add or remove the replica from and the third parameter is the folder path from the root. So say you want to add a replica of the folder “Shared/Company Info” to the server called server1 you would use cscript pubrep.vbs add server1 “Shared/Company Info”. The one thing that you do need to change to make this script work properly is the path to the administrative virtual root which is in the following line
admnamefold = "http://" & servername & "/ExAdmin/Admin/YouDomain.com /public folders/" & foldername & "/"
The domain name should be your default SMTP domain in your default Recipient policy. The other easy way to find this out is have a look at ExAdmin directory with IIS Admin on any mail server (or use Pfdavadmin and the property editior)
The Octenttostring function takes the base64 encoded value decodes into one string variable also removing the null termination characters and replacing them with Line feeds.
The Repaction sub then runs and look at the action requested if its display it just outputs the replica’s. If its add or remove it then calls the add or remove sub. The add and remove subs work essentially the same way they build the new replica list be either adding or removing a public store from it.
Because an Exchange server can have multiple public stores but only one MAPI Public Folder tree the Publicfolder function take the netbios name of the server and finds DN of the server in the configuration partition. It then finds the default MAPI folder tree by querying for all the PF folder trees with the msExchPFTreeType property = 1. These two pieces of information are then used to find the public folder store in the configuration partition for that server that hosts the MAPI Public Folder tree and then retrieves the Exchange legacy DN of this store which is needed to construct or remove the server from the replica list. The rest of the sub either removes or adds the new public folder MDB url to replica list replaces the LF with nulls again and then calls the proppatchrep function which first does a few tricks to encode the new replica list in base64 it first does a binary conversion using an ADODB.Stream (thanks to Paul Randall who I picked this up from) and then uses a temporary XML document to do the base64 encoding. I could have used the XML document to create the XML for the Proppatch but at the end of the day its simpler just to use construct a string manually.
The only other thing to note about using the administrative Virtual Root is that you need to have admin rights to use it. I’ve posted a download copy of the script here the code look like.
action = wscript.arguments(0)
servername = wscript.arguments(1)
foldername = wscript.arguments(2)
public admnamefold
admnamefold = "http://" & servername & "/ExAdmin/Admin/domain.com/public
folders/" & foldername & "/"
Set objX = CreateObject("Microsoft.XMLHTTP")
objX.Open "PROPFIND", admnamefold, FALSE, "", ""
strR = "<?xml version='1.0'?>"
strR = strR & "<a:propfind xmlns:a='DAV:' xmlns:e='http://schemas.microsoft.com/mapi/proptag/'>"
strR = strR & "<a:prop><e:x66980102/></a:prop></a:propfind>"
objX.SetRequestHeader "Content-type:", "text/xml"
objX.SetRequestHeader "Depth", "0"
objX.send(strR)
set docback = objX.responseXML
Dim objNodeList
Set objNodeList = docback.getElementsByTagName("d:x66980102")
For i = 0 TO (objNodeList.length -1)
Set objNode = objNodeList.nextNode
strrep = Octenttostring(objNode.nodeTypedValue)
call Repaction(strrep,action,servername)
Next
sub Repaction(strrep,action,servername)
select case action
case "display" wscript.echo "Current Replica's"
wscript.echo
wscript.echo strrep
case "add" call addrep(strrep,servername)
case "remove" call deleterep(strrep,servername)
case else Wscript.echo "Invalid Commmand use add,remove or display"
end select
end sub
sub addrep(strrep,servername)
aexist = 0
reparray = split(strrep,chr(10),-1,1)
pubfolderLDN = PublicfolderLDN(Servername)
for i = lbound(reparray) to ubound(reparray)
if ucase(reparray(i)) = ucase(pubfolderLDN) then aexist = 1
next
if aexist = 1 then
wscript.echo "Replica already Exist for this server"
call Repaction(strrep,"display",servername)
else
strrep = replace(strrep,chr(10),chr(0)) & pubfolderLDN & chr(0)
call proppatchrep(strrep)
end if
end sub
sub deleterep(strrep,servername)
aexist = 0
nstr = ""
reparray = split(strrep,chr(10),-1,1)
pubfolderLDN = PublicfolderLDN(Servername)
if ubound(reparray) > 1 then
for i = lbound(reparray) to ubound(reparray)-1
if ucase(reparray(i)) = ucase(pubfolderLDN) then
aexist = 1
else
nstr = reparray(i) & chr(0)
end if
next
else
Wscript.echo "You cant delete the only replica of this folder !"
end if
if aexist = 1 then
call proppatchrep(nstr)
else
wscript.echo "NO Replica Exists for this server"
call Repaction(strrep,"display",servername)
end if
end sub
sub proppatchrep(strrep)
set convobj = CreateObject("Msxml2.DOMDocument.4.0")
Set oRoot = convobj.createElement("test")
oRoot.dataType = "bin.base64"
OriginalLocale = SetLocale(1033)
set stm = CreateObject("ADODB.Stream")
stm.Type = 2
stm.Charset = "x-ansi"
stm.Open
stm.WriteText strrep
stm.Position = 0
stm.Type = 1
oRoot.nodeTypedValue = stm.Read
SetLocale(OriginalLocale)
xmlstring = "<?xml version=""1.0"" encoding=""utf-8""?>"
xmlstring = xmlstring & "<d:propertyupdate xmlns:d=""DAV:""
xmlns:m=""http://schemas.microsoft.com/mapi/proptag/""" _
& " xmlns:b=""urn:schemas-microsoft-com:datatypes/"">" & vbcrlf & "<d:set>" &
vbcrlf & "<d:prop>" & vbcrlf & "<m:0x66980102 b:dt=""bin.base64"">"
xmlstring = xmlstring & oRoot.text & vbcrlf
xmlstring = xmlstring & "</m:0x66980102>" & vbcrlf & "</d:prop>" & vbcrlf &
"</d:set>" & vbcrlf & "</d:propertyupdate>"
Set xmlReq = CreateObject("Microsoft.XMLHTTP")
xmlReq.open "PROPPATCH",admnamefold, False
xmlReq.setRequestHeader "Content-Type", "text/xml"
xmlReq.send xmlstring
If xmlReq.status >= 500 Then
wscript.echo "Status: " & xmlReq.status
wscript.echo "Status text: An error occurred on the server."
ElseIf xmlReq.status = 207 Then
wscript.echo "Replica Set sussessfully"
Else
wscript.echo "Status: " & xmlReq.status
wscript.echo "Status text: " & xmlReq.statustext
wscript.echo "Response text: " & xmlReq.responsetext
End If
end sub
Function Octenttostring(OctenArry)
ReDim aOut(UBound(OctenArry))
For i = 1 to UBound(OctenArry) + 1
if ascb(midb(OctenArry,i,1)) <> 0 then
aOut(i-1) = chr(ascb(midb(OctenArry,i,1)))
else
aOut(i-1) = chr(10)
end if
Next
Octenttostring = join(aOUt,"")
End Function
function PublicfolderLDN(Servername)
set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
set conn1 = createobject("ADODB.Connection")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
svcQuery = "<LDAP://" & strNameingContext &
">;(&(objectCategory=msExchExchangeServer)(cn=" & Servername &
"));cn,name,distinguishedName,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = svcQuery
Set Rs = Com.Execute
while not rs.eof
defpf = "(&(objectCategory=msExchPFTree)(msExchPFTreeType=1))"
strQuery = "<LDAP://" & strNameingContext & ">;" & defpf &
";distinguishedName;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs1 = Com.Execute
while not rs1.eof
snameq = "(&(&(objectCategory=msExchPublicMDB)(msExchOwningPFTree=" &
rs1.fields("distinguishedName") _
& ")(msExchOwningServer=" & rs.fields("distinguishedName") & ")))"
strQuery = "<LDAP://" & strNameingContext & ">;" & snameq &
";distinguishedName,legacyExchangeDN;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs2 = Com.Execute
while not rs2.eof
PublicfolderLDN = rs2.fields("legacyExchangeDN")
rs2.movenext
wend
rs1.movenext
wend
rs.movenext
wend
end function