http://pacher.fr était un comparateur de prix (2013-2014), avant que le nom ne soit repris par une agence web rennaise (2017) puis devienne un domain parking.
<% @language="VBScript" %>
<% option explicit %>
<%
Response.Buffer = True
Response.CacheControl = "Public"
Response.Expires = 15
Response.ContentType = "text/plain"
Server.ScriptTimeout = 600
Const path = "tarifs.mdb" ' Chemin relatif d'acces a la base
Const strProvider = "DRIVER={Microsoft Access Driver (*.mdb)};" ' Provider OLE DB
Const csPagePrix = "/code/pacher.asp"
Const tauxTVA = 0.196
Dim conn ' Connexion ADO
Dim i,curi ' Indices generiques
Dim q ' Requete ADO
Dim argc ' Nombre de parametres
Dim curgamme ' La gamme en cours de listage
Dim rs ' RecordSet ADO generique
Dim sBrandName ' Nom de la marque en cours de visualisation
Dim sBrandNotes ' Notes sur la marque en cours de visualisation
Dim sBrandURL ' URL de base de la marque sur OSInet
Dim sBrandLogo ' URL du logo de la marque, relatif a /data/images
Dim s ' Buffer chaine generique
Dim dBrands ' Dictionnaire marques
Dim newscount ' Nombre d'articles de news sur la marque
'-- Formatage de nombres a la francaise ------------------
Private function CleanFormatNumber (byval x)
Dim n
if IsNumeric (x) then
CleanFormatNumber = FormatNumber (x, 2, -1, 0, -1)
else
CleanFormatNumber = "<a href=""https://osinet.fr/contact"">n.c.</a>"
end if
end function
'-- Formatage de dates a la francaise --------------------
Private function CleanFormatDate (byval x)
Dim n
if IsDate (x) then
CleanFormatDate = FormatDateTime (x, 2)
else
CleanformatDate = "-"
end if
end function
'-- /Formatage de nombres a la francaise -----------------
'-- Initialisation donnees globales ----------------------
' Modifie: argc, conn
Private Sub InitGlobals
argc = Request.QueryString.Count
set conn=server.createobject("ADODB.connection")
conn.Open strProvider & "DBQ=" & server.mappath(path)
End Sub
'-- Lecture des tarifs --
' Depend de: conn
Private Sub GetPriceList
Const csqPacher = "PacherQuery"
Const ciChunkSize = 255
Dim rs ' Resultat ADO
Dim size ' Taille du memo Notes
Dim ofs ' Offset dans le memo
Dim chunk ' Bloc de donnees du memo Notes
Dim s
Dim pvht, pvttc
q = csqPacher
set rs = conn.execute (q)
do while not rs.eof
Response.Write "<article>"
Response.Write "<cat>" & rs.Fields("Catégorie") & "</cat>" & vbTAB
Response.Write "<marque>" & rs.Fields("Marque") & "</marque>" & vbTAB
Response.Write "<produit>"
Response.Write "<nom>" & rs.Fields("Nom") & "</nom>" & vbTAB
s = rs.Fields("Version")
if ("x" & s & "x") = "xx" then
s = "NC"
end if
Response.Write "<version>" & s & "</version>" & vbTAB
Response.Write "<langue>" & rs.Fields("langue") & "</langue>" & vbTAB
Response.Write "<notes>" & rs.Fields("notes") & "</notes>" & vbTAB
Response.Write "<pn>" & rs.Fields("PN") & "</pn>" & vbTAB
Response.Write "</produit>"
pvht = rs.Fields("PVHT")
pvttc = pvht * (1 + tauxTVA)
Response.Write "<ttc>" & FormatNumber (pvttc, 2, 0, 0, 0) & "</ttc>"
Response.Write "</article>" & vbCRLF
' On ne peut pas simplement faire sBrandNews = rs.Fields(1) car c'est un champ long (adFldLong dans Field.Attributes)
' On peut toutefois le coller dans une chaine car du fait de la nature du site, il est raisonnablement petit.
'chunk = rs.Fields(1).GetChunk (ciChunkSize)
'do while not IsNull (chunk)
' sBrandNews = sBrandNews + chunk
' chunk = rs.Fields(1).GetChunk (ciChunkSize)
' loop
'if not IsNull (rs.Fields(2)) then
' abstract = "<span class=""abstract"">" & rs.Fields(2) & "</span></p><p>"
'else
' abstract = ""
' end if
'Response.Write "<p><em>" & CleanFormatDate (rs.fields (0)) & "</em> - " & abstract & sBrandNews
'if not IsNull (rs.Fields(3)) then
' url = rs.Fields(3)
' Response.Write " <span class=""moreinfo""><a href=""" & url & """>Plus d'infos</a></span>"
' end if
rs.MoveNext
loop
rs.close
set rs = Nothing
end Sub
'== Debut du code principal ==============================
setLocale (1036)
call InitGlobals () ' Positionne argc, conn
call getPriceList ()
%>