¿Como sacar estadisticas de usuarios de Exchange Active Sync para Exchange 2003?

English Version

Buenos días,
amig@s acá les dejo un script que saca la info de las sincronizaciones de los dispositivos de cada usuario de Exchange 2003 en tu organización. El resultado lo guarda en una planilla excel y lo postea automaticamante en un Sharepoint. La forma de acceso a esta data que está en una carpeta oculta del buzón es webDAV

Este es el código:


#######COMIENZO DEL SCRIPT#################################################

On Error Resume Next
Dim connLDAP
Dim objCOM
Dim rsLDAP
Dim StrSQL
Dim correo
Dim salida,handle,arr(10)
Dim filtro,furl,serverEx,strname,serachAsync2
c=0
t=0
Set ConnLDAP = CreateObject("ADODB.connection")
Set objCOM = CreateObject("ADODB.Command")
connLDAP.Provider = "ADsDSOObject"
connLDAP.Open
   
objCOM.ActiveConnection = connLDAP
objCOM.Properties("searchscope") = 2
objCOM.Properties("Chase referrals") = 64
objCOM.Properties("Cache Results") = False

StrSQL = "SELECT name,distinguishedName FROM 'LDAP://DC=us,DC=contoso,DC=com' where  objectCategory='organizationalUnit' "
wscript.echo "Handle,EAS-Status,Sync-Activated,Device-name,DeviceID,Last-Folder-Sync,Last-update,Exchange-Server,Region"
objCOM.CommandText = StrSQL
Set rsLDAP = objCOM.Execute
While Not rsLDAP.EOF
filtro = "LDAP://" & rsLDAP(0)
if instr(filtro,"OU=All Users ") <> 0  then

Set objUsers = GetObject(filtro)
For Each objUser In objUsers
 if objUser.class="user" then
            strname = objUser.Get("name")
     handle=objUser.Get("samAccountName")
     strWirelessEnabled = objUser.Get("msExchOmaAdminWirelessEnable")
            oRegion=objUser.Get("region")
     strHomeMDB= split(objUser.get("homeMDB"),",")
     if err.number <> 0 then
  err.clear
  noEx=true
     else
  noEx=false
     end if
     if noEx=false then
   if instr(strHomeMDB(0),"MBX") <> 0 then ' -> este filtro es para que no chequee los usuarios de Exchange 2007   else
    serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),11)
    if instr(strHomeMDB(0), "Server_name") = 0 then
     serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),11)
    else
     serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),9)
    end if
    t=t+1
    if strWirelessEnabled = 0 then

     furl ="http://" & serverEx & "/exchange/" & handle & "/NON_IPM_SUBTREE/"
     set req = createobject("microsoft.xmlhttp")
     'WScript.Echo handle & ",Enabled," & SerachAsync(furl) & "," & serverEx
     call SerachAsync(furl)
     if serachAsync2 = "YES" then
      WScript.Echo handle & ",Enabled," & SerachAsync2 & "," & arr(1) & "," & serverEx & "," & oRegion
     else
      WScript.Echo handle & ",Enabled," & SerachAsync2 & "," & "N/A,N/A,N/A,N/A," & serverEx & "," & oRegion
     end if
    c=c+1

    end if
          end if
     end if
 end if             
Next
end if
rsLDAP.MoveNext

Wend


const xlnormal=&HFFFFEFD1
dim appExcel
fecha=replace(date,"/","")
pathFile="d:\reportes\"
file="EASUserReport" & fecha & ".xls"
fileCSV="EASUserReport.csv"

Set appexcel= createObject("Excel.application")
appExcel.workbooks.open pathFile + fileCSV
appexcel.ActiveWorkbook.SaveAs pathFile + file ,xlNormal
appExcel.Workbooks.close
appexcel.quit


const adTypeBinary = 1
const adModeWrite = 2
const adModeReadWrite = 3
user="dominio\user"
pass="Password"
const adCreateOverwrite = &H4000000

dim objStream, objRecord
dim strUrl
strUrl = "http://sharepoint.contoso.com/Report/Shared%20Documents/EAS%20Reports/"
set objRecord = CreateObject("ADODB.Record")
set objStream = CreateObject("ADODB.Stream")

objRecord.Open strUrl + File,"", adModeReadWrite, adCreateOverwrite,,user,pass
objStream.Type = adTypeBinary
objStream.Open  "URL=" + strUrl + File, adModeWrite
objStream.LoadFromFile  File
objStream.Close
objRecord.Close

set objStream = nothing
set objRecord = nothing







sub SerachAsync(furl)

strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT""http://schemas.microsoft.com/mapi/proptag/x3001001E"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True AND "
strQuery = strQuery & """http://schemas.microsoft.com/mapi/proptag/x3001001E"" = 'Microsoft-Server-ActiveSync'</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
if oNodeList.length <> 0 then

 SerachAsync2="YES"
 call displayAyncSub(furl & "/Microsoft-Server-ActiveSync")

else
 SerachAsync2="NO"
end if

end if
'exit
end sub

sub displayAyncSub(furl)
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""http://schemas.microsoft.com/mapi/proptag/x3001001E"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
for each node in oNodeList
'wscript.echo node.text
call displaydeviceSub(furl & "/" & node.text,node.text)
next
Else
End If
end sub



sub displaydeviceSub(furl,fname)
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""http://schemas.microsoft.com/mapi/proptag/x3001001E"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
report=""
for each node in oNodeList
'if instr(fname,"IMEI") = 0 then
k=k+1
report= fname & "," & node.text & "," & finditems(furl & "/" & node.text)
arr(k)=report
'wscript.echo arr(k)
'end if
next

Else
End If

end sub


function finditems(furl)
hascalsyc = 0
hasfolsyc = 0
hasconsyc = 0
hasautd = 0
rback = ""
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""DAV:displayname"",""DAV:getlastmodified"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:isfolder"" = False</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
rem response.write req.responsetext
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:displayname")
set oNodemodlist = oResponseDoc.getElementsByTagName("a:getlastmodified")
'response.write oNodeList.length
for i = 1 to oNodeList.length
set onode = oNodeList.nextNode
Set onode1 = oNodemodlist.nextNode
select case lcase(onode.text)
case "calendarsyncfile" hascalsyc = 1
hascalsycval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
case "foldersyncfile" hasfolsyc = 1
hasfolsycval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
case "contactssyncfile" hasconsyc = 1
hasconsycval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
case "autdstate.xml" hasautd = 1
hasautdval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
end select
next
Else
End If
if hasfolsyc = 1 then
rback = rback & hasfolsycval & ","
else
rback = rback & "No,"
end if
if hasautd <> 0 then
rback = rback & hasautdval
else
rback = rback & "No"
end if
finditems = rback
end function

#######FIN DEL SCRIPT########################################################

Espero que les sirva.Disfrutenlo! dejen sus comentarios por favor
-Dario