Intégration VBScript pour le défunt comparateur MonsieurPrix.fr

http://monsieurprix.fr était un comparateur de prix spécialisé sur le secteur informatique, avant d'être racheté par son concurrent Kelkoo en 2003.

<% @language="VBScript" %>
<% option explicit %>
<%
Response.Buffer = True
Response.CacheControl = "Public"
Response.Expires = 15
Response.ContentType = "application/xml"
Server.ScriptTimeout = 600

Const	path			= "/data/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 "&nbsp;<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
Response.Write "<?xml version=""1.0"" encoding=""iso-8859-1""?>" & vbCRLF
Response.Write "<tarif>" & vbCRLF
Response.Write "<iso-currency default=""FRF"" />" & vbCRLF
call getPriceList ()
Response.Write vbCRLF & "</tarif>" & vbCRLF
%>