Soyez le premier à donner votre avis sur cette source.
Snippet vu 20 111 fois - Téléchargée 34 fois
<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>
@+
en faite je cherche a connaitre le nom des champs d'une table, c'est a dire que je veut une requette sql me permettant de relever ces nom, j'en ai besoin pour une api en vb mais le mieu ce serai d'avoir la requette sql donc a bon entendeur
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.