Exemple de mes fonctions qui utilise l'xml !

<%
private function getUserDesc(sOpe)

    Dim oXmlUser
    Dim oDomUser
    Dim item
    Dim sUserForm
    Dim sUserOpt
    Dim i

    Set oXmlUser = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomUser = Server.CreateObject("Msxml2.DOMDocument")

    oXmlUser.open "post", Session("pathDms"), false
    oXmlUser.send "<GetUserDesc>Session("M3CatNewPath")<langue>"& Session("langue") &"</langue></GetUserDesc>"

    oDomUser.loadXML oXmlUser.responseText

    if oXmlUser.responseText = "" then
        Response.Clear
        Response.Write "<br><br><div style='font-family:arial;font-weight:bold;font-size:11pt;color:red;' align='center'>"& dvp_map_gestionUsager_erreur_1 & "</div>"
        Response.End
    end if

    sUserForm = ""
    sUserOpt  = "<select name='userdesc'>"
    For i=0 to oDomUser.getElementsByTagName("user").length - 1
       
        sUserOpt = sUserOpt &"<option value='"& oDomUser.getElementsByTagName("userlogn").item(i).text &"'>" & _
                   oDomUser.getElementsByTagName("username").item(i).text & _
                   " - "&oDomUser.getElementsByTagName("userlogn").item(i).text &"</option>"
       
        sUserForm = sUserForm &"<form name='"& oDomUser.getElementsByTagName("userlogn").item(i).text &"' action='adm_info.asp?"& sOpe &"' method='post'>" & _
                    "<input type='hidden' name='userlogn' value='"& oDomUser.getElementsByTagName("userlogn").item(i).text &"'>" & _
                    "<input type='hidden' name='username' value='"& oDomUser.getElementsByTagName("username").item(i).text &"'>" & _
                    "<input type='hidden' name='userpasw' value='"& oDomUser.getElementsByTagName("userpasw").item(i).text &"'>" & _
                    "<input type='hidden' name='userlang' value='"& oDomUser.getElementsByTagName("userlang").item(i).text &"'>" & _
                    "<input type='hidden' name='userrole' value='"& oDomUser.getElementsByTagName("userrole").item(i).text &"'>" & _
                    "<input type='hidden' name='userlevl' value='"& oDomUser.getElementsByTagName("userlevl").item(i).text &"'>" & _
                    "<input type='hidden' name='userpath' value='"& oDomUser.getElementsByTagName("userpath").item(i).text &"'>" & _
                    "<input type='hidden' name='usertemp' value='"& oDomUser.getElementsByTagName("usertemp").item(i).text &"'>" & _
                    "</form>"
    next
   
    sUserOpt = sUserOpt &"</select></form>"
   
    Set oDomUser = Nothing
    Set oDomUser = Nothing

    Response.Write sUserOpt
    Response.Write sUserForm

end function

'******************************************************************************
'*      Fonction qui retourne la liste des langues disponibles en             *
'*      envoyant une requête XML et reçoit le résultat en XML.                *
'******************************************************************************
private function getLangue(sSelection)

    Dim oXmlLangue
    Dim oDomLangue
    Dim oNode
    Dim item
    Dim sLangue
    Dim sSelect
    Dim i

    Set oXmlLangue = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomLangue = Server.CreateObject("Msxml2.DOMDocument")

    oXmlLangue.open "post", Session("pathDms"), false
    oXmlLangue.send "<GetUserDesc>Session("M3CatNewPath")<langue>"& Session("langue") &"</langue></GetUserDesc>"

    oDomLangue.loadXML oXmlLangue.responseText

    if oXmlLangue.responseText = "" then
        Response.Clear
        Response.Write "<br><br><div style='font-family:arial;font-weight:bold;font-size:11pt;color:red;' align='center'>"& dvp_map_gestionUsager_erreur_1 & "</div>"
        Response.End
    end if

    sLangue = ""
    For i=0 to oDomLangue.getElementsByTagName("langue").length - 1
       
        sSelect = ""
        if oDomLangue.getElementsByTagName("codelang").item(i).text = sSelection then
            sSelect = "Selected"
        end if
        sLangue = sLangue &"<option value='"& oDomLangue.getElementsByTagName("codelang").item(i).text &"' "& sSelect &"> " & _
                  oDomLangue.getElementsByTagName("taglang").item(i).text &"</option>"
    next

    Set oXmlLangue = Nothing
    Set oDomLangue = Nothing

    getLangue = sLangue

