| Dal jsem si kdysi práci a udělal si skriptík na testování Autodiscover přístupu. To je taková ta fíčura Exchange Server 2007 a 2010, která umožňuje Outlooku vyhledat si automaticky informace o přístupu k mailboxu. A už se mi to několikrát hodilo, takže pokud chcete, můžete ho (na vlastní nebezpečí) používat taky.
Cílem skriptu je, po zadání nějakých základních informací, vytáhnout z Autodiscover webové služby výsledné XML, aby se člověk mohl podívat, jestli to vůbec jede, nebo co se z toho nakonec Outlook dozví. Hodí se to použít z venku, když Autodiscover publikujete přes TMG (Threat Management Gateway) nebo ISA Server.
Takže tu je. Prostě si to vložíte do VBS souboru. Lze to pustit z venku i zevnitř sítě, jen musíte zvolit správné jméno CAS serveru. Výsledné XML je zobrazeno, ale také uloženo do souboru, aby to šlo lépe prohlížet:
' Script to test Exchange Server 2007 or Exchange Server 2010 Autodiscover service
' You need to supply the CAS public or private FQDN. The FQDN that you supply is appended
' with https:// prefix automatically. The script then tries to obtain the .XML output
' from the service for the particular user you specified. You need to provide a user's
' login and password because this may be different when publishing with ISA Server or TMG
'
' (C) 2011, Ondrej Sevecek, www.sevecek.com, ondrej@sevecek.com
defDnsName = "s-ex1.gopas.local"
defClientEmail = "sevecek-user@gopas.cz"
defClientLogin = "gopas\sevecek"
defClientPwd = "rumcajs.35"
dnsName = InputBox("FQDN of the Autodiscover service (either internal or public FQDN)", _
"Autodiscover", defDnsName)
if dnsName = "" then WScript.Quit
clientEmail = InputBox("User email address", "Autodiscover", defClientEmail)
if clientEmail = "" then WScript.Quit
clientLogin = InputBox("User AD login", "Autodiscover", defClientLogin)
if clientLogin = "" then WScript.Quit
clientPwd = InputBox("User AD password", "Autodiscover", defClientPwd)
if clientPwd = "" then WScript.Quit
requestXml = _
"" & _
clientEmail & _
"http://schemas.microsoft.com/exchange/" & _
"autodiscover/outlook/responseschema/2006a"
set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "POST", "https://" & dnsName & "/Autodiscover/Autodiscover.Xml"
http.SetRequestHeader "User-Agent", "MSRPC"
http.SetRequestHeader "Content-Type", "text/xml"
http.SetCredentials clientLogin, clientPwd, 0
on error resume next
http.Send(requestXml)
if (Err <> 0) then
errorRes = MsgBox("Error: " & Err.Number & " (0x" & Hex(Err.Number) & ")" & vbCrLf & _
"Description: " & Err.Description & vbCrLf & "Do you want to try the operation again?" & vbCrLf & _
"This time the connection would be attempted without SSL certificate checks.", vbYesNo, "Error")
if errorRes = vbYes then
on error goto 0
' WINHTTP_OPTION_SECURITY_FLAGS
' SECURITY_FLAG_IGNORE_CERT_CN_INVALID = 0x00001000
' SECURITY_FLAG_IGNORE_CERT_DATE_INVALID = 0x00002000
' SECURITY_FLAG_IGNORE_UNKNOWN_CA = 0x00000100
' SECURITY_FLAG_IGNORE_CERT_WRONG_USAGE = 0x00000200
' SECURITY_FLAG_STRENGTH_MEDIUM = 0x40000000 - 56bit encryption
' SECURITY_FLAG_STRENGTH_STRONG = 0x20000000 - 128bit encryption
' SECURITY_FLAG_STRENGTH_WEAK = 0x10000000 - 40bit encryption
http.Option(4) = &H3300
http.Send(requestXml)
else
WScript.Quit
end if
end if
on error goto 0
respns = http.ResponseTextWSCript.Echo "HTTP Status: " & http.Status & vbCrLf & "===========" & _
vbCrLf & vbCrLf & respns
set fso = CreateObject("Scripting.FileSystemObject")
set outFile = fso.CreateTextFile("autodiscoverTesting-Result.Xml", true, true)
respns = Replace(respns, "encoding=""utf-8""", "encoding=""unicorespns = Replace(respns, _
"encoding=""utf-8""", "encoding=""unicode""")
outFile.WriteLine respns
|