Partagez vos meilleurs sources ASP. Vous pouvez ajouter vos commentaires :o)

[Immobilis]

Salut,

Comme souvent on a de bonnes idées pour se faciliter la vie pourquoi ne pas en faire profiter tout le monde?

Ajouter tout ce qui peux aider à la suite de ce message.

Merci

----------------------------------------------------------------------------
----------------------------------------------------------------------------

Salut à tous (débutants comme confirmés),

Voici un retour sur experience qui peut se résumer ainsi:
UTILISEZ DES CLASSES!!!

Je m'explique (et ça n'engage que moi).

L'informatique c'est pour les fainéants (j'en suis un gros). Je ne rechigne pas à la tâche, mais quand mon PC peut bosser à ma place, je suis content.

En conséquence cherchez toujours à vous économisez vous bosserez moins et vous gagnerez plus (de temps...).

Comment? En ecrivant le moins de code possible pardi!!
Je vois souvent des kilomètres de codes linéaires! A mort! Ne répétez jamais deux fois le même code. FACTORISEZ.

Et en pratique? Comme dit le post précédent allez voir le tuto sur les classes. Si vous ne comprennez pas (j'avoue que j'ai eu du mal la première fois) voici un exemple sur lequel méditer:

1 - Créez une page "cls_Parent.asp"
2 - Collez ce code dedans. Sauvegardez.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
<%Class Parent
    Private NomPere_
    Private NomMere_
 
    Private Sub Class_Initialize
        NomPere_ = null
        NomMere_ = null
    End Sub
 
    Private Sub Class_Terminate
        NomPere_ = null
        NomMere_ = null
    End Sub
 
    Public Default Property Get DefaultProperty
        DefaultProperty = "Parent"
    End Property
 
    Public Property Let NomPere(s)
        NomPere_ = s
    End Property
 
    Public Property Get NomPere
        NomPere = NomPere_
    End Property
 
    Public Property Let NomMere(s)
        NomMere_ = s
    End Property
 
    Public Property Get NomMere
        NomMere = NomMere_
    End Property
End Class
%>

3 - Créez une page "cls_Enfant.asp"
4 - Collez ce code dedans. Sauvegardez.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
<%
Class Enfant
    Private Prenom_
    Private objParent_
 
    Private Sub Class_Initialize
        Prenom_ = null
        Set objParent_ = Nothing
    End Sub
 
    Private Sub Class_Terminate
        Prenom_ = null
        Set objParent_ = Nothing
    End Sub
 
    Public Default Property Get DefaultProperty
        DefaultProperty = "Enfant"
    End Property
 
    Public Property Get oParent
        Set oParent = objParent_
    End Property
 
    Public Property Set oParent(o)
        Set objParent_ = o
    End Property
 
    Public Property Get Prenom
        Prenom = Prenom_
    End Property
 
    Public Property Let Prenom(s)
        Prenom_ = s
    End Property
 
End Class
%>

5 - Créez une page "Test.asp"
6 - Collez ce code dedans. Sauvegardez.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
<%@ LANGUAGE="VBSCRIPT" CODEPAGE="1252"
Option Explicit%>
<!--#include file="cls_Parent.asp" -->
<!--#include file="cls_Enfant.asp" -->
 
<%
Dim p, e
Set p = new Parent
    Response.Write p & "<br />"
    p.NomPere = "Joseph"
    Response.Write p.NomPere & "<br />"
    Set e = new Enfant
        Set e.oParent = p
        e.Prenom = "Jésus"
        Response.Write e.oParent.NomPere & " est le père de " & e.Prenom & "<br />"
        e.oParent.NomMere = "Marie"
        Response.Write p.NomMere & "<br />" & e.oParent.NomMere & " est la mère de " & e.Prenom & "<br />"
    Set e = Nothing
Set p = Nothing
%>

7 - Executez "Test.asp"
8 - Méditez
9 - Poses vos question si vous en avez.

Vous aurez une approche objet de l'ASP. Très utile pour passer au .NET par la suite.

A+

[Immobilis]

Re,

Sympa ces histoires de familles, mais comment pouvez-vous transposer cet exemple à quelque chose d'utile pour vous?
Et bien c'est super simple. Je vois souvent des chaines de connections dans chacune de vos pages. Du code qui ressemble à ceci:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
 
<title>Ma page</title>
 
</head>
 
<body>
<%
Dim Provider, oConn, oCm, oRs
strProvider = "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.Mappath("MaBase.mdb") & ";"
set oConn = server.createobject("ADODB.Connection")
 
oConn.Open strProvider
 
set oCm = Server.CreateObject("ADODB.Command")
oCm.ActiveConnection = oConn
%>

Je le sais, j'ai commencé comme ça!
Cette façon de faire pose un énorme problème. Le jour où vous déplacez, renommez ou migrez la base vers du SQL, il faut retrouver toutes les occurences de la chaine de connection et les modifier.
Voici comment faire mieux.
Principe: on va créer une classe qui va se charger de nous fournir la connection dont on a besoin.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
<%
' Afin de rester simple, toutes les propriétés Get, Let, Set ne figurent pas.
Class DBFactory
 
        ' Les variable privées sont inaccessibles depuis l'exterieur
        ' nous les consulterons par l'intermediaire de leurs propriétés nommées "accessers".
        ' Les accessers sont comme des fonctions.
        Private m_Provider ' variable privée de la chaine de connection
        Private m_oCn ' objet privée de connection
        Private m_oCm ' objet privé de command
 
        ' Ce que va faire la classe au moment de son instanciation
        ' 1 - Créer une connection ADO
        ' 2 - Créer une command ADO
        Private Sub Class_Initialize
                Set m_oCn = Server.CreateObject("ADODB.Connection")
                Set m_oCm = Server.CreateObject("ADODB.Command")
                ' A ce stade les objets m_oCn et m_oCm ne sont pas utilisables car non "connectés". Il faut récupérer la chaine de connection
        End Sub
 
        ' Ce que va faire la classe au moment de sa destruction
        ' 1 - detruire l'objet command
        ' 2 - fermer la connection si elle est encore ouverte
        ' 3 - détruire l'objet connection
        Private Sub Class_Terminate
                Set m_oCm = Nothing
                If m_oCn.State = 1 then m_oCn.Close()
                Set m_oCn = Nothing
        End Sub
 
        ' Permet :
        ' 1 - D'assigner la chaine de connection
        ' 2 - Ouvrir la connection
        ' 3 - De lier l'objet Command à la connection
	Public Property Let Provider(s)
                m_Provider = s
                ' Au moment où nous allons assigner une valeur à la chaine de connection, nous allons l'ouvrir.
                m_oCn.ConnectionString = m_Provider
                m_oCn.Open()
                ' Nous lions la command à l'objet connection
                m_oCm.ActiveConnection = m_oCn
	End Property
 
        ' Cette propriété execute la requete SQL et renvoi le recordset correspondant
        Public Function ExecuteQuery(s)
            m_oCm.CommandText = s
                Set ExecuteQuery = m_oCm.Execute()
        End Function
End Class
%>

Pour réutiliser ce code dans vos pages il suffit de faire

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
<!-- #include file="DBFactory.asp" -->
<%
Dim db, rs
 
Set db = new DBFactory
    db.Provider = Application("ChaineDeConnection")
    Set rs = db.ExecuteQuery("SELECT TOP 10 * FROM MATABLE;")
        (...)
    Set rs = Nothing
Set db = Nothing
%>

C'est une façon de faire. Il en existe bcp d'autres. On peut ainsi se constituer une sorte de FrameWork.

A+

[Immobilis]

Re,

Bon, continuons sur notre lancée sur la question de l'organisation d'une page.
Ici encore, il y a plusieurs façons mais grosso modo, je dirais:

1. Linéaire
2. Modulaire

La méthode linéaire est la première à laquelle on pense (surtout quand on débute j'en sais quelquechose). Le code HTML et le code de script se mélangent et s'executent dans l'ordre depuis le début jusqu'à la fin de la page. On n'y trouve pas de procédure ni de fonction. J'ai beau chercher, je ne trouve pas (plus) d'intérêts à l'utiliser. Ah si, cela permet à votre EDI préféré de renvoyer un rendu de votre page quand vous passez en mode "design".

Au contraire, la méthode modulaire permet de découper le code et d'en executer tout ou partie selon le résultat qu'on souhaite obtenir. On a tout à gagner à isoler des bouts de codes. Principal avantage: la possibiliter de les réutiliser dans d'autres pages, de ne pas avoir à réécrire deux fois la même chose donc de diminuer la maintenance, du même coup, diminuer le risque d'erreurs, moins de plantages, des utilisateurs et un patron heureux. Bon, évidement c'est moins joli en mode "design" mais ça fait très pro.

Dans le meilleur des cas (à mon sens), une page "modulaire" ne contient que des procédures, fonctions ou classes. Dans tous les cas PAS de code HTML en dehors. En voici un plan:

1. Une procédure principale qui va piloter la page. On l'appelera "Main". C'est court et ça veut dire "principal".
2. Des procédures/fonctions secondaires qui sont autant d'outils.

Parmis ces outils on peut compter un moyen :

1. de se connecter à une base de données
2. de récupérer des paramètres issue de l'URL ou d'un formulaire
3. de mettre à jour une base de données
4. faire des calculs
5. de récupérer des informations d'une base de données
6. d'afficher un contenu pour l'internaute
7. d'envoyer des emails
8. plein de trucs super sympa...
9. de se déconnecter

Comme exemple, prenons un simple formulaire de recherche:

Code :

1
2
3
4
5
6
 
<!-- Si je mets rien dans action cela envoi le formulaire sur la même page -->
<form action="" id="form" method="post" name="search" >
	<input id="txtNom" name="txtNom" type="text" />
	<input id="action" name="action" type="submit" />
</form>

Le code pour traiter les données du formulaire pourrait ressembler à:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
<!-- #include file="DBFactory.asp" -->
<%
Dim db, rs
 
' ATTENTION: on réutilise la classe DBFactory mais modifiée de telle façon que
' la chaine de connection soit directement assigné dans la classe. C'est toujours ça de moins à répéter.
Set db = new DBFactory
    Set rs = db.ExecuteQuery("SELECT USER_LNAME AS NOM, USER_FNAME AS PRENOM FROM [USERS] WHERE USER_LNAME LIKE '%" & Request.Form("txtName") & "%';")
        If not rs.EOF then
		Do While not rs.EOF
			Response.Write "Nom : " & rs("NOM") & ", Prénom : " & rs("PRENOM") & "<br />"
			rs.Movenext
		Loop
	Else
		Response.Write "Pas de résultat."
	End if
    Set rs = Nothing
Set db = Nothing
%>

Pour le moment tout cela n'est pas encore très modulaire. Voici comment faire:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
' On déclare les variables et objets globaux
Dim db ' Notre objet de base de données
 
' On appel la procédure principale et on lui passe le contenu du formulaire
Call Main(Request.Form)
 
' La procédure reçoit le formulaire auquel on fera référence en utilisant "frm"
Public Sub Main(frm)
	' Appel de la procédure "Connect" pour instancier l'objet "db"
	Call Connect
 
	' Affichage du formulaire
	Call DisplayForm(frm)
 
	' Vérifions si la page reçoit des données du formulaire
	If Len(frm) > 0 then
		' Le formulaire contient des données.
		' On appel la procédure résponsable de l'affichage du résultat.
		' On lui passe les données du formulaire
		Call DisplayResult(frm)
	Else
		Call DisplayMessage()
	End if
 
	' Appel de la procédure "Disconnect" pour détruire l'objet "db"
	Call Disconnect
End Sub
 
Public Sub Connect
	Set db = new DBFactory
End Sub
 
Public Sub DisplayForm(frm)
	Response.Write "<form action="""" id=""form"" method=""post"" name=""search"" >" & _
		"	<input id=""txtNom"" name=""txtNom"" type=""text"" value=""" & frm("txtNom") & """ />" & _
		"	<input id=""action"" name=""action"" type=""submit"" value=""Search"" />" & _
		"</form><br />"
End Sub
 
Public Sub DisplayResult(frm)
    Dim rs ' Déclaration d'un recordset.
 
    ' Inutile de créer un objet recordset car ce sera fait automatiquement par la fonction "ExecuteQuery"
    Set rs = db.ExecuteQuery("SELECT USER_LNAME AS NOM, USER_FNAME AS PRENOM FROM [USERS] WHERE USER_LNAME LIKE '%" & frm("txtName") & "%';")
    If not rs.EOF then
        Response.Write "Voici le résultat de la recherche de: " & frm("txtNom") & ".<br />"
        Do While not rs.EOF
            Response.Write "Nom : " & rs("NOM") & ", Prénom : " & rs("PRENOM") & ".<br />"
            rs.Movenext
        Loop
    Else
        Response.Write "Il n'y a pas de résultat pour la recherche de: " & frm("txtNom") & ".<br />"
    End if
    Set rs = Nothing
End Sub
 
Public Sub DisplayMessage()
	Response.Write "Veuillez saisir un nom et lancer la recherche."
End Sub
 
Public Sub Disconnect
	Set db = Nothing
End Sub

Vous pouvez constater que ce code ne contient que des procédures. Il devient donc très facile d'y faire appel dans l'ordre qu'on souhaite ou pas du tout, d'en intercaler d'autres qui viendront enrichir la page.
De plus, la procédure "Main" indique clairement le déroulement de la page.
A+

[Immobilis]

Re,

Si on faisait un page comme en .NET, c'est à dire une page que ne serait qu'une classe?
Pour ceux qui font un peu de .NET, on sait que les pages aspx sont des classes et que lorsque qu'elles sont lancée il se produit un évènement "Page_Load". Cet évènement se produit toujours. En ASP3 on pourrait faire la similitude avec la méthode Class_Initialize.
On peut transformer le code de mon précédent post en une classe.

Tout d'abords, voici la dernière version de la classe DBFactory. J'ai ajouté deux méthodes l'une permet à partir d'un recordset de générer le code HTML d'un tableau, l'autre de créer une liste déroulante:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
<%
Class DBFactory
    Private m_Provider
    Private m_oCn
    Private m_oCm
 
    Private Sub Class_Initialize
        Set m_oCn = Server.CreateObject("ADODB.Connection")
        Set m_oCm = Server.CreateObject("ADODB.Command")
        m_oCn.ConnectionTimeout = 30
        Me.Provider = Application("ConnectionString")
    End Sub
 
    Private Sub Class_Terminate
        Set m_oCm = Nothing
        If m_oCn.State = 1 then m_oCn.Close()
        Set m_oCn = Nothing
    End Sub
 
    Public Default Property Get DefaultProperty
		DefaultProperty = "Class DBFactory"
    End Property
 
    Public Property Let Provider(s)
        m_Provider = s
        m_oCn.ConnectionString = m_Provider
        m_oCn.Open()
        m_oCm.ActiveConnection = m_oCn
    End Property
 
    Public Property Get Connection
        Set Connection = m_oCn
    End Property
 
    Public Property Get Command
        Set Command = m_oCm
    End Property
 
    Public Function ExecuteQuery(s)
        m_oCm.CommandText = s
        Set ExecuteQuery = m_oCm.Execute()
    End Function
 
    Public Sub RsToTable(rs, classname)
        Dim i
        response.Write("<table class=""" & classname & """>"  & vbcrlf)
        for i= 0 to rs.fields.count-1
            response.write ("<th>" & rs.fields(i).name & "&nbsp;</th>" & vbcrlf)
        next 
        Do while not rs.eof 
            response.Write("<tr>" & vbcrlf)
            for i= 0 to rs.fields.count-1 
                response.write ("<td>" & rs.fields(i).value & "&nbsp;</td>" & vbcrlf)
            next 
            response.Write("<tr>" & vbcrlf)
            rs.movenext 
        loop
        response.Write("</table>" & vbcrlf)
    End Sub
 
    Public Sub RsToDDListe(rs, classname, selectedvalue, id)
        response.Write("<select class=""" & classname & """ id=""" & id & """ name=""" & id & """>"  & vbcrlf)
        Do while not rs.eof
            If strcomp(selectedvalue,rs.fields(0).value) = 0 then
                response.write ("<option value=""" & rs.fields(0).value & """ selected = ""selected"">" & rs.fields(1).value & "</option>" & vbcrlf)
            Else
                response.write ("<option value=""" & rs.fields(0).value & """>" & rs.fields(1).value & "</option>" & vbcrlf)
            End if
            rs.movenext 
        loop
        response.Write("</select>" & vbcrlf)
    End Sub
End Class
%>

Ensuite, voici le code de la page de recherche:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
<%@ LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<% Option Explicit%>
 
<!--#include file="DBFactory.asp" -->
 
<%
' Cette section est destinée à lancer l'execution de la classe.
' On ne passe pas d'arguments.
Dim rech
Set rech = new Recherche
Set rech = Nothing
 
Class Recherche
	Private bd_
 
	' Cette procédure se lance au moment de l'instanciation de la classe Recherche
	Private Sub Class_Initialize
        Set bd_ = new DBFactory
		' Affichage de l'entête
        Header
		' Affichage du formulaire. Passage de la totalité du formulaire
		DisplayForm(Request.Form)
		' Affichage du résultat. Passage de la totalité du formulaire
		DisplayResult(Request.Form)
		' Affichage du pied de page
		Footer
	End Sub
 
	' Cette procédure se lance au moment de la fin de l'execution de la page.
	Private Sub Class_Terminate
        Set bd_ = Nothing
	End Sub
 
	Private Sub Header
	    %>
	    <html>
	    <head>
	        <title>Recherche</title>
	        <style type="text/css">
	            body
	            {
	                font-family:Arial;
	                font-size:1em;
	            }
	            table
	            {
	                border-collapse:collapse;
	                border: solid 1px black;
	                font-size:0.8em;
	            }
	            th
	            {
	                background-color:Silver;
	                border: solid 1px black;
	                font-weight:bold;
                }
	            td
	            {
	                border: solid 1px black;
	            }
	        </style>
	    </head>
 
	    <body>
	    <%
	End Sub
 
	Private Sub Footer
	    %>
	    </body>
	    </html>
	    <%
	End Sub
 
	Private Sub DisplayForm(frm)
		Response.Write "<form action="""" id=""form"" method=""post"" name=""search"" >" & _
			"	<input id=""txtNom"" name=""txtNom"" type=""text"" value=""" & frm("txtNom") & """ />" & _
			"	<input id=""action"" name=""action"" type=""submit"" value=""Search"" />" & _
			"</form><br />"
	End Sub
 
	Private Sub DisplayResult(frm)
	    Dim rs, i
 
		If len(frm("txtNom")) > 0 then
		    Response.Write "Voici le résultat de la recherche:<br />"
		    Set rs = bd_.ExecuteQuery("SELECT * FROM [USER] WHERE User_Lname LIKE '%" & frm("txtNom") & "%';")
                Call bd_.RsToTable(rs, "")
		    Set rs = Nothing
		Else
			Response.Write "Veuillez saisir un nom et lancer la recherche."
		End If
	End Sub
End Class
 
%>

L'initialisation de la classe provoque l'affichage de l'entête, puis du formulaire, puis du résultat et enfin du pied de page. La finalisation de la classe provoque la destruction des objets créés au cours de l'exécution du code.

N'hésitez pas à me dire si j'ai laissé un bug ou à faire des suggestion.

A+

[Immobilis]

Salut,

Voici une classe pour récupérer les principales informations d'une page ASP

1. ServerVariables
2. Session
3. Application
4. Cookies
5. Request.Form
6. Request.QueryString
7. Une propriété "IsPostBack"

Elle génère un tableau ou un fichier XML.
Qu'en pensez-vous?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
<%
Class HttpContext
    Private HttpContext_
    Private Arr_Keys
    Private Arr_Names
    Private IsPostBack_
 
    Private Sub Class_Initialize
        Set HttpContext_ = Server.CreateObject("Scripting.Dictionary")
        GrabServerVariables
        GrabApplication
        GrabSession
        GrabCookies
        GrabForm
        GrabQueryString
        SetArrays
    End Sub
 
    Private Sub Class_Terminate
        Set HttpContext_ = Nothing
    End Sub
 
    Public Default Property Get DefaultProperty
        DefaultProperty = "Class HttpContext"
    End Property
 
    ' Nombre d'éléments dans le dictionnaire
    Public Property Get Count
        Count = HttpContext_.Count
    End Property
 
    ' Référence vers la collection Form
    Public Property Get Form
        Set Form = Request.Form
    End Property
 
    ' Référence vers la collection QueryString
    Public Property Get QueryString
        Set QueryString = Request.QueryString
    End Property
 
    ' Permet de savoir si un formulaire a été soumis
    Public Property Get IsPostBack
        Select case lcase(Me.ItemByKey("REQUEST_METHOD"))
            Case "post"
                If Me.ItemByKey("CONTENT_LENGTH") > 0 then
                    IsPostBack_ = true
                else
                    IsPostBack_ = false
                end if
            Case "get"
                If Me.QueryString.Count > 0 then
                    IsPostBack_ = true
                Else
                    IsPostBack_ = false
                End if
            Case else
                IsPostBack_ = false
        End Select
        IsPostBack = IsPostBack_
    End Property
 
    ' Permet de renvoyer la valeur d'un élément du dictionnaire en fonction de sa clef (son nom)
    Public Property Get ItemByKey(key)
        If HttpContext_.Exists(key) then
            ItemByKey = HttpContext_.Item(key)
        Else
            ItemByKey = null
        End if
    End Property    
 
    ' Permet de renvoyer la valeur d'un élément en fonction de son index
    Public Property Get ItemByIndex(i)
        ItemByIndex = Arr_Names(i)
    End Property
 
    ' Permet de renvoyer la clef d'un élément en fonction de son index
    Public Property Get KeyByIndex(i)
        KeyByIndex = Arr_Keys(i)
    End Property    
 
    ' Affiche le contenu du dictionnaire
    Public Sub ToTable
        Dim i 
        Response.Write "<table border=""1"">" & vbcrlf
        For i = 1 to Me.Count - 1
            Response.Write "<tr><td>" & Me.KeyByIndex(i) & "</td><td>" & Me.ItemByIndex(i) & "&nbsp;</td></tr>" & vbcrlf
        Next
        Response.Write "</table>" & vbcrlf
    End Sub
 
    ' Créé un fichier XML au chemin spécifié (chemin + nom du fichier)
    Public Sub ToXml(path)
        Dim objDom, objRoot, objRow, objField, objFieldValue, objPI, i
        Set objDom = server.CreateObject("Microsoft.XMLDOM")
            objDom.preserveWhiteSpace = True
            Set objRoot = objDom.createElement("root")
                objDom.appendChild objRoot
                For i = 1 to Me.Count - 1
                    Set objRow = objDom.CreateElement("item")
                    Set objField = objDom.createElement(Me.KeyByIndex(i))
                        objField.Text = Me.ItemByIndex(i)
                        objRow.appendChild objField
                    Set objField = Nothing
                    objRoot.appendChild objRow
                    Set objRow = Nothing
                Next
                Set objPI = objDom.createProcessingInstruction("xml", "version='1.0' encoding='iso-8859-1'")
                    objDom.insertBefore objPI, objDom.childNodes(0)
                Set objPI = Nothing
            Set objRoot = Nothing
            objDom.Save path
        Set objDom = Nothing
    End Sub
 
 
    ' Récupère les variables serveur
    Private Sub GrabServerVariables
        Dim i
        For i = 1 to Request.ServerVariables.Count
            HttpContext_.Add Request.ServerVariables.Key(i), Request.ServerVariables.Item(i)
        Next
    End Sub
 
    ' Récupère les variables d'application
    Private Sub GrabApplication
        Dim i
        For i = 1 to Application.Contents.Count
            HttpContext_.Add Application.Contents.Key(i), Application.Contents.Item(i)
        Next
    End Sub
 
    ' Récupère les variables de session
    Private Sub GrabSession
        Dim i
        For i = 1 to Session.Contents.Count
            HttpContext_.Add Session.Contents.Key(i), Session.Contents.Item(i)
        Next
    End Sub
 
    ' Récupère les cookies
    Private Sub GrabCookies
        Dim i
        For i = 1 to Request.Cookies.Count
            HttpContext_.Add Request.Cookies.Key(i), Request.Cookies.Item(i)
        Next
    End Sub
 
    ' Récupère les variables formulaire
    Private Sub GrabForm
        Dim i
        if lcase(Request.ServerVariables("CONTENT_TYPE")) <> "multipart/form-data" then
            if Request.Form.Count > 0 then
                For i = 1 to Request.Form.Count
                    HttpContext_.Add Request.Form.Key(i), Request.Form.Item(i)
                Next
            End if
        End if
    End Sub
 
    ' Récupère les variables de l'url
    Private Sub GrabQueryString
        Dim i
        if Request.QueryString.Count > 0 then
            For i = 1 to Request.QueryString.Count
                HttpContext_.Add Request.QueryString.Key(i), Request.QueryString.Item(i)
            Next
        End if
    End Sub
 
    ' Assigne les clefs et les valeurs dans deux tableaux
    Private Sub SetArrays
        Arr_Keys = HttpContext_.Keys
        Arr_Names = HttpContext_.Items
    End Sub
End Class
%>

Exemple d'utilisation. La clase DBFactory est a reprendre dans les posts précédents.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
<%@  language="VBSCRIPT" codepage="1252" %>
<% option explicit %>
 
<!--#include file="cls/cls_HttpContext.asp" -->
<!--#include file="cls/cls_DBFactory.asp" -->
 
<%
Dim db, ctx, i, rs, strsql
Set ctx = New HttpContext
Set db = New DBFactory
	Session("test") = "test"
	Application("compteur") = 1
	Response.Cookies("biscuit") = "miam"
	%>
    <html>
    <head>
        <title>Test</title>
        <style type="text/css">
            body
            {
                font-family:Arial;
                font-size:1em;
            }
            table
            {
                border-collapse:collapse;
                border: solid 1px black;
                font-size:0.8em;
            }
            th
            {
                background-color:Silver;
                border: solid 1px black;
                font-weight:bold;
            }
            td
            {
                border: solid 1px black;
            }
        </style>
    </head>
    <body>
        <a href="index.asp">Reload</a><br />
        <form action="index.asp" id="frm" method="post" enctype="application/x-www-form-urlencoded">
            <input id="txt" name="txt" type="text" value="<%=ctx.ItemByKey("txt") %>" />
            <%
	        strsql = "select * from country order by country_desc asc"
	        call db.RsToDDListe(db.ExecuteQuery(strsql), "", ctx.ItemByKey("country"), "country")
	        strsql = "select * from team order by team_desc asc"
	        call db.RsToDDListe(db.ExecuteQuery(strsql), "", ctx.ItemByKey("team"), "team")
            %>
            <input type="submit" name="action" id="action" value="Go" />
        </form>
        <%
        if ctx.IsPostBack then
            strsql = "select * from [user] where (User_UserName like '%" & ctx.ItemByKey("txt") & "%' and user_country = " & ctx.ItemByKey("country") & " and user_team = " & ctx.ItemByKey("team") & ")"
	        call db.RsTotable(db.ExecuteQuery(strsql), "")
	    end if
        %>
    </body>
    </html>
<%
	ctx.ToTable
	ctx.ToXml(Server.MapPath(".") & "\HttpContext_" & replace(cdbl(now()), ",", "") & ".xml")
Set db = Nothing
Set ctx = Nothing
 
%>

A+

[Immobilis]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
<%
' path est le chemin complet vers le fichier
Public Sub DownLoad(path)
    Dim Arr
    Dim objStream
    Dim objFile
    Const adTypeBinary = 1
 
    Set objFile = Server.CreateObject("Scripting.FileSystemObject")
        if objFile.FileExists(path) then
            Arr = split(path,"\")
            Response.Buffer = True
            Response.Clear
 
            Set objStream = Server.CreateObject("ADODB.Stream")
                objStream.Open
                    objStream.Type = adTypeBinary
                    objStream.LoadFromFile path
                    Response.AddHeader "Content-Disposition", "attachment; filename= " & Arr(ubound(Arr))
                    Response.Charset = "UTF-8"
                    Response.ContentType = "application/octet-stream"
                    Response.BinaryWrite objStream.Read
                    Response.Flush
                objStream.Close
            Set objStream = Nothing
        end if
    Set objFile = Nothing
end sub
%>

[Immobilis]

OWC10: http://www.microsoft.com/downloads/d...displaylang=en
OWC11: http://www.microsoft.com/downloads/d...displaylang=en
A mettre dans la DBFactory?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
    Public Sub RsToXls(rs, path)
        Dim i, j, xlsname
        Dim objSpreadsheet
        rs.movefirst
        Set objSpreadsheet = Server.CreateObject("OWC11.Spreadsheet")
            With objSpreadsheet
                for i= 0 to rs.fields.count - 1
                    .Cells(1, i+1).Value = rs.fields(i).name
                next
                j = 2
                while not rs.eof 
                    for i= 0 to rs.fields.count-1 
                        .Cells(j, i+1).Value = rs.fields(i).value
                    next
                    j = j + 1
                    rs.movenext 
                wend
                '.ActiveSheet.Name = "test"
                .Export path, 0
            End with
        Set objSpreadsheet = Nothing
    End sub

[Immobilis]

Voici le script pour générer la table:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
/****** OBJECT:  TABLE [DBO].[RECURSIVE]    SCRIPT DATE: 03/10/2008 23:02:04 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [DBO].[RECURSIVE](
	[ID] [INT] IDENTITY(1,1) NOT NULL,
	[ID_PARENT] [INT] NULL,
	[DESCRIPTION] [NCHAR](10) NULL
) ON [PRIMARY]
GO
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (0,'JEAN      ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (1,'PIERRE    ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (1,'PAUL      ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (1,'JACQUES   ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (0,'ANDRE     ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (5,'FRANCIS   ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (5,'MARTINE   ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (2,'CHRISTOPHE');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (2,'STEVE     ');
INSERT INTO [RECURSIVE] ([ID_PARENT], [DESCRIPTION]) VALUES (4,'LUCIE     ');

Et celui de la procédure

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
<% option explicit %>
 
<!--#include file="../cls/cls_DBFactory.asp" -->
 
<%
Dim dbf
Set dbf = new DBFactory
    Call Recursive(dbf, 0)
Set dbf = Nothing
 
Public Sub Recursive(oDbf, parent)
    Dim i
    Dim rs
    Set rs = oDbf.ExecuteQuery("SELECT * FROM RECURSIVE WHERE (ID_PARENT = " & parent & " ORDER BY DESCRIPTION ASC);")
        If not rs.Eof then
            Response.Write "<ul>" & vbcrlf
            Do while not rs.Eof
                Response.Write "<li>" & vbcrlf
                for i= 0 to rs.fields.count - 1
                    ' Ce Select/Case estt là uniquement pour séparer joliement les valeurs des champs 
                    Select case i
                        case 0
                            Response.Write(trim(rs(i)))
                        case rs.fields.count - 1
                            Response.Write(" - " & trim(rs(i)) & ".")
                        case else
                            Response.Write(" - " & trim(rs(i)))
                    end Select
                next 
                Response.Write "</li>" & vbcrlf
                ' La récursivité: la procédure s'appelle elle-même
                Call Recursive(oDbf, rs(0))
                rs.movenext
            Loop
            Response.Write "</ul>" & vbcrlf
        End if
    Set rs = Nothing
End Sub
%>

Ce qui donnera

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
<ul>
    <li>5 - 0 - ANDRE.</li>
    <ul>
        <li>6 - 5 - FRANCIS.</li>
        <li>7 - 5 - MARTINE.</li>
    </ul>
    <li>1 - 0 - JEAN.</li>
    <ul>
        <li>4 - 1 - JACQUES.</li>
        <ul>
            <li>10 - 4 - LUCIE.</li>
        </ul>
        <li>3 - 1 - PAUL.</li>
        <li>2 - 1 - PIERRE.</li>
        <ul>
            <li>8 - 2 - CHRISTOPHE.</li>
            <li>9 - 2 - STEVE.</li>
        </ul>
    </ul>
</ul>

Sous la forme d'une classe

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 
<!--#include file="../cls/cls_DBFactory.asp" -->
<%
Set dbf = new DBFactory
Set familly = new Famille
    call familly.DisplayFamillyTree(dbf, 0)
Set familly = nothing
Set dbf = nothing
 
Class Famille
 
    Private Sub Class_Initialize
 
    End Sub
 
    Private Sub Class_Terminate
 
    End Sub
 
    Public Default Property Get DefaultProperty
        DefaultProperty = "Class Famille"
    End Property
 
    Public Sub DisplayFamillyTree(oDbf, parent)
        Dim Arr, i, j
        Dim rs
        Set rs = oDbf.ExecuteQuery("SELECT * FROM RECURSIVE WHERE (ID_PARENT = " & parent & ") ORDER BY DESCRIPTION ASC;")
            If not rs.Eof then
                Response.Write "<ul>" & vbcrlf
                Do while not rs.Eof
                    Response.Write "<li>" & vbcrlf
                    for i= 0 to rs.fields.count - 1
                        Select case i
                            case 0
                                Response.Write(trim(rs(i)))
                            case rs.fields.count - 1
                                Response.Write(" - " & trim(rs(i)) & ".")
                            case else
                                Response.Write(" - " & trim(rs(i)))
                        end Select
                    next 
                    Response.Write "</li>" & vbcrlf
                    ' La récursivité: la procédure s'appelle elle-même
                    Call DisplayFamillyTree(oDbf, rs(0))
                    rs.movenext
                Loop
                Response.Write "</ul>" & vbcrlf
            End if
        Set rs = Nothing
    End Sub
 
End Class
%>

A+

[Immobilis]

Voici une classe caisse à outils:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
' Class réunissant des outils
Class ToolsBox
    Private Sub Class_Initialize
 
    End Sub
 
    Private Sub Class_Terminate
 
    End Sub
 
    Public Default Property Get DefaultProperty
        DefaultProperty = "Class ToolsBox"
    End Property
 
    Public Property Get StringBox
        Set StringBox = New StringsBox
    End Property
 
End Class

Voici l'outil (la classe) "StringsBox":

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Class StringsBox
    Private Sub Class_Initialize
 
    End Sub
 
    Private Sub Class_Terminate
 
    End Sub
 
    Public Default Property Get DefaultProperty
        DefaultProperty = "Class StringsBox"
    End Property
 
    ' Fonction qui met en majuscule la première lettre de tous les mots d'une chaine de caractères (utile pour les prénoms)
    Public Function ToProperCase(s)
        Dim propercase
        Dim Arr()
        Dim i
 
        if len(trim(s)) > 0 then
            ReDim Arr(0)
 
            For i = 1 to len(s)
                if IsAlpha(mid(s, i, 1)) = true then
                    Arr(ubound(Arr)) = Arr(ubound(Arr)) & mid(s, i, 1)
                else
                    ReDim Preserve Arr(ubound(Arr) + 1)
                    Arr(ubound(Arr)) = mid(s, i, 1)
                    ReDim Preserve Arr(ubound(Arr) + 1)
                end if
            Next
 
            for i = 0 to ubound(Arr)
                If len(Arr(i)) > 1 then
                    propercase = propercase & UCase(Left(Arr(i),1)) & LCase(mid(Arr(i),2,len(Arr(i))-1))
                Else
                    propercase = propercase & Arr(i)
                End If
            next
        else
            propercase = ""
        end if
 
        ToProperCase = propercase
    End function
 
    ' Fonction permettant de determiner si un caractère est une lettre
    Public Function IsAlpha(c)
        if (asc(c) > 64 and asc(c) < 91) or (asc(c) > 96 and asc(c) < 123) or (asc(c) > 191 and asc(c) < 256) then
            IsAlpha = true
        else
            IsAlpha = false
        end if
    End Function
 
    ' Procédure permettant d'afficher les caractères ascii dans différents types d'encodage
    Public Sub DisplayAscii
        Dim i
        %>
        <table>
            <tr>
                <th>
                    &nbsp;</th>
                <th>
                    &nbsp;</th>
                <th>
                    Ascii<br />
                    Chr(i)</th>
                <th>
                    HTML<br />
                    replace(server.HTMLEncode(Chr(i)),"&","&amp;amp;")
                </th>
                <th>
                    URL<br />
                    server.URLEncode(Chr(i))
                </th>
                <th>
                    HEX<br />
                    "&amp;H" & hex(i)
                </th>
                <th>
                    OCT<br />
                    oct(i)
                </th>
            </tr>
            <tbody>
                <%
                FOR i = 0 to 255
                    response.Write("<tr>" & vbcrlf & _
                        "<td align=""center"" valign=""top nowrap"">" & i + 1 & "</td>" & _
                        "<td align=""center"" valign=""top nowrap"">Chr(" & i &")</td>" & _
                        "<td align=""center"" valign=""top nowrap"">" & Chr(i) & "</td>" & _
                        "<td align=""center"" valign=""top nowrap"">" & replace(server.HTMLEncode(Chr(i)),"&","&amp;") & "</td>" & _
                        "<td align=""center"" valign=""top nowrap"">" & server.URLEncode(Chr(i)) & "</td>" & _
                        "<td align=""center"" valign=""top nowrap"">" & "&amp;H" & hex(i) & "</td>" & _
                        "<td align=""center"" valign=""top nowrap"">" & oct(i) & "</td>" & _
                        "</tr>" & vbcrlf)
                NEXT
                %>
            </tbody>
        </table>
        <%
    End Sub
End Class

Pour l'utiliser:

Code :

1
2
3
4
5
6
 
Dim tbx
Set tbx = new ToolsBox
    Response.Write tbx.StringBox & " " & tbx.StringBox.ToProperCase("hello world!")
    tbx.StringBox.DisplayAscii
Set tbx = Nothing

Ajoutez en autant que vous voulez.

A+

FW réalisé avec l'aimable participation de agrotic

[Immobilis]

Me revoilà,

Y'a une question qui revient souvent: "comment faire des listes liées?"

Une solution est d'utiliser le javascript comme sur ce tuto. C'est une solution qui peut être coûteuse en terme de poids de la page car toutes les combinaisons sont chargées dans la page.
On peut aussi utiliser de l'AJAX, euh, j'ai pas d'exemple sous le coude et de toutes façons, j'aime pas trop l'AJAX.
Il reste une solution simple mais assez efficace de faire varier le contenu de la liste en fonction de données soumises à l'aide d'un formulaire. Problematique: on souhaite avoir un jeux de listes de tous les pays, toutes les regions, tous les departements, toutes les villes. Ca fait beaucoup.

1. Une page affiche une liste déroulante de tous pays
2. On souhaite avoir une deuxieme liste qui affiche les regions en fonction du pays
3. Puis les departements en fonction de la region
4. Puis les villes en fonction du département

On se rend bien compte que si on souhaitait charger toutes les combinaisons dans la page comme sur le tuto, la page atteindrait vite un poid énorme.
La solution consiste donc à soumettre une première fois le pays puis de faire une requete en base pour obtenir la liste des regions de ce pays. Ensuite, on soumet la region et on demande à la base la liste des département qui dépendent de la région et ainsi de suite.

Comment faire en pratique:

1. Code de la base de données "test". Créer une base de donnée "test" puis executez le code SQL pour créer les tables et insérer les données.
   
   Code :

   1
   2
   3
   4
   5
   6
   7
   8
   9
   10
   11
   12
   13
   14
   15
   16
   17
   18
   19
   20
   21
   22
   23
   24
   25
   26
   27
   28
   29
   30
   31
   32
   33
   34
   35
   36
   37
   38
   39
   40
   41
   42
   43
   44
   45
   46
   47
   48
   49
   50
   51
   52
   53
   54
   55
   56
   57
   58
   59
   60
   61
   62
   63
   64
   65
   66
   67
   68
   69
   70
   71
   72
   73
   74
   75
   76
   77
   78
   USE [test]
   GO
   /****** Object:  Table [dbo].[PAYS]    Script Date: 07/31/2008 22:39:49 ******/
   SET ANSI_NULLS ON
   GO
   SET QUOTED_IDENTIFIER ON
   GO
   CREATE TABLE [dbo].[PAYS](
   	[PAYS_ID] [numeric](18, 0) IDENTITY(1,1) NOT NULL,
   	[PAYS_NOM] [nchar](50) NULL,
    CONSTRAINT [PK_PAYS] PRIMARY KEY CLUSTERED 
   (
   	[PAYS_ID] ASC
   )WITH (PAD_INDEX  = OFF, STATISTICS_NORECOMPUTE  = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS  = ON, ALLOW_PAGE_LOCKS  = ON) ON [PRIMARY]
   ) ON [PRIMARY]
    
    
   USE [test]
   GO
   /****** Object:  Table [dbo].[REGION]    Script Date: 07/31/2008 22:42:15 ******/
   SET ANSI_NULLS ON
   GO
   SET QUOTED_IDENTIFIER ON
   GO
   CREATE TABLE [dbo].[REGION](
   	[REGION_ID] [numeric](18, 0) IDENTITY(1,1) NOT NULL,
   	[PAYS_ID] [numeric](18, 0) NULL,
   	[REGION_NOM] [nchar](50) NULL,
    CONSTRAINT [PK_REGION] PRIMARY KEY CLUSTERED 
   (
   	[REGION_ID] ASC
   )WITH (PAD_INDEX  = OFF, STATISTICS_NORECOMPUTE  = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS  = ON, ALLOW_PAGE_LOCKS  = ON) ON [PRIMARY]
   ) ON [PRIMARY]
    
    
   USE [test]
   GO
   /****** Object:  Table [dbo].[DEPARTEMENT]    Script Date: 07/31/2008 22:42:37 ******/
   SET ANSI_NULLS ON
   GO
   SET QUOTED_IDENTIFIER ON
   GO
   CREATE TABLE [dbo].[DEPARTEMENT](
   	[DEP_ID] [numeric](18, 0) IDENTITY(1,1) NOT NULL,
   	[REGION_ID] [numeric](18, 0) NULL,
   	[DEP_NOM] [nchar](50) NULL,
    CONSTRAINT [PK_DEPARTEMENT] PRIMARY KEY CLUSTERED 
   (
   	[DEP_ID] ASC
   )WITH (PAD_INDEX  = OFF, STATISTICS_NORECOMPUTE  = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS  = ON, ALLOW_PAGE_LOCKS  = ON) ON [PRIMARY]
   ) ON [PRIMARY]
    
    
   DECLARE @P INT, @R INT
    
   INSERT INTO PAYS (PAYS_NOM) VALUES ('FRANCE'); SET @P = SCOPE_IDENTITY();
   INSERT INTO REGION (PAYS_ID, REGION_NOM) VALUES (@P, 'NORMANDIE'); SET @R = SCOPE_IDENTITY();
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'CALVADOS');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'ORNE');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'MANCHE');
    
   INSERT INTO REGION (PAYS_ID, REGION_NOM) VALUES (@P, 'PACA'); SET @R = SCOPE_IDENTITY();
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'BDR');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'VAR');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'ALPES HP');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'ALPES MAR');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'HTES ALPES');
    
   INSERT INTO PAYS (PAYS_NOM) VALUES ('ENGLAND'); SET @P = SCOPE_IDENTITY();
   INSERT INTO REGION (PAYS_ID, REGION_NOM) VALUES (@P, 'GLOUCESTERSHIRE'); SET @R = SCOPE_IDENTITY();
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'GLOUCESTERSHIRE');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'SOUTH GLOUCESTERSHIRE');
    
   INSERT INTO REGION (PAYS_ID, REGION_NOM) VALUES (@P, 'SOMERSET'); SET @R = SCOPE_IDENTITY();
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'BATH AND NORTH EAST SOMERSET');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'NORTH SOMERSET');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'BRISTOL');
   INSERT INTO DEPARTEMENT (REGION_ID, DEP_NOM) VALUES (@R, 'SOMERSET');

2. Code de la page ASP. Adapter la chaine de connexion
   
   Code :

   1
   2
   3
   4
   5
   6
   7
   8
   9
   10
   11
   12
   13
   14
   15
   16
   17
   18
   19
   20
   21
   22
   23
   24
   25
   26
   27
   28
   29
   30
   31
   32
   33
   34
   35
   36
   37
   38
   39
   40
   41
   42
   43
   44
   45
   46
   47
   48
   49
   50
   51
   52
   53
   54
   55
   56
   57
   58
   59
   60
   61
   62
   63
   64
   65
   66
   67
   68
   69
   70
   71
   72
   73
   74
   75
   76
   77
   78
   79
   80
   81
   82
   83
   84
   85
   86
   87
   88
   89
   90
   91
   92
   <%@ language="VBSCRIPT"%>
   <%Option Explicit %>
   <%
   Dim con
    
   Call Main
    
   Sub Main
       OpenConnection
       Display(Request.Form)
       CloseConnexion
   End Sub
    
   Function OpenConnection
       Set con = Server.CreateObject("ADODB.Connection")
           con.ConnectionString = "VOTRE CHAINE DE CONNECTION"
           con.Open()
   End Function
   Function CloseConnexion
           con.Close()
       Set con = Nothing
   End function
   Function GetRecordSet(strSql)
       Set GetRecordSet = con.Execute(strSql)
   End Function
    
   Sub Display(frm)
   %>
    
   <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
   <html xmlns="http://www.w3.org/1999/xhtml" >
   <head>
       <title>Listes liées en ASP</title>
   </head>
   <body>
   <form id="frm" method="post" action="">
       <%Response.Write "Données de formulaire: " & frm %><br />
       <select id="pays" name="pays" onchange="submit(this)">
           <option value="0"> --- </option>
           <%
           Dim rs, selected
           selected = ""
           Set rs = GetRecordSet("SELECT * FROM PAYS")
           While not rs.eof
               if strcomp(rs("PAYS_ID"), frm("pays")) = 0 then
                   Response.Write "<option value=""" & rs("PAYS_ID") & """ selected = ""selected"">" & trim(rs("PAYS_NOM")) & "</option>"
               else
                   Response.Write "<option value=""" & rs("PAYS_ID") & """>" & trim(rs("PAYS_NOM")) & "</option>"
               end if
               rs.movenext
           wend
           selected = ""
           %>
       </select>
       <select id="region" name="region" onchange="submit(this)">
           <option value="0"> --- </option>
           <%
           if len(frm("pays")) > 0 then
               Set rs = GetRecordSet("SELECT * FROM REGION WHERE PAYS_ID = " & frm("pays"))
               While not rs.eof
                   if strcomp(rs("REGION_ID"), frm("region")) = 0 then
                       Response.Write "<option value=""" & rs("REGION_ID") & """ selected = ""selected"">" & rs("REGION_NOM") & "</option>"
                   else
                       Response.Write "<option value=""" & rs("REGION_ID") & """>" & rs("REGION_NOM") & "</option>"
                   end if
                   rs.movenext
               wend
           end if
           %>
       </select>
       <select id="departement" name="departement" onchange="submit(this)">
           <option value="0"> --- </option>
           <%
           if len(frm("region")) > 0 and strcomp(frm("paysencours"), frm("pays")) = 0 then
               Set rs = GetRecordSet("SELECT * FROM DEPARTEMENT WHERE REGION_ID = " & frm("region"))
               While not rs.eof
                   if strcomp(rs("DEP_ID"), frm("departement")) = 0 then
                       Response.Write "<option value=""" & rs("DEP_ID") & """ selected = ""selected"">" & rs("DEP_NOM") & "</option>"
                   else
                       Response.Write "<option value=""" & rs("DEP_ID") & """>" & rs("DEP_NOM") & "</option>"
                   end if
                   rs.movenext
               wend
           end if
           %>
       </select>
       <input type="hidden" name="paysencours" value="<%=frm("pays") %>" />
    
   </form>
   </body>
   </html>
   <%End Sub %>

Testez sur un serveur IIS.

Si vous avez des question n'hésitez pas.

Ce code ne verifie pas les données et de ce fait ne présente aucune sécurité face à des injections SQL!!

A+

[Immobilis]

Salut,

Les recordset ont au moins deux emplois la lecture et l'ecriture.
Pour pouvoir utiliser l'une ou l'autre des capacités, il est interessant de savoir un peu comment ils fonctionnent.

Pour ouvrir un recordset il faut faire ainsi:

Code :

recordset.Open Source, ActiveConnection, CursorType, LockType, Options

• Source = la requete sql
• ActiveConnection = la connection ouverte
• CursorType = -1 ou 0 ou 1 ou 2 ou 3
• LockType = -1 ou 1 ou 2 ou 3 ou 4

Que veulent dirent ces chiffres? Un petit saut sur cette page web (c'est le fichier joint) et ce post.
La page web est le resultat d'un test, un peu empirique car il faudrait le faire plusieurs fois dans des conditions strictement identiques, que j'ai fait pour passer sur toutes les combinaisons possibles des options d'ouverture du recordset. Toutefois les chiffres ont des écarts tellements significatifs qu'il y a peu de chances que plusieurs essais fassent une grosse différence. Il y a aussi cette discussion.

Interprétation du resultat:

• Un curseur est localisé soit sur le serveur de BD soit sur le client (IIS et pas l'internaute)
• Seul le curseur sur le client (IIS) permet à tous les coups de compter le nb d'enregistrements
• Tous ne sont pas aussi rapides les uns que les autres. Le recordset en lecture seule et en avant seulement est le plus rapide.
• On n'a pas toujours ce qu'on demande. Une combinaison demandée n'est pas forcement celle qui est utilisée par le serveur de base de données.
• Si la plupart permettent de lire, tous ne permettent pas de mettre à jour.

Un information n'est pas mise en évidence ici, il s'agit des perturbations engendrées par des accès concurents. En effet, lors de la lecture ou de la mise à jour, une requete à la base de données peut poser un verrou. Ce dernier va retarder les autres requetes envoyées par d'autres client tant que le verrou n'est pas levé. Mieux vaut donc choisir un curseur qui aura le moins d'impacts sur les temps de latence.

Choisissez donc bien votre curseur.

N'hésitez pas si vous avez des questions.

[Immobilis]

Salut,

Pas mal de codes trainent sur internet à propos de la pagination.
Voici un code simple que vous pouvez copié coller. Vous n'avez qu'à changer la requête SQL et la chaine de connexion.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%Option explicit%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Pagination</title>
</head>
 
<body>
<%
Dim strSQL, objConnection, objRecordset, PageNum, i, j
 
Const adOpenKeyset = 1
 
Set objConnection = Server.CreateObject("ADODB.Connection")
	OBJConnection.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=Chemin_Vers_La_Base;"
 
	Set objRecordset = Server.CreateObject("ADODB.Recordset")
		objRecordset.PageSize = 20
		objRecordset.Open "SELECT * FROM MATABLE", objConnection, adOpenKeyset
 
		i = 0
 
		IF request.QueryString("PageNum") <> "" THEN
			IF objRecordset.AbsolutePage <= objRecordset.pagecount THEN
				objRecordset.AbsolutePage = request.QueryString("PageNum")
				PageNum = request.QueryString("PageNum")
			END IF
		ELSE
			PageNum = 1
		END IF
 
		IF NOT objRecordset.EOF AND NOT objRecordset.BOF THEN
			response.write "nb champs = " & objRecordset.fields.count & "<br>" 
			response.Write("<table>"  & vbcrlf)
			for j= 0 to objRecordset.fields.count-1 
				response.write ("<th>" & objRecordset.fields(j).name & "&nbsp;</th>" & vbcrlf)
			next
			while not objRecordset.EOF AND i<= objRecordset.PageSize
				response.Write("<tr>" & vbcrlf)
				for j= 0 to objRecordset.fields.count-1 
					response.write ("<td>" & objRecordset.fields(j).value & "&nbsp;</td>" & vbcrlf)
				next 
				response.Write("<tr>" & vbcrlf)
				objRecordset.movenext 
				i=i+1
			wend
			response.Write("</table>" & vbcrlf)
		ELSE
			response.Write("Pas d'enregistrements")
		END IF
		response.Write("You are page " & PageNum & " of " & objRecordset.Pagecount & "<br>")
		If cint(PageNum) > 1 Then
			response.Write("<a href='" & Request.ServerVariables("SCRIPT_NAME") & "?Direction=Prev&PageNum=" & PageNum - 1 & "'>Enregistrements précédents</a>&nbsp;")
		End If
		If cint(PageNum) < objRecordset.Pagecount Then
			response.Write("<a href='" & Request.ServerVariables("SCRIPT_NAME") & "?Direction=Next&PageNum=" & PageNum + 1 & "'>Enregistrements suivants</a>")
		End If
 
		objRecordset.Close
		objConnection.Close
	Set objRecordset = Nothing
Set objConnection = Nothing
%> 
</body>
</html>

Comment ça marche? Dans tous les cas la totalité du recordset va être chargé. Ce qui va nous servir est la propriété "AbsolutePage" qui va permettre de démarrer la consultation des enregistrements à partir de la bonne page. La propriété "PageSize" est juste là pour porter le nombre d'enrgistrements qui constituent une page. Il ne permet pas de stoper la lecture une fois la fin de la page atteinte.

Vous pouvez améliorer la navigation en ajoutant les numéros des pages intermédiaires.
Si vous voulez trier selon l'ordre des champs des enregistrements, il faudra porter les paramètres de tri dans l'url de la "barre" de navigation pour ainsi faire varier la requete SQL.

A+

PS, comme d'hab si vous avez des questions...

[StephM_asp]

Je sais pas trop si c'est le bon endroit pour poster ce message, mais c'était juste pour te remercier d'avoir partager ces très bonnes infos !

Je vais d'ailleurs de ce pas m'essayer à la class permettant de créer une connexion, surtout que je souhaite pouvoir en ouvrir une et la refermer aussitôt que je n'en ai plus besoin ! En effet, certains de mes sites ont encore le problème du nombre de connexion trop élevées ouvertes en même temps (généralement 30 maxi) et pour les sites particulièrement visités, je suis obligé d'alourdir mon code avec les fermetures.

Par la suite je vais travailler à créer une fonction ou une class je ne sais pas encore qui va me permettre d'une part de retourner le résultat d'une requête dans un tableau (peut-être un scripting dictionary) libérant ainsi le oRs et me permettant donc de fermer immédiatement ma connexion.

Je ferais passer mon code si j'arrive à quelque chose de vraiment "propre" (genre un joli tableau associatif ?)

A++ et encore merci (content de ne plus être seul dans le vieil univers des ASP ) .

[StephM_asp]

Histoire de participer un peu :

Contre les injections SQL

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
function SQLProtect(sMot)
	dim badChars, newChars
	Dim i
 
	badChars = array("select", "drop", ";", "--", "insert", "delete", "xp_", "%")
	newChars = sMot
 
	for i = 0 to uBound(badChars)
		newChars = replace(newChars, badChars(i), "")
	next
 
	SQLProtect = replace(newChars,"'","''")
 
end function

Le RegEx qui va permettre quelques trucs vraiment sympa :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
'-- Permet de savoir si la chaine de caractère correspond au modèle
'-- returns true or false
'-- varIgnoreCase must be TRUE (match is case insensitive) or FALSE (match is case sensitive)
function ereg(sChaine, sModele, varIgnoreCase)
	dim objRegExp : set objRegExp = new RegExp
	with objRegExp
	.Pattern = sModele
	.IgnoreCase = varIgnoreCase
	.Global = True
	end with
	ereg = objRegExp.test(sChaine)
	set objRegExp = nothing
end function

Une fonction pour tester (avec ereg justement) si le contenu de la variable est un entier (très utile pour éviter les injection)

Code :

1
2
3
4
 
function est_un_entier(sATester)
	est_un_entier = ereg (sATester, "^0*1?[\d]{1,9}$", true)
end function

Test si le contenu de la variable est un décimal :

Code :

1
2
3
4
 
function est_un_decimal(sATester)
	est_un_decimal = ereg ( sATester, "^\d+[,.]?\d*$", true )
end function

++

[StephM_asp]

Voilà je viens de réussir tout ce que je voulais !
Alors je travail avec une librairie (fct_array.asp) spécial pour les tableaux.

J'y ai placé ma fonction, "a_data()", qui reçoit une chaine SQL et retourne un tableau de tableau.
Pour chaque élément du 1er tableau je place un dico avec le résultat de la première ligne du RS correspondant.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
function a_data(sSQL)
	Dim aTab, dico, elt, aTemp
	Dim oRs, db
	Dim iNbrRec, iRecCount, iFieldCount, iFieldCountMax
	Dim Field
	iRecCount = 0
	iFieldCount = 0
	iNbrRec = 0
	set db = new cDB
	'-- la connexion + remplissage du RS
	Set oRs = db.SQL(sSQL)
	'-- combien d'enregistrements trouvés ?
	'-- pas de .count, traitement vraiment trop lourd et incompatible avec Access je crois bien
		if not oRs.EOF then
			while not oRs.EOF
				iNbrRec = iNbrRec + 1
				oRs.movenext
			wend
			'-- -1 pour ne pas dépasser lors de la lecture (les tableaux commençant à 0)
			redim aTab(iNbrRec-1)
			'-- ne pas oublier de replacer le pointeur au début du RS
			oRs.movefirst
			while not oRs.EOF
				set dico = createObject("Scripting.Dictionary")
				for each elt in oRs.fields
					dico.Add elt.name, elt.value
				next
				set aTab(iRecCount) = dico
				set dico = nothing
				iRecCount = iRecCount + 1
				oRs.movenext
			wend
		else
			'-- le requete ne donne aucun résultat, on donne tout de meme un dico afin de ne pas prendre une erreur lors du traitement final
			reDim aTab(0)
			set dico = createObject("Scripting.Dictionary")
			dico.Add "", ""
			set aTab(0) = dico
			set dico = nothing
		end if
	oRs.close
	set oRs = nothing	
	set db = nothing
	a_data = aTab	
end function

Le but étant d'alléger au maximum la page principal, tout comme avec ton système de class pour la chaine de connexion.
Du coup, sur la page principale on peut appeler par exemple :

Code :

1
2
3
4
5
6
7
8
 
sSQL = "SELECT * FROM Membre"
aTab = a_data(sSQL)
for each elt in aTab
   response.write elt("Nom") & "<br>"
   response.write elt("Prenom") & "<br>"
   response.write elt("Adresse") & "<br>"
next

L'avantage est de pouvoir fermer la connexion dans a_data(), donc immédiatement après avoir fini le traitement, libérant la connexion pour les autres clients.

++

EDIT : Ben voilà je l'ai mon tableau associatif !

[StephM_asp]

Salut,

Ces deux fonctions permettent d'alléger votre page principale ou vos fonctions.

Note : gérez vos connexions différemment (cf : http://www.developpez.net/forums/d67...ier-recordset/)


d_value()
Celle-ci récupère une valeur, résultat d'une requête (l'id d'un membre, le prix d'un produit etc.)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
 
function d_value(sSQL)
	Dim sValue
	Dim db
	set db = new cDB
	set sValue= db.SQL(sSQL)
	if not sValue.eof then	
		d_value= sValue(0)
	else
		d_value= false
	end if
	set db = nothing
end function

Il suffit, là où vous en avez besoin d'appeler :

Code :

1
2
3
 
sPrix = d_value("select prix from produit where id = 45")
response.write sPrix

a_ereg()
Enfin, celle-ci permet de récupérer un enregistrement complet :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
function a_ereg(sSQL)
	Dim dico, oRs, db
	Dim elt
 
	set db = new cDB
	Set oRs = db.SQL(sSQL)
	Set dico = server.createObject("Scripting.Dictionary")
 
	if not oRs.EOF then
		for each elt in oRs.fields
			dico.Add elt.name, elt.value
		next
	else
 
	end if
	set a_ereg= dico
 
	set dico = nothing
	set oRs = nothing
	set db = nothing
end function

Il suffit alors de récupérer les valeurs comme bon vous semble dans votre page principale ou vos fonctions :

Code :

1
2
3
 
set aMonEnreg = a_line("select Produit, Prix from produit where id = 45")
response.write aMonEnreg("Produit") & " : " & aMonEnreg("Prix")

ecrire()
Et juste parce que j'ai la flemme de taper response.write à chaque fois :

Code :

1
2
3
4
 
sub ecrire(sStr)
      response.write sStr
end sub

Que l'on appelle donc où l'on veut :

Code :

1
2
 
ecrire aMonEnreg("Produit")

[StephM_asp]

Hello,

Ici "mon" gestionnaire de formulaire (les fichiers nécessaires dans l'archive)
"mon" parce qu'il est basé sur la classe CForm d'Immo, que j'ai modifié donc.

Le principe :
- Il génère les champs désirés
- Il vérifie lors de l'envoi le caractère obligatoire du champ (si demandé) ainsi que le format de la chaine envoyée (email, CP, entier, tel etc.).
- Il compte le nombre d'erreurs rencontrées.
- Il affiche un message spécifique à l'erreur rencontrée (erreur de formatage ou erreur "obligatoire")
- Il place le message par défaut de chaque champ à l'intérieur de celui-ci. Lorsque ce dernier gagne le focus, le message disparait et laisse place à un champ vide.
- Il sait repérer les messages par défaut et gère les éventuelles erreur en conséquence.

En pratique.
Assurez-vous d'avoir inclus :
- le fichier des fonctions nécessaires : "fct_est_un.asp" (inclus dans l'archive)
- le fichier de la classe CForm : "cls.form.asp" (inclus dans l'archive)
Attention, j'ai laissé mes constantes trainer ça et là (NOM_CONSTANTE), n'oubliez pas de faire le ménage...

Enfin, testez le formulaire grâce à "form.asp" (inclus dans l'archive).

Je pense n'avoir rien oublié.

++

Mise à jour 1.1 :
- ajout de "InputChckBx()" qui permet donc de gérer les checkbox.
On configure le nombre de box, leur label, leur value, le nombre de réponses obligatoires (sinon erreur de caractère obligatoire) et enfin si on les souhaite en ligne ou en colonne.
- ajout de "InputRadio()" qui permet de gérer les boutons radio.
On configure le nom du champ, les labels, les values, obligatoire, en ligne ou colonne.

TO DO : gérer l'envoi des images (je vais voir si je peux faire qque chose)

[StephM_asp]

Salut,

Modification de la class d'Immo (cXml).

Voici un petit module de lecture d'un fichier XML.
Il lit un fichier xml en extrait soit une chaine de caractères, soit un CDATA.
Il peut aussi imprimer à l'écran le contenu complet du fichier (string + CDATA)

lisez-moi.txt pour plus d'infos.

++

[StephM_asp]

Salut,

Voici le gestionnaire de formulaire pour les données binaires d'un encodage de type "form-data".

Code :

1
2
 
<form method="post" name="frm_test" action="./formFile.asp?mod=sendform" enctype="multipart/form-data">

Je n'ai pas ajouté le fichier des fonctions qui est déjà présent dans le zip du gestionnaire de form text/plain.

Grosso modo, c'est la même chose que l'autre gestionnaire sauf qu'il fonctionne exclusivement avec ASPSmartUpload.

On retrouve les mêmes fonctionnalités globales (vérification des champs, caractère obligatoires, tailles des champs etc.)

Code :

1
2
3
4
5
6
7
8
9
 
<%set oFormFile = new cFormFile%>
<form method="post" name="frm_test" action="./formFile.asp?mod=sendform" enctype="multipart/form-data">
 
'-- un champ fichier
<% echo oFormFile.InputFile("NomFichier", 50, "*")%><br/>
<% echo oFormFile.InputTexte("Auteur", 40, "* Votre nom", "*") %>	
 
</form>

Pour récupérer les données une fois le form validé par le gestionnaire il suffit d'appeler la fonction MonFormFile.GetForm() et d'y passer le chemin où enregistrer les images en paramètre (i.e : formFile.asp) :

Code :

1
2
3
4
5
6
7
8
9
 
'-- A placer après votre formulaire
'-- retourne 1 si le gestionnaire ne trouve aucune erreur
if oFormFile.Valide then
     '-- ici oFormFile = oFormFile.GetForm(sPath)
     call TraitementFormFile(oFormFile.GetForm(sPath))
end if
'-- maintenant on peut tout fermer
set oFormFile = nothing

Non seulement le gestionnaire enregistre les images sur le serveur mais il retourne un dico contenant l'ensemble des valeurs des champs postés.

Donc dans votre fonction de traitement de données il vous suffit d'appeler :

Code :

1
2
3
4
5
6
7
8
 
function TraitementFormFile(oFormFile)
  '-- le traitement des données récupérées
    '-- ouverture en écriture d'un rs + insertion des données ds votre bdd
       oRec(NomFichier) = oForm(NomFichier)
       oRec(Auteur) = oForm(Auteur)
  '-- et voila
end function

Un exemple complet d'utilisation dans FormFile.asp (sauf la fonction de traitement de données qui vous est personnelle).

++

EDITE : suppression de quelques "request.form" + gestion plus explicite des erreurs d'upload

[StephM_asp]

Salut,

Une petite fonction qui découpe une URL et la retourne prête pour l'URL Rewrite.

-1- passez l'URL que vous voulez, avec autant de param que souhaité, autant de répertoires :

Code :

1
2
3
4
5
 
http://www.monsite.com/rep1/rep2/page.asp?id=10&action=upd
ou encore
http://www.monsite.com/rep1/rep2/rep3/page.asp?id=10&action=upd&scat=56
'-- etc.

-2- l'id de l'élément (page, article, produit etc.) est toujours le 1er param.
mais vous pouvez tout à fait ajouter un param dans la fonction aussi pourquoi pas, par exemple :

Code :

1
2
3
4
5
6
7
8
 
'-- actuellement
call URLRewrite(sUrl)
'-- et la fonctionne trouve toute seule l'id de votre élément s'il est bien passé
'-- en premier (?id=154) 
'-- peut devenir :
call URLRewrite(sUrl, idElement)
'-- à vous de faire les modifs nécessaires dans la fonction

-3- elle retourne :

Code :

1
2
 
http://www.monsite.com/rep1/rep2/rep3/page/10/upd/le-titre-de-la-page

Voilà, vous n'avez plus qu'à écrire de jolies Regex pour récupérer tout ça.

++

Et la fonction :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
function UrlRewrite(sURL)
	if URL_REWRITE then '-- j'ai une constante globale qui me permet d'activer ou non l'URLRewrite
		Dim aUrl
		Dim i : i = 0
		Dim j : j = 0
		Dim k : k = 0
		Dim iElement
		Dim var, avar, aVarTemp, part
		Dim sDomaine, sDomaineSuite, sUrlFinale, sTitre
		'-- on commence le découpage
		aUrl = split(sUrl,"?")
		if Ubound(aUrl) > 0 then
			for each part in aUrl
				if i = 0 then '-- on récupère le 1ère partie de l'url (nom de domaine + répertoires)
					sDomaine = part
				else '-- sinon on récupère les variables
					'-- y'a plus qu'à découper sur les "&"
					avar = split(part,"&")
					if Ubound(avar) > 0 then
						for each var in avar
							aVarTemp = split(var,"=")
							if Ubound(aVarTemp) > 0 then
								for each aVar in aVarTemp
									if not est_un_entier(k/2) then '-- on ne prend que la seconde partie de la chaine = les valeurs
										sDomaineSuite = sDomaineSuite & "/" & aVar
										if k = 1 then '-- pour moi l'ID de l'élement passé dans la fonction : la page, l'article, le produit, peu importe.
											iElement = aVar
										end if
									end if
									k = k + 1
								next
							end if
						next
					end if
				end if
				i = i + 1
			next
 
			sUrlFinale = sDomaine & sDomaineSuite
			'-- on enlève le .asp qui n'est pas très joli
			'-- on peut aussi évidemment, gérer les .HTML ou ce que l'on souhaite
			sUrlFinale = replace(sUrlFinale, ".asp", "")
			'- ajout du titre de la page (issu de ma base)
			'-- l'iElement est ce que vous voulez : une constante, un param de votre fonction, le 1er var etc.
			if est_un_entier(iElement) then '-- protection contre les injections sql
				sTitre = d_valeur(db, "select rewrite from page where id =" & iElement)
			end if
			sUrlFinale = sUrlFinale & "/" & sTitre
			UrlRewrite = sUrlFinale
		end if
	else
		UrlRewrite = sURL '-- pas de changement donc
	end if
end function

Salut,

Et bien le client envoit la chaine formatée, puis en fonction de la version de ton serveur IIS :

-1- IIS 5+ jusqu'à IIS 6 :
-> tu dois alors installer un filtre ISAPI (i.e : ISAPI_Rewrite) dans IIS, ne pas oublier de vérifier que l'extension .asp soit bien liée à ton filtre sous IIS.
-> puis configurer le httpd.ini (avec tes jolies Regex justement) par exemple :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
'-- dans le httpd.ini
'--------------------------------------------
[ISAPI_Rewrite]
RewriteEngine on 
'-- reçoit http://www.mondomaine.com/rep1/rep2/rep3/exemples/15/ma-page-a-moi
RewriteRule (.*)/([0-9]{1,})/(.*) $1/exemples.asp?id=$2
'-- retourne http://www.mondomaine.com/rep1/rep2/rep3/exemple.asp?id=15
 
 
 
'-- et dans ta page exemple.asp 
'--------------------------------------------
idPage = request.querystring("id")

-2- IIS 7 :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
'-- dans ton web.config
<?xml version="1.0" encoding="UTF-8"?>
<configuration>
    <system.webServer>		
		<rewrite>
           <rules>
               <rule name="test">
                   <match url="(.*)/([0-9]{1,})/(.*)" />
                   <action type="Rewrite" url="{R:1}/exemple.asp?id={R:2}" />
               </rule>
           </rules>
       </rewrite>
    </system.webServer>
</configuration>
 
'-- note, les $1, $2 et $3 sont alors à remplacer par {R:1}, {R:2} etc.
'-- la Regex reste strictement la même

++

Alors attention quand même, autant lorsqu'on formate la chaine (cf ma fonction UrlRewrite) on passe autant de rep + para que l'on souhaite, autant quand on récupère (les regex) on est obligé d'en connaitre le nombre exacte.

Par exemple :

Code :

1
2
3
4
5
6
7
8
9
10
 
http://www.mondomaine.com/rep1/rep2/rep3/exemples/15/ma-page-a-moi
'-- passera parfaitement avec 
(.*)/([0-9]{1,})/(.*)
 
'-- autant 
http://www.mondomaine.com/rep1/rep2/rep3/exemples/15/16/ma-page-a-moi
'-- ne passera plus du tout, on voit bien que :
(.*)/([0-9]{1,})/(.*)
'-- ne s'occupe que d'un seul /num/

Enfin, en générale, on passe un seul param.
Sinon, autant de Regex que de forme d'URL à "traduire" dans le header.

++