Tramite questa pagina ASP è possibile caricare in un server Exchange, mediante script XML, i contatti prelevati da un dB SQL. La struttura dello script risulta semplice.
In pratica prima cancello tutti i contatti presenti nella lista contatti del server exchange, poi creo una stringa XML con le informazini relative al contatto e la invio a l server Exchange che provvederà a registrarla nel lista indicata.
Questo script ha lo scopo di mantenere aggiornata la rubrica clienti/fornitori di Exchange con quella presente nel gestionale aziendale, è per questo che elimina tutti i contatti esistenti prima di inserirne di nuovi. Quindi per aggiungere un contatto in exchange bisogna prima inserirlo nel gestionale aziendale.
In questo script userò delle funzioni personalizzate per l'accesso al database, contenute nei file di inclusione COMMON e DBO. E' possibile utilizzare le funzioni standard per l'accesso al dB o comunque quelle che utilizzate normalemtne.
<%@LANGUAGE="VBSCRIPT"%>
<!--#INCLUDE VIRTUAL="/Libraries/common.asp" -->
<!--#include virtual="/Libraries/DBO.asp" -->
<%
'Imposto la pagina affinchè non rimanga in cache
Response.Expires = 0
Response.Expiresabsolute = Now() - 1
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "no-cache"
'non blocco l'esecuzione in caso di errori
on error resume next%>
<HTML>
<HEAD>
<TITLE>aggiorna contatti</TITLE>
<link href="/Style/style.css" rel="stylesheet" type="text/css">
</HEAD>
<BODY>
<table width="100%" border="0" class="CaratteristicheProdotti">
<%
' VALORIZZAZIONE DELLE COSTANTI
' questo è il tipo di oggetti che vado a cercare nella rubrica
TIPO="a:href"
' immetto le credenziali utente
USER = %NOME_UTENTE%
PWD = %PASSWORD%
' specifico il repository dei contatti
'StrURL = "http://SERVER_EXCHANGE/Exchange/NOME_UTENTE/contatti/"
StrURL = "http://SERVER_EXCHANGE/PUBLIC/RUBRICA"
' CANCELLAZIONE CONTATTI ESISTENTI
'apro la connessione
Dim objX, strR, objXD, objDE
Set objX = CreateObject("Microsoft.XMLHTTP")
objX.Open "PROPFIND", StrURL, FALSE, USER, PWD
'interrogo il server exchange che mi restituisce un file
'xml che contiene la lista degli oggetti nel repository
strR = "<?xml version='1.0'?>"
strR = strR & "<d:propfind xmlns:d='DAV:'>"
strR = strR & "<d:prop><d:displayname/></d:prop></d:propfind>"
objX.SetRequestHeader "Content-type:", "text/xml"
objX.SetRequestHeader "Depth", "1"
objX.send(strR)
'memorizzo l'xml di risposta
set docback = objX.responseXML
Dim objNodeList
' vado a selezionare tra gli oggetti nel file XML
' solo quelli del tipo specificato
Set objNodeList = docback.getElementsByTagName(TIPO)
For i = 0 TO (objNodeList.length -1)
Set objNode = objNodeList.nextNode
'ricavo il nome del file eml
aNome_Elemento = split(objNode.Text,"/")
ultimo = ubound(aNome_Elemento)
'controllo che il file eml non sia un elemento di sistema
if aNome_Elemento(ultimo) <> ""
AND aNome_Elemento(ultimo) <> "Schede%20indirizzi.EML"
then
%>
<tr>
<td nowrap>eliminazione del contatto <strong>"</strong></td>
<td nowrap class="LabelRed"><strong>
<%= replace(aNome_Elemento(ultimo),"%20", " ")%>
</strong></td>
<td><strong>"</strong></td>
<td> </td>
<td> status:
<%
' Apro una nuova connessione
Set objRequest = CreateObject("Microsoft.xmlhttp")
' preparo la richiesta di eliminazione dell'elemento
objRequest.open "DELETE", objNode.Text, False, USER, PWD
' mando al server la richiesta.
objRequest.send
'gestisco gli errori
If (objRequest.Status >= 200 And objRequest.Status < 300) Then
status = "Ok!"
ElseIf objRequest.Status = 401 Then
status="<strong>Spiacente, non hai i privilegi sufficienti!</strong>"
ElseIf (objRequest.Status >= 500 And objRequest.Status < 600) Then
status="<strong>Errore sul server</strong>"
Else
status="<strong>Non riuscito!</strong>"
End If
%> </td>
<td class="LabelRed"><%=status%></td>
</tr>
<%
'distruggo l'oggetto utilizzato
Set objRequest = Nothing
end if
Next
'imposto la connessione al dB
Init_Connessione CONNESSIONE, STRINGA_DI_CONNESSIONE
SQL="SELECT * from TABELLA_CONTATTI where CONDIZIONE"
Init_Recordset rs, CONNESSIONE, SQL
Record = Record_Count(rs) -1
for i = 0 to record
%>
<tr>
<td nowrap>inserimento del contatto <strong>"</strong></td>
<td nowrap class="LabelRed"><strong><%=server.HTMLEncode(rs("NOME"))%>
</strong></td>
<td><strong>"</strong></td>
<td> </td>
<td> status:
<%
' ricavo il nome del file del nuovo contatto
strURLContatto =
strURL &replace(server.HTMLEncode(rs("NOME")),"/", "")&".eml"
' creo l'oggetto xml
Set objRequest = CreateObject("Microsoft.xmlhttp")
' CREAZIONE DEL FILE XML DEL DETTAGLIO DEL CONTATTO
' imposto il namespaces.
strXMLNSInfo = "xmlns:g=""DAV:"" " & _
"xmlns:c=""urn:schemas:contacts:"" " & _
"xmlns:e=""http://schemas.microsoft.com/exchange/"" " & _
"xmlns:mapi=""http://schemas.microsoft.com/mapi/"" " & _
"xmlns:x=""xml:"" xmlns:cal=""urn:schemas:calendar:"" " & _
"xmlns:mail=""urn:schemas:httpmail:"">"
' imposto le informazioni anagrafiche
strNameInfo = "<c:cn>"&server.HTMLEncode(rs("NOME"))&"</c:cn>" & _
"<c:fileas>"&server.HTMLEncode(rs("NOME"))&"</c:fileas>" & _
"<mail:subject>"&server.HTMLEncode(rs("NOME"))&"</mail:subject>"
' imposto le informazioni relative all'ufficio
strBusinessAddrInfo = "<c:street>"&_
server.HTMLEncode(rs("INDIRIZZO"))&_
"</c:street>" & _
"<c:l>"&server.HTMLEncode(rs("CITTA"))&"</c:l>" & _
"<c:st>"&server.HTMLEncode(rs("PROVINCIA"))&"</c:st>" & _
"<c:postalcode>"&server.HTMLEncode(rs("CAP"))&"</c:postalcode>"
' imposto le informazioni relative alla residenza
strHomeAddrInfo = ""
' imposto le informazioni relative agli altri indirizzi disponibili
strOtherAddrInfo = ""
' specifico quale indirizzo è valido per la corrispondenza
' 0 = nessuno, 1 = casa, 2 = ufficio, 3 = altro
strMailAddrInfo = "<c:mailingaddressid>2</c:mailingaddressid>"
' imposto le informazioni relative ai numeri telefonici
strPhoneInfo = "<c:telephoneNumber>"&_
server.HTMLEncode(rs("TELEFONO"))&_
"</c:telephoneNumber>" & _
"<c:facsimiletelephonenumber>"&server.HTMLEncode(rs("FAX"))&_
"</c:facsimiletelephonenumber>" & _
"<c:mobile>"&server.HTMLEncode(rs("CELLULARE_1"))&"</c:mobile>" & _
"<c:othermobile>"&server.HTMLEncode(rs("CELLULARE_2"))&_
"</c:othermobile>"
' imposto le informazioni relative alla mail
strEmailInfo ="<mapi:emaillisttype>1</mapi:emaillisttype>" & _
"<mapi:email1addrtype>SMTP</mapi:email1addrtype>" & _
"<mapi:email1emailaddress>" & server.HTMLEncode(rs("E_MAIL")) & _
"</mapi:email1emailaddress>" & _
"<mapi:email1originaldisplayname>" &server.HTMLEncode(rs("NOME"))& _
"</mapi:email1originaldisplayname>"
' imposto le informazioni relative all'impiego
strOrganizationalInfo = ""
' imposto le informazioni personali
strPersonalInfo = ""
' imposto le informazioni personalizzate
strCustomerInfo=""
'strCustomerInfo = "<c:customerid>YYY</c:customerid>" & _
' "<c:account>YYY</c:account>" & _
' "<c:billinginformation>YYY</c:billinginformation>"
' imposto le informazioni relative ad un eventuale promemoria
strFollowUpInfo =""
'strFollowUpInfo = "<mapi:reminderset>1</mapi:reminderset>" & _
' "<mapi:request>Chiamare</mapi:request>" & _
' "<mapi:remindertime>2004-08-01T08:00:00Z</mapi:remindertime>" & _
' "<mapi:remindernexttime>2004-08-01T08:00:00Z"&_
' "</mapi:remindernexttime>" & _
' "<e:reply-by-iso>2004-08-01T08:00:00Z</e:reply-by-iso>"
' imposto le informazioni varie
strMiscInfo = ""
'strMiscInfo = "<e:keywords-utf8>" & _
' "<x:v>Buddies</x:v><x:v>Engineers</x:v>" & _
' "</e:keywords-utf8>" & _
' "<mapi:contacts><x:v>Brian Johnson</x:v></mapi:contacts>" & _
' "<e:mileage>Rarely used string property</e:mileage>" & _
' "<c:ftpsite>ftp://ftp.example.com/</c:ftpsite>" & _
' "<c:language>US English</c:language>" & _
' "<c:governmentid>000-00-0000</c:governmentid>" & _
' "<c:location>Nowhere Land</c:location>" & _
' "<cal:fburl>http://www.example.com/JoLynnDobney/freebusy"&_
' "</cal:fburl>" & _
' "<mapi:sensitivity>2</mapi:sensitivity>"
' imposto gli attributi personalizzati
strUserFieldsInfo =""
'strUserFieldsInfo = "<e:extensionattribute1>User Data 1" & _
' "</e:extensionattribute1>" & _
' "<e:extensionattribute2>User Data 2</e:extensionattribute2>" & _
' "<e:extensionattribute3>User Data 3</e:extensionattribute3>" & _
' "<e:extensionattribute4>User Data 4</e:extensionattribute4>"
' invio tutto in una richiesta HTTP.
strBody = "<?xml version=""1.0""?>" & _
"<g:propertyupdate " & strXMLNSInfo & _
"<g:set>" & _
"<g:prop>" & _
"<g:contentclass>urn:content-classes:person"&_
"</g:contentclass>" & _
"<e:outlookmessageclass>IPM.Contact"&_
"</e:outlookmessageclass>" & _
strNameInfo & strBusinessAddrInfo & _
strHomeAddrInfo & strOtherAddrInfo & _
strMailAddrInfo & strPhoneInfo & _
strEmailInfo & strOrganizationalInfo & _
strPersonalInfo & strCustomerInfo & _
strFollowUpInfo & strMiscInfo & _
strUserFieldsInfo & _
"</g:prop>" & _
"</g:set>" & _
"</g:propertyupdate>"
' apro l'oggetto
objRequest.open "PROPPATCH", strURLContatto, False, USER, PWD
' imposto gli headers per la richiesta.
objRequest.setRequestHeader "Content-Type", "text/xml"
objRequest.setRequestHeader "Translate", "f"
objRequest.setRequestHeader "Content-Length", Len(strBody)
' invio la richiesta in xml
objRequest.send strBody
'gestisco gli errori
If (objRequest.Status >= 200 And objRequest.Status < 300) Then
status = "Ok!"
ElseIf objRequest.Status = 401 Then
status="<strong>Spiacente, non hai i privilegi sufficienti!</strong>"
ElseIf (objRequest.Status >= 500 And objRequest.Status < 600) Then
status="<strong>Errore sul server</strong>"
Else
status="<strong>Non riuscito!</strong>"
End If
%> </td>
<td class="LabelRed"><%=status%></td>
</tr>
<%
'distruggo l'ogetto
Set objRequest = Nothing
'passo al nuovo record
rs.movenext
next
%>
<!--scrivo il dettaglio riepilogativo-->
<tr>
<td colspan="6"><%=i%> " contatti inseriti</td>
</tr>
</table>
</BODY>
</HTML>