end function

'******************************************************************************
'*      Fonction qui retourne la liste des rôles disponibles en               *
'*      envoyant une requête XML et reçoit le résultat en XML.                *
'******************************************************************************
private function getRole(sSelection)

    Dim oXmlRole
    Dim oDomRole
    Dim oNode
    Dim item
    Dim sRole
    Dim sSelect
    Dim i
    Dim bRole

    Set oXmlRole = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomRole = Server.CreateObject("Msxml2.DOMDocument")

    oXmlRole.open "post", Session("pathDms"), false
    oXmlRole.send "<GetUserDesc><m3catPath>"& Session("M3CatNewPath") &"</m3catPath><langue>"& Session("langue") &"</langue></GetUserDesc>"

    oDomRole.loadXML oXmlRole.responseText

    sRole = ""
    bRole = false
    For i=0 to oDomRole.getElementsByTagName("role").length - 1

        sSelect = ""
        if oDomRole.getElementsByTagName("coderole").item(i).text = sSelection then
            sSelect = "Selected"
            bRole = true
        elseif oDomRole.getElementsByTagName("coderole").item(i).text = "B" and not bRole then
            sSelect = "Selected"
        end if
        sRole = sRole &"<option value='"& oDomRole.getElementsByTagName("coderole").item(i).text &"' "& sSelect &"> " & _
                oDomRole.getElementsByTagName("tagrole").item(i).text &"</option>"
    next

    Set oXmlRole = Nothing
    Set oDomRole = Nothing

    getRole = sRole

end function

'******************************************************************************
'*      Fonction qui retourne la liste des niveaux disponibles en             *
'*      envoyant une requête XML et reçoit le résultat en XML.                *
'******************************************************************************
private function getLevel(sSelection)

    Dim oXmlLevel
    Dim oDomLevel
    Dim oNode
    Dim item
    Dim sLevel
    Dim sSelect
    Dim i

    Set oXmlLevel = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomLevel = Server.CreateObject("Msxml2.DOMDocument")

    oXmlLevel.open "post", Session("pathDms"), false
    oXmlLevel.send "<GetUserDesc><m3catPath>"& Session("M3CatNewPath") &"</m3catPath><langue>"& Session("langue") &"</langue></GetUserDesc>"

    oDomLevel.loadXML oXmlLevel.responseText

    sLevel = ""
    For i=0 to oDomLevel.getElementsByTagName("level").length - 1
       
        sSelect = ""
        if oDomLevel.getElementsByTagName("codelevl").item(i).text = sSelection then
            sSelect = "Selected"
        end if
        sLevel = sLevel &"<option value='"& oDomLevel.getElementsByTagName("codelevl").item(i).text &"' "& sSelect &"> " & _
                oDomLevel.getElementsByTagName("taglevl").item(i).text &"</option>"
    next

    Set oXmlLevel = Nothing
    Set oDomLevel = Nothing

    getLevel = sLevel

end function

'******************************************************************************
'*      Fonction qui retourne la liste des gabarits disponibles en            *
'*      envoyant une requête XML et reçoit le résultat en XML.                *
'******************************************************************************
private function getGabarit(sSelection)

    Dim oXmlGabarit
    Dim oDomGabarit
    Dim oNode
    Dim item
    Dim sGabarit
    Dim sSelect
    Dim i

    Set oXmlGabarit = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomGabarit = Server.CreateObject("Msxml2.DOMDocument")

    oXmlGabarit.open "post", Session("pathDms"), false
    oXmlGabarit.send "<GetUserDesc><m3catPath>"& Session("M3CatNewPath") &"</m3catPath><langue>"& Session("langue") &"</langue></GetUserDesc>"

    oDomGabarit.loadXML oXmlGabarit.responseText

    sGabarit = ""
    For i=0 to oDomGabarit.getElementsByTagName("template").length - 1
       
        sSelect = ""
        if oDomGabarit.getElementsByTagName("codetemp").item(i).text = sSelection then
            sSelect = "Selected"
        end if
        sGabarit = sGabarit &"<option value='"& oDomGabarit.getElementsByTagName("codetemp").item(i).text &"' "& sSelect &"> " & _
                   oDomGabarit.getElementsByTagName("tagtemp").item(i).text &"</option>"
    next

    Set oXmlGabarit = Nothing
    Set oDomGabarit = Nothing

    getGabarit = sGabarit

