Ecommerce DEV - Organiser sur votre site ASP des Quizz pour faire gagner des lots à vos visiteurs

avr 11 2006

Organiser sur votre site ASP des Quizz pour faire gagner des lots à vos visiteurs

Programmation - ASP/.Net/PHP

Ecrit par www.asp-php.net

11-04-2006

Organiser sur votre site ASP des Quizz pour faire gagner des lots à vos visiteurs

Ce code vous permettra d'organiser sur votre site des concours sous forme de Quizz permettant de faire gagner des lots à vos visiteurs... Une page ASP a donc été écrite pour permettre la gestion complète de ce jeu. Celle-ci est extraite du site: http://www.asp-php.net. Pour télécharger le code source de ce script cliquez sur ce lien.

1. Le lien d'appel

Un simple lien javascript permet d'ouvrir la page dans un popUp :

<A href="javascript:void(0)"
onclick="window.open('quizz.asp',null,'width=600,height=560,left=20,top=20,'
+ ' status=no, directories=no, toolbar=no, location=no, menubar=no, scrollbars=yes, resizable=no')"
>PARTICIPEZ AU CONCOURS !</A>

2. La base de données

J'utilise ici une base MSAccess quizz.mdb générée par AxS et comportant une table joueurs ayant les champs suivants :

ID NumAuto (entier long auto-incrémenté)

Nom Texte (100)

Prenom Texte (100)

Adresse Texte (100)

CP Texte (20)

Ville Texte (100)

Email Texte (100)

Date Date/Heure

Score Octal

NbQuest Octal

IP Texte (20)

3. Remarques

Ce quizz n'autorise qu'un jeu par connexion (stockage de l'IP dans la BD)... pour permettre plusieurs jeux successifs adaptez ou supprimez les lignes concernées :

<% ' === PAGE 1 : Questions ===

if request.form.count = 0 and request.queryString.count = 0 then

   ' 1 seule participation par IP
   Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & database
   SQL = "SELECT * FROM joueurs where IP='" & IP & "'"
   RS.open SQL,conn,3,3
   test = RS.eof
   RS.close
   Conn.close

   if not test then%>
      <script>location.replace("quizz.asp?redir")</script>
   <%end if
%>

4. Tirage aléatoire

A l'issue du jeu, un tirage aléatoire doit être fait parmi les joueurs ayant répondu correctement aux questions... cette petite procédure (à appeler dans une page "admin") devrait vous aider à l'automatiser :

<% ' TIRAGE ALEATOIRE DANS LA BD

sub tirage(tours,base,requete)
   dim alea,Conn,RS,cpt,mem
   ' Connexion
   Set Conn = Server.CreateObject("ADODB.Connection")
   Set RS = server.createobject("ADODB.Recordset")
   Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & base
   ' Sélection de tous les enregistrements
   RS.Open requete,Conn,3,3
   cpt = 0 : mem = "|"
   ' En-têtes du tableau
   response.write "<table border cellspacing=0 cellpadding=2><tr>"
   for each champ in RS.Fields
      response.write "<td><b>" & champ.name & "</b></td>"
   next
   response.write "</tr>"
   ' Tirage parmi les enregistrements
   randomize
   while cpt < tours
      alea = Int(RS.recordCount * Rnd)
      ' Déjà sorti ?
      if instr(mem, "|" & cStr(alea) & "|") < 1 then
         cpt = cpt + 1
         mem = mem & cStr(alea) & "|"
         RS.moveFirst : RS.move(alea)
         ' Affiche l'enregistrement
         response.write "<tr>"
         for each champ in RS.Fields
            response.write "<td>" & RS(champ.name) & "</td>"
         next
         response.write "</tr>"
      end if
   wend
   response.write "</table>"
   ' Déconnexion
   RS.close
   Conn.close
end sub

' Exemple d'appel :
' database = Server.MapPath("../../") & "\database\asphp2\quizz.mdb"
' SQL = "SELECT * FROM joueurs WHERE Score = NbQuest"
' tirage 2,database,SQL
%>

5. Le module d'envoi de mails

Lors de la validation du dernier formulaire, un message est automatiquement envoyé au joueur pour lui confirmer son inscription. Le serveur étant équipé du composant ASPMail, le script ci-dessous est utilisé, mais vous pouvez l'adapter en fonction de votre composant...

<% ' Interface pour ASPmail 3.0 ou + >> maj DY 05/05/02 - www.ASP-PHP.net

Function sendMail(nomFrom,mailFrom,nomTo,mailTo,CC,BCC,subject,body,pj)
   on error resume next
   dim Mail,FSO,inF,i,temp,test
   ' création des objets
   Set FSO = Server.CreateObject("Scripting.FileSystemObject")
   Set Mail = Server.CreateObject("SMTPsvg.Mailer")
   ' SERVEUR
   Mail.RemoteHost = "mail.asp-php.net"
   ' EXPÉDITEUR
   Mail.FromName = nomFrom
   Mail.FromAddress = mailFrom
   ' DESTINATAIRE
   if inStr(mailTo,"@") > 0 then
      if nomTo<>"" then Mail.Addrecipient nomTo, mailTo _
      else Mail.Addrecipient mailTo, mailTo
   end if
   ' COPIE CONFORME
   if inStr(CC,"@") > 0 then
      ' adresses séparées par ,
      temp = split(CC,",",-1,1)
      for i = 0 to ubound(temp)
         if inStr(temp(i),"@") > 0 then Mail.AddCC ".", temp(i)
      next
   end if
   ' COPIE CONFORME INVISIBLE
   if inStr(BCC,"@") > 0 then
      ' adresses séparées par ,
      temp = split(BCC,",",-1,1)
      for i = 0 to ubound(temp)
         if inStr(temp(i),"@") > 0 then Mail.AddBCC ".", temp(i)
      next
   ' ou en lisant un fichier (65 Ko max !)
   elseif BCC <> "" then
      temp = BCC
      if left(temp,1) = "/" then temp = server.MapPath("/") & replace(temp,"/","\")
      if FSO.fileExists(temp) then
         set inF = FSO.openTextFile(temp,1,false)
         while not inF.AtEndOfStream
            test = inF.readLine
            if inStr(test,"@") > 0 then Mail.AddBCC ".", test
         wend
         inF.close
      end if
   end if
   ' TITRE
   Mail.Subject = subject
   ' CORPS (format html ou non)
   if lcase(left(body,6)) = "<html>" then Mail.ContentType="text/html"
   Mail.BodyText = body
   ' PIÈCES JOINTES séparées par ,
   if pj <> "" then
      temp = split(pj,",",-1,1)
      for i = 0 to ubound(temp)
         if instr(temp(i),"\") < 1 then ' path court
            test = prefix
            if test = "" then test = "/"
            temp(i) = server.MapPath(test & temp(i))
         end if
         if FSO.fileExists(temp(i)) then Mail.AddAttachment temp(i)
      next
   end if
   ' et zou... retourne false si erreur !
   sendMail = Mail.SendMail
   if err then sendMail = false
end Function
%>

Dernière mise à jour : ( 06-11-2006 )