http://www.aspgenerator.net
- connexion à la base de données
- Exécution de requetes
- Affichage du contenu d'une table / requete
- Affichage du contenu d'une table ou requete en donnant la possibilité d'appeler des fichier ASP pour modification/suppression/Ajout
Source / Exemple :
<SCRIPT RUNAT=SERVER LANGUAGE="VBScript">
' cette fonction permet d'ouvrir une base de données
' CheminBase : chemin de la base de données
dim sDBName
dim objDB
dim RS
sub OuvrirBDAccess(CheminBase)
sDBName = "driver={Microsoft Access Driver (*.mdb)};dbq="+CheminBase
Set objDB = Server.CreateObject("ADODB.Connection")
objDB.Open sDBName
end sub
' récupère le jeux d'enregistrements dans RS
' retourne 0 si aucun
function GetRSAccess(requete)
Set RS = objDB.Execute(requete)
GetRSAccess=0
on error resume next
GetRSAccess=RS(0)
end function
' Recherche les données dont le champs est égal à info
function rechercheChampsAccess(Nomtable, NomChamps, Info)
dim requete
'requete = "select * from "+Nomtable+" where "+NomChamps+"='"+cstr(Info)+"'"
requete1 = "select count(*) from "+Nomtable+" where "+NomChamps+"='"+Info+"'"
rechercheChampsAccess=GetRSAccess(requete1)
requete = "select * from "+Nomtable+" where "+NomChamps+"='"+Info+"'"
GetRSAccess(requete)
end function
'permet de faire une recherche dans un champs de la table
'Retourne 0 si aucun enregistrement trouvé
'pour mettre un lien vers un champs mettre le symbole "@" puis le
'nom du champs contenant l'adresse URL
function rechercheDansChampsAccess(Nomtable, NomChamps, Info)
dim requete
'requete = "select * from "+Nomtable+" where "+NomChamps+"='"+cstr(Info)+"'"
requete1 = "select count(*) from "+Nomtable+" where instr("+NomChamps+", '"+Info+"')"
rechercheDansChampsAccess=GetRSAccess(requete1)
requete = "select * from "+Nomtable+" where instr("+NomChamps+", '"+Info+"')"
GetRSAccess(requete)
end function
'Trace un tableau et y affiche les résultats fiche par fiche
'd'une requete déjà préparée dans RS
'la liste des champs doit être séparée par des "/"
'Dans un nom de champs on peut trouver la légende du champs
'EX : /nomclient>Nom du client@chemin/
'@ : pour définir un lien vers chemin
function AfficheResultatFiche(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr)
rs.movefirst
for i=1 to NumDebut
rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
Compt=1
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
Response.Write("<td colspan='3'>")
Response.Write("<b><font face='Arial' size='5' color='#000080'>")
Response.Write(NumDebut+compt-1)
Response.Write("</font></b>")
Response.Write("</td>")
While encore
i=i+1
Response.Write("<tr>")
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write("- "+LibChamps+" : ")
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write("- "+LibChamps+" : ")
end if
Response.Write("</font></B>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
Response.Write(RS(NomChampsTemp))
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' target='_blank' style='color: #000080'>")
Response.Write(RS(NomChampsTemp))
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
Response.Write("</tr>")
else
encore=false
if EnrParTableau=true then
Response.Write("<table> <br>")
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='0' bordercolor='"+couleurbordure+"'>")
end if
end if
wend
rs.movenext
wend
end function
'cette fonction remplie une liste à partir d'une table
' le premier élément est séléctionné
function RemplirListeDeTableAccess(Table, Champ)
dim rs1
set rs1=objDB.Execute("select distinct "+champ+" from "+table+" order by "+champ)
Response.write("<select size='1' name='"+champ+"'>")
i=0
rs1.movefirst
while not (rs1.eof)
if i=0 then
Response.Write("<option selected>"+trim(rs1(champ))+"</option>")
else
Response.Write("<option>"+trim(rs1(champ))+"</option>")
end if
rs1.movenext
wend
Response.write("</select>")
end function
function zoneTexte(NomZone)
Response.Write("<input type='text' name='"+NomZone+"' size='20'>")
end function
'cette fonction permet de construire automatiquement
'un formulaire de recherche
'Les noms des champs sont séparés par des slash "/"
'Dans un nom de champs on peut trouver la légende du champs
'EX : /nomclient>Nom du client/
function ConstruireFormulaireRecherche(champs, fichierASP, couleur)
Response.Write("<font color='"+couleur+"' face='Verdana' size='1'>")
Response.Write("<form method='POST' action='"+fichierASP+"'>")
Response.Write("<table border='0'><tr>")
encore=true
ch=champs
dim i
i=1
While encore
i=i=+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
if i=false then
options="<select name='O"+NomChamps+"'><option selected>OU</option><option>ET</option></select>"
else
options=""
end if
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+LibChamps+"</td>")
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+options+"<input type='text' name='"+nomchamps+"' size='40'>"+"<input type='radio' value='"+NomChamps+"' name='Letri'> "+"</td></tr>")
else
encore=false
end if
wend
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+"Type Affichage</td><TD><input type='text' name='affichage' size='5' value='5'>")
Response.Write("<select name='TypeAffichage'><option>Liste</option><option selected>Fiche</option></select>")
Response.Write(" <input type='submit' value='OK' name='B1'>")
Response.Write(" <input type='reset' value='Annuler' name='B2' ></p></td></tr>")
Response.Write("</table>")
Response.Write("</form>")
end function
'Trace un tableau et y affiche les résultats sous forme de liste
'd'une requete déjà préparée dans RS
'la liste des champs doit être séparée par des "/"
'Dans un nom de champs on peut trouver la légende du champs
'EX : /nomclient>Nom du client@chemin/
'@ : pour définir un lien vers chemin
function AfficheResultatListe(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr)
if (not rs.eof) then rs.movefirst
for i=1 to NumDebut
if (not rs.eof) then rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
'ecriture de l'entete
encore=true
ch=champs
Response.Write("<tr>")
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write(LibChamps)
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write(LibChamps)
end if
Response.Write("</font></B>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("</tr>")
'.....................
Compt=1
Response.Write("<tr>")
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
Response.Write(RS(NomChampsTemp))
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' target='_blank' style='color: #000080'>")
Response.Write(RS(NomChampsTemp))
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("</tr>")
rs.movenext
wend
Response.Write("<tr>")
Response.Write(" Du ")
Response.Write(NumDebut+1)
Response.Write(" à ")
Response.Write(NumDebut+Compt-1)
Response.Write("</tr>")
Response.Write("</table>")
end function
'construit la clause WHERE d'une requete
'argument sous forme de :
' "code","001|002|003&005"
' "/" = ou entre les champs
' "\" = et entre les champs
' "|" = ou pour un seul champs
' "&" = et pour un seul champs
' "*" :
' cette fonction retourne false si la syntaxe est fausse
function critereRequete(nomChamps,ch)
ch1=ch
if ch<>"" then
resultat=nomChamps+" LIKE '"
for i = 1 to len(ch)
car=left(ch1,1)
select case car
case "&"
resultat=resultat+"' AND " +" "+nomChamps+" LIKE '"
case "|"
resultat=resultat+"' OR " +" "+nomChamps+" LIKE '"
case else resultat=resultat+car
end select
ch1=right(ch1,len(ch1)-1)
next
resultat=resultat+"'"
critereRequete=resultat
else
critereRequete=nomChamps+" LIKE '%'"
end if
end function
function Op(operateur)
if operateur="OU" then Op=" OR "
if operateur="ET" then Op=" AND "
end function
'permet de créer un formulaire de sasie d'une table
'pour avoir un textArea il faut terminer le nom du champs pas un espace comme suit
' "Nom/Prenom/Remarques /"
function ConstruireFormulaire(champs, fichierASP, couleur)
Response.Write("<font color='"+couleur+"' face='Verdana' size='1'>")
Response.Write("<form method='POST' action='"+fichierASP+"' id=form1 name=form1>")
Response.Write("<table border='0'><tr>")
encore=true
ch=champs
dim i
i=1
While encore
i=i=+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+LibChamps+"</td>")
if right(nomchamps,1)<>" " then
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+options+"<input type='text' name='"+nomchamps+"' size='40'>"+"</td></tr>")
else
'<textarea rows="2" name="S1" cols="40"></textarea>
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+options+"<textarea rows='4' cols='30' name='"+nomchamps+"' >"+"</textarea></td></tr>")
end if
else
encore=false
end if
wend
Response.Write(" <input type='submit' value='Envoyer' name='B1'>")
Response.Write(" <input type='reset' value='Annuler' name='B2' ></p></td></tr>")
Response.Write("</table>")
Response.Write("</form>")
end function
'****************************
function AfficheResultatFicheMemePage(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr)
rs.movefirst
for i=1 to NumDebut
rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
Compt=1
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
Response.Write("<td colspan='3'>")
Response.Write("<b><font face='Arial' size='5' color='#000080'>")
Response.Write(NumDebut+compt-1)
Response.Write("</font></b>")
Response.Write("</td>")
While encore
i=i+1
Response.Write("<tr>")
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write("- "+LibChamps+" : ")
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write("- "+LibChamps+" : ")
end if
Response.Write("</font></B>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
Response.Write(RS(NomChampsTemp))
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' style='color: #000080'>")
Response.Write(RS(NomChampsTemp))
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
Response.Write("</tr>")
else
encore=false
if EnrParTableau=true then
Response.Write("<table> <br>")
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='0' bordercolor='"+couleurbordure+"'>")
end if
end if
wend
rs.movenext
wend
end function
'************************************************
function AfficheResultatListeMemePage(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr)
if (not rs.eof) then rs.movefirst
for i=1 to NumDebut
if (not rs.eof) then rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
'ecriture de l'entete
encore=true
ch=champs
Response.Write("<tr>")
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write(LibChamps)
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write(LibChamps)
end if
Response.Write("</font></B>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("</tr>")
'.....................
Compt=1
Response.Write("<tr>")
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
Response.Write(RS(NomChampsTemp))
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' style='color: #000080'>")
Response.Write(RS(NomChampsTemp))
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("</tr>")
rs.movenext
wend
Response.Write("<tr>")
Response.Write(" Procédures de ")
Response.Write(NumDebut+1)
Response.Write(" à ")
Response.Write(NumDebut+Compt-1)
Response.Write("</tr>")
Response.Write("</table>")
end function
'*******************************************
function AfficheResultatListeSansRepetition(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr)
if (not rs.eof) then rs.movefirst
for i=1 to NumDebut
if (not rs.eof) then rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
'ecriture de l'entete
encore=true
ch=champs
Response.Write("<tr>")
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write(LibChamps)
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write(LibChamps)
end if
Response.Write("</font></B>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("</tr>")
'.....................
Compt=1
Response.Write("<tr>")
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
if UCase(RS(NomChampsTemp))<> ucase(session("V"+NomChampsTemp)) then
Response.Write(RS(NomChampsTemp))
session("V"+NomChampsTemp)=RS(NomChampsTemp)
else
session("V"+NomChampsTemp)=RS(NomChampsTemp)
Response.Write("-")
end if
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' target='_blank' style='color: #000080'>")
Response.Write(RS(NomChampsTemp))
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("</tr>")
rs.movenext
wend
Response.Write("<tr>")
Response.Write(" Procédures de ")
Response.Write(NumDebut+1)
Response.Write(" à ")
Response.Write(NumDebut+Compt-1)
Response.Write("</tr>")
Response.Write("</table>")
end function
'*******************Donner la possibilité de modifier les informations*****************************
function AfficheListeModif(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr,cle,FichModif,FichSupp,mode)
if (not rs.eof) then rs.movefirst
for i=1 to NumDebut
if (not rs.eof) then rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
'ecriture de l'entete
encore=true
ch=champs
Response.Write("<tr>")
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write(LibChamps)
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write(LibChamps)
end if
Response.Write("</font></B>")
Response.Write("</td>")
else
Response.Write("<td>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
Response.Write(" Actions ")
Response.Write("</font></B>")
Response.Write("</td>")
encore=false
end if
wend
Response.Write("</tr>")
'.....................
Compt=1
Response.Write("<tr>")
while (not(rs.eof))and (Compt<=EnrParTableau)
Compt=Compt+1
encore=true
ch=champs
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
if mode=0 then
Response.Write(RS(NomChampsTemp))
else
Response.Write(RS(cint(NomChampsTemp)))
end if
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' style='color: #000080'>")
'Response.Write(RS(NomChampsTemp))
if mode=0 then
Response.Write(RS(NomChampsTemp))
else
Response.Write(RS(cint(NomChampsTemp)))
end if
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("<td>")
if (session("profil")<=1 ) then
Response.Write(" <a href='"+FichModif+"?"+cle+"="&rs(cle)&"'><img border='0' src='modifier.gif' alt='Modifier'></a>")
Response.Write(" <a href='"+FichSupp+"?"+cle+"="&rs(cle)&"'><img border='0' src='detruire.gif' alt='Supprimer'></a>")
else
Response.Write(" ")
end if
Response.Write("</td>")
Response.Write("</tr>")
rs.movenext
wend
end function
function traiterSuppression(message,lien)
response.write("<br><font face=Verdana size=1 color=#000080>")
Response.write("Attention : "+message+" <br>pour continuer cliquez sur")
Response.Write("<a href="+lien+"> Supprimer</a> et pour annuler la suppression cliquez sur ")
Response.Write("<a href=javascript:history.go(-1)>Retour</a></font>")
end function
'cette fonction remplie une liste à partir du résultat d'une requete
''élément sélectionné est Champs
function RemplirListeDeRequeteAccessModif(Champ, requete,ChampBD)
dim rs1
set rs1=objDB.Execute(requete)
i=0
existe=0
if not (rs1.eof) then
Response.write("<select size='1' name='"+champ+"' value='"+rs(ChampBD)+"'>")
rs1.movefirst
while not (rs1.eof)
i=i+1
existe=existe+1
if rs1(champ)=rs(ChampBD) then
Response.Write("<option selected>"+rs1(champ)+"</option>")
else
Response.Write("<option velue='"+rs1(champ)+"'>"+rs1(champ)+"</option>")
end if
rs1.movenext
wend
Response.write("</select>")
end if
RemplirListeDeRequeteAccessModif=existe
end function
function RemplirListeDeRequeteAccess(Champ,champ1, requete)
dim rs1
set rs1=objDB.Execute(requete)
i=0
existe=0
if not (rs1.eof) then
Response.write("<select size='1' name='"+champ+"'>")
rs1.movefirst
while not (rs1.eof)
existe=existe+1
i=i+1
if i=0 then
Response.Write("<option>"+rs1(champ)+"</option>")
else
Response.Write("<option>"+rs1(champ)+"</option>")
end if
rs1.movenext
wend
Response.write("</select>")
end if
end function
function RemplirListeMultipleSelections(NomListe,Champ,ChampIndex, requete)
dim rs1
set rs1=objDB.Execute(requete)
i=0
existe=0
if not (rs1.eof) then
Response.write("<select id='"+NomListe+"' name='"+NomListe+"' SIZE='6'> ")
rs1.movefirst
while not (rs1.eof)
existe=existe+1
texte=replace(trim(rs1(ChampIndex))," "," ")
Response.Write("<option value="&texte&">"+rs1(champ)+"</option>")
rs1.movenext
wend
Response.write("</select>")
end if
end function
function ConstruireFormulaireRechercheModif(champs, fichierASP, couleur)
Response.Write("<font color='"+couleur+"' face='Verdana' size='1'>")
Response.Write("<form method='POST' action='"+fichierASP+"?nouvelle=oui' id=form1 name=form1>")
Response.Write("<table border='0'><tr>")
encore=true
ch=champs
dim i
i=1
While encore
i=i=+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
if i=false then
options="<select name='O"+NomChamps+"'><option selected>OU</option><option>ET</option></select>"
else
options=""
end if
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+LibChamps+"</td>")
Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+options+"<input type='text' name='"+nomchamps+"' size='40'>"+"<input type='radio' value='"+NomChamps+"' name='Letri'> "+"</td></tr>")
else
encore=false
end if
wend
'Response.Write("<td>"+"<font color='"+couleur+"' face='Verdana' size='1'>"+"Type Affichage</td><TD><input type='text' name='affichage' size='5' value='5'>")
'Response.Write("<select name='TypeAffichage'><option selected>Liste</option><option>Fiche</option></select>")
Response.Write(" <input type='submit' value='OK' name='B1'>")
Response.Write(" <input type='reset' value='Annuler' name='B2' ></p></td></tr>")
Response.Write("</table>")
Response.Write("</form>")
end function
'*******************Donner la possibilité de modifier les informations*****************************
function AfficheResultatListeModif(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr,cle,FichModif,FichInfo,FichSupp)
if (not rs.eof) then rs.movefirst
for i=1 to NumDebut
if (not rs.eof) then rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
'ecriture de l'entete
encore=true
ch=champs
Response.Write("<tr>")
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write(LibChamps)
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write(LibChamps)
end if
Response.Write("</font></B>")
Response.Write("</td>")
else
Response.Write("<td>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
Response.Write(" Actions ")
Response.Write("</font></B>")
Response.Write("</td>")
encore=false
end if
wend
Response.Write("</tr>")
'.....................
Compt=1
Response.Write("<tr>")
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
Response.Write(RS(NomChampsTemp))
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' style='color: #000080'>")
Response.Write(RS(NomChampsTemp))
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("<td>")
Response.Write("<a href='"+FichInfo+"?cle="+rs(cle)+"&debut=0&nombre=10'><img border='0' src='Info.gif' alt='Liste des activités attachées'></a>")
Response.Write(" <a href='"+FichModif+"?cle="+rs(cle)+"'><img border='0' src='modifier.gif' alt='Modifier'></a>")
Response.Write(" <a href='"+FichSupp+"?cle="+rs(cle)+"'><img border='0' src='detruire.gif' alt='Supprimer'></a>")
Response.Write("</td>")
Response.Write("</tr>")
rs.movenext
wend
end function
function ecrire(chaine)
Response.Write(chaine)
end function
'-----------------------------
function traiterSuppressiondeuxcles(message,lien)
response.write("<br><font face=Verdana size=1 color=#000080>")
Response.write("Attention : "+message+" <br>pour continuer cliquez sur")
Response.Write("<a href="+lien+"> Supprimer</a> et pour annuler la suppression cliquez sur ")
Response.Write("<a href=javascript:history.go(-1)>Retour</a></font>")
end function
'--------------------------------
'ENVOYER MODIFPER & SUPPPER DS LA MEME PAGE
function AfficheListeModif1(champs, couleurNom, couleurDonnee,TailleBordure,couleurFond,couleurbordure,EnrParTableau,NumDebut,NombreEnr,cle,FichModif,FichSupp,mode)
Response.Write("<p align='left'>")
Response.Write(" <a href='"+FichModif+"?"+cle+"="+rs(cle)+"&MaJ=Ajouter'><img border='0' src='ADD.gif' alt='Ajouter'><p></a>")
if (not rs.eof) then rs.movefirst
for i=1 to NumDebut
if (not rs.eof) then rs.movenext
next
Response.Write("<table border='"+TailleBordure+"' bgcolor='"+couleurfond+"' width='100%' cellspacing='1' cellpadding='1' bordercolor='"+couleurbordure+"'>")
'ecriture de l'entete
encore=true
ch=champs
Response.Write("<tr>")
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td align='center'>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
posSup=instr(NomChamps,">")
if posSup<>0 then
NomChamps1=left(NomChamps,posSup-1)
LibChamps=right(NomChamps,len(NomChamps)-posSup)
NomChamps=NomChamps1
else
LibChamps=NomChamps
end if
Response.Write(LibChamps)
else
x=instr(NomChamps,"@")
NomChampsTemp=NomChamps
'tester sur la légende
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=left(NomChampsTemp,x-1)
end if
Response.write(LibChamps)
end if
Response.Write("</font></B>")
Response.Write("</td>")
else
Response.Write("<td>")
Response.Write("<B><font color='"+couleurNom+"' face='Verdana' size='1'>")
Response.Write(" Actions ")
Response.Write("</font></B>")
Response.Write("</td>")
encore=false
end if
wend
Response.Write("</tr>")
'.....................
Compt=1
Response.Write("<tr>")
while (not(rs.eof))and (Compt<=NombreEnr)
Compt=Compt+1
encore=true
ch=champs
While encore
i=i+1
posSlash=instr(ch,"/")
if posSlash>0 then
NomChamps=left(ch,posSlash-1)
ch=right(ch,len(ch)-posSlash)
Response.Write("<td>")
Response.Write("<font color='"+couleurDonnee+"' face='Verdana' size='1'>")
if instr(NomChamps,"@")=0 then
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
if mode=0 then
Response.Write(RS(NomChampsTemp))
else
Response.Write(RS(cint(NomChampsTemp)))
end if
else
'tester sur la légende
NomChampsTemp=NomChamps
posSup=instr(NomChampsTemp,">")
if posSup<>0 then
NomChamps1=left(NomChampsTemp,posSup-1)
LibChamps=right(NomChampsTemp,len(NomChampsTemp)-posSup)
NomChampsTemp=NomChamps1
else
LibChamps=NomChampsTemp
end if
x=instr(NomChampsTemp,"@")
y=left(NomChampsTemp,x-1)
url=right(NomChampsTemp,len(NomChampsTemp)-x)
NomChampsTemp=y
Response.Write("<a href='"+RS(url)+"' style='color: #000080'>")
'Response.Write(RS(NomChampsTemp))
if mode=0 then
Response.Write(RS(NomChampsTemp))
else
Response.Write(RS(cint(NomChampsTemp)))
end if
Response.Write("</a>")
end if
Response.Write("</font>")
Response.Write("</td>")
else
encore=false
end if
wend
Response.Write("<td>")
dim t
if (session("profil")<=1 ) then
Response.Write(" <a href='"+FichModif+"?"+cle+"="+rs(cle)+"&MaJ=Modifier'><img border='0' src='modifier.gif' alt='Modifier' ></a>")
'op=Modification&code="+cstr(rs("codedoc"))+"'
Response.Write(" <a href='"+FichModif+"?"+cle+"="+rs(cle)+"&MaJ=Supprimer'><img border='0' src='detruire.gif' alt='Supprimer'></a>")
'Response.Write(" <a href='"+FichModif+"?"+cle+"="+rs(cle)+"&MaJ=Ajouter'><img border='0' src='ADD.gif' alt='Ajouter'></a>")
else
Response.Write(" ")
end if
Response.Write("</td>")
Response.Write("</tr>")
rs.movenext
wend
'Response.Write("<p align='right'>")
'Response.Write("<a href='Recherche"+$table$+"'>Rechercher</a></font>")
end function
'ASP Generator CODE (c) 2001-2002 [www.aspgenerator.net]
'Revenez sur www.aspgenerator.net ! vous y trouverez la documentation complète de la
'bibiothèque !!!
</script>
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.