end function

'******************************************************************************
'*      Procédure qui soumet l'ajout d'un nouvel usager.                      *
'******************************************************************************
private function ajoutUsager(sUserLogn, sUserName, sUserPasw, sUserLang, sUserRole, sUserLevl, sUserTemp, sUserPath)

    Dim oXmlAjout
    Dim oDomAjout
    Dim oNode
    Dim item
    Dim sErreur
    Dim i

    Set oXmlAjout = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomAjout = Server.CreateObject("Msxml2.DOMDocument")

    oXmlAjout.open "post", Session("pathDms"), false
    oXmlAjout.send "<DoAddUser>" & _
                   "<userlogn>"& sUserLogn &"</userlogn>" & _
                   "<username>"& sUserName &"</username>" & _
                   "<userpasw>"& sUserPasw &"</userpasw>" & _
                   "<userlang>"& sUserLang &"</userlang>" & _
                   "<userrole>"& sUserRole &"</userrole>" & _
                   "<userlevl>"& sUserLevl &"</userlevl>" & _
                   "<userpath>"& sUserPath &"</userpath>" & _
                   "<usertemp>"& sUserTemp &"</usertemp>" & _
                   "</DoAddUser>"

    oDomAjout.loadXML oXmlAjout.responseText

    sErreur = ""
    if oDomAjout.getElementsByTagName("Message").length > 0 then
        sErreur = oDomAjout.getElementsByTagName("Message").item(0).text
    end if

    Set oXmlAjout = Nothing
    Set oDomAjout = Nothing

    ajoutUsager = sErreur

end function

'******************************************************************************
'*      Procédure qui soumet la modification d'un usager.                     *
'******************************************************************************
private function modifUsager (sUserLognOld, sUserLogn, sUserName, sUserPasw, sUserLang, sUserRole, sUserLevl, sUserTemp, sUserPath)

    Dim oXmlModif
    Dim oDomModif
    Dim oNode
    Dim item
    Dim sErreur
    Dim i

    Set oXmlModif = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomModif = Server.CreateObject("Msxml2.DOMDocument")

    oXmlModif.open "post", Session("pathDms"), false
    oXmlModif.send "<DoUpdtUser>" & _
                   "<oldlogn>"& sUserLognOld &"</oldlogn>" & _
                   "<userlogn>"& sUserLogn &"</userlogn>" & _
                   "<username>"& sUserName &"</username>" & _
                   "<userpasw>"& sUserPasw &"</userpasw>" & _
                   "<userlang>"& sUserLang &"</userlang>" & _
                   "<userrole>"& sUserRole &"</userrole>" & _
                   "<userlevl>"& sUserLevl &"</userlevl>" & _
                   "<userpath>"& sUserPath &"</userpath>" & _
                   "<usertemp>"& sUserTemp &"</usertemp>" & _
                   "</DoUpdtUser>"

    oDomModif.loadXML oXmlModif.responseText

    sErreur = ""
    if oDomModif.getElementsByTagName("Message").length > 0 then
        sErreur = oDomModif.getElementsByTagName("Message").item(0).text
    end if

    Set oXmlModif = Nothing
    Set oDomModif = Nothing

    modifUsager = sErreur

end function

'******************************************************************************
'*      Procédure qui soumet la suppression d'un usager.                      *
'******************************************************************************
private function supprUsager (sUserLogn)

    Dim oXmlSuppr
    Dim oDomSuppr
    Dim oNode
    Dim item
    Dim sErreur
    Dim i

    Set oXmlSuppr = Server.CreateObject("Msxml2.ServerXMLHTTP")
    Set oDomSuppr = Server.CreateObject("Msxml2.DOMDocument")

    oXmlSuppr.open "post", Session("pathDms"), false
    oXmlSuppr.send "<DoDelUser>" & _
                   "<userlogn>"& sUserLogn &"</userlogn>" & _
                   "</DoDelUser>"

    oDomSuppr.loadXML oXmlSuppr.responseText

    sErreur = ""
    if oDomSuppr.getElementsByTagName("Message").length > 0 then
        sErreur = oDomSuppr.getElementsByTagName("Message").item(0).text
    end if

    Set oXmlSuppr = Nothing
    Set oDomSuppr = Nothing

    supprUsager = sErreur

end function
%>