<%@ Language="VBScript" %>
<%
' ============================================================
' save_results.asp
' Reçoit les réponses de l'exercice TP Nuisibles (JSON en POST)
' et les enregistre dans la base SQL Server.
' ============================================================
Response.Buffer = True
Response.ContentType = "application/json"
Response.CharSet = "UTF-8"

' ------- À ADAPTER : chaîne de connexion vers votre base -------
' Récupérée depuis le panneau "Manage Databases" de FreeASPHosting :
'   Server Name : sql.bsite.net\MSSQL2016
'   SQL Username : nextgnformation_reponses_exercices
'   Database name : (généralement identique au username, à vérifier dans le panneau)
Dim connString
connString = "Provider=SQLOLEDB;Data Source=sql.bsite.net\MSSQL2016;" & _
             "Initial Catalog=nextgnformation_reponses_exercices;" & _
             "User ID=nextgnformation_reponses_exercices;" & _
             "Password=S5$NyFXzEjJCg6jD;"
' -----------------------------------------------------------------

Function JSONEscape(s)
    s = Replace(s, "\", "\\")
    s = Replace(s, Chr(34), "\""")
    s = Replace(s, vbCrLf, "\n")
    s = Replace(s, vbLf, "\n")
    s = Replace(s, vbCr, "\n")
    s = Replace(s, vbTab, "\t")
    JSONEscape = s
End Function

Sub SendJSON(success, message)
    Dim out
    out = "{""success"":" & LCase(CStr(success)) & ",""error"":""" & JSONEscape(message) & """}"
    Response.Write out
    Response.End
End Sub

' --- Lecture du corps de la requête (JSON brut envoyé en POST) ---
Dim rawJSON
Dim totalBytes
totalBytes = Request.TotalBytes
If totalBytes = 0 Then
    SendJSON False, "Aucune donnée reçue."
End If

Dim binData
binData = Request.BinaryRead(totalBytes)

' Conversion des octets UTF-8 en chaîne VBScript
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 ' adTypeBinary
objStream.Open
objStream.Write binData
objStream.Position = 0
objStream.Type = 2 ' adTypeText
objStream.CharSet = "utf-8"
rawJSON = objStream.ReadText
objStream.Close
Set objStream = Nothing

If Trim(rawJSON) = "" Then
    SendJSON False, "Corps de requête vide."
End If

' --- Parsing JSON minimal sans librairie externe ---
' On utilise le moteur JScript via ScriptControl pour parser le JSON de façon fiable.
Dim sc
Set sc = Server.CreateObject("MSScriptControl.ScriptControl")
sc.Language = "JScript"
sc.AddCode "function parseIt(s){ return eval('(' + s + ')'); } " & _
           "function getStr(o,k){ return (o && o[k] != null) ? String(o[k]) : ''; } " & _
           "function getReponsesJSON(o){ var arr = o.reponses || []; var out = []; " & _
           "for (var i=0;i<arr.length;i++){ out.push({id:String(arr[i].id||''), question:String(arr[i].question||''), reponse:String(arr[i].reponse||'')}); } return out; } " & _
           "function getTableauJSON(o){ var arr = o.tp3_tableau || []; var out = []; " & _
           "for (var i=0;i<arr.length;i++){ out.push({etape:String(arr[i].etape||''), risque:String(arr[i].risque||''), mesure:String(arr[i].mesure||'')}); } return out; }"

Dim dataObj
On Error Resume Next
Set dataObj = sc.Run("parseIt", rawJSON)
If Err.Number <> 0 Then
    SendJSON False, "JSON invalide : " & Err.Description
End If
On Error Goto 0

Dim nom, dateSession, casChoisi, casCle, dateEnvoi
Dim metaIntitule, metaDescription, metaLieu, metaDebut, metaRealise, metaVerifie, metaMaj

nom            = sc.Run("getStr", dataObj, "nom")
dateSession    = sc.Run("getStr", dataObj, "date_session")
casChoisi      = sc.Run("getStr", dataObj, "cas_choisi")
casCle         = sc.Run("getStr", dataObj, "cas_cle")
dateEnvoi      = sc.Run("getStr", dataObj, "date_envoi")

Dim tp3Obj
tp3Obj = dataObj.tp3_meta
metaIntitule    = sc.Run("getStr", tp3Obj, "intitule")
metaDescription = sc.Run("getStr", tp3Obj, "description")
metaLieu        = sc.Run("getStr", tp3Obj, "lieu")
metaDebut       = sc.Run("getStr", tp3Obj, "debut")
metaRealise     = sc.Run("getStr", tp3Obj, "realise_par")
metaVerifie     = sc.Run("getStr", tp3Obj, "verifie_par")
metaMaj         = sc.Run("getStr", tp3Obj, "maj_par")

If Trim(nom) = "" Then
    SendJSON False, "Le nom du groupe est obligatoire."
End If

' --- Sérialisation des réponses et du tableau en JSON texte (stockés en colonnes NVARCHAR(MAX)) ---
Dim reponsesArr, tableauArr
Set reponsesArr = sc.Run("getReponsesJSON", dataObj)
Set tableauArr = sc.Run("getTableauJSON", dataObj)

Dim reponsesJSONStr, tableauJSONStr
reponsesJSONStr = "["
Dim i
For i = 0 To reponsesArr.length - 1
    If i > 0 Then reponsesJSONStr = reponsesJSONStr & ","
    reponsesJSONStr = reponsesJSONStr & "{""id"":""" & JSONEscape(reponsesArr.Item(i).id) & _
        """,""question"":""" & JSONEscape(reponsesArr.Item(i).question) & _
        """,""reponse"":""" & JSONEscape(reponsesArr.Item(i).reponse) & """}"
Next
reponsesJSONStr = reponsesJSONStr & "]"

tableauJSONStr = "["
For i = 0 To tableauArr.length - 1
    If i > 0 Then tableauJSONStr = tableauJSONStr & ","
    tableauJSONStr = tableauJSONStr & "{""etape"":""" & JSONEscape(tableauArr.Item(i).etape) & _
        """,""risque"":""" & JSONEscape(tableauArr.Item(i).risque) & _
        """,""mesure"":""" & JSONEscape(tableauArr.Item(i).mesure) & """}"
Next
tableauJSONStr = tableauJSONStr & "]"

' --- Connexion et insertion en base ---
Dim conn
Set conn = Server.CreateObject("ADODB.Connection")

On Error Resume Next
conn.Open connString
If Err.Number <> 0 Then
    SendJSON False, "Connexion BDD impossible : " & Err.Description
End If
On Error Goto 0

' Création de la table si elle n'existe pas encore
Dim createTableSQL
createTableSQL = "IF NOT EXISTS (SELECT * FROM sysobjects WHERE name='tp_resultats' AND xtype='U') " & _
    "CREATE TABLE tp_resultats (" & _
    "id INT IDENTITY(1,1) PRIMARY KEY, " & _
    "nom NVARCHAR(255), " & _
    "date_session NVARCHAR(50), " & _
    "cas_choisi NVARCHAR(255), " & _
    "cas_cle NVARCHAR(100), " & _
    "reponses_json NVARCHAR(MAX), " & _
    "tp3_intitule NVARCHAR(500), " & _
    "tp3_description NVARCHAR(1000), " & _
    "tp3_lieu NVARCHAR(500), " & _
    "tp3_debut NVARCHAR(50), " & _
    "tp3_realise_par NVARCHAR(255), " & _
    "tp3_verifie_par NVARCHAR(255), " & _
    "tp3_maj_par NVARCHAR(255), " & _
    "tp3_tableau_json NVARCHAR(MAX), " & _
    "date_envoi NVARCHAR(50), " & _
    "date_enregistrement DATETIME DEFAULT GETDATE())"

On Error Resume Next
conn.Execute createTableSQL
If Err.Number <> 0 Then
    SendJSON False, "Création de table impossible : " & Err.Description
End If
On Error Goto 0

' Insertion via requête paramétrée (Command) pour éviter les injections SQL
Dim cmd
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = conn
cmd.CommandText = "INSERT INTO tp_resultats " & _
    "(nom, date_session, cas_choisi, cas_cle, reponses_json, tp3_intitule, tp3_description, tp3_lieu, tp3_debut, tp3_realise_par, tp3_verifie_par, tp3_maj_par, tp3_tableau_json, date_envoi) " & _
    "VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
cmd.CommandType = 1 ' adCmdText

Dim p
Set p = cmd.CreateParameter("nom", 202, 1, 255, nom) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("date_session", 202, 1, 50, dateSession) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("cas_choisi", 202, 1, 255, casChoisi) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("cas_cle", 202, 1, 100, casCle) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("reponses_json", 203, 1, Len(reponsesJSONStr), reponsesJSONStr) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_intitule", 202, 1, 500, metaIntitule) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_description", 202, 1, 1000, metaDescription) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_lieu", 202, 1, 500, metaLieu) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_debut", 202, 1, 50, metaDebut) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_realise_par", 202, 1, 255, metaRealise) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_verifie_par", 202, 1, 255, metaVerifie) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_maj_par", 202, 1, 255, metaMaj) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("tp3_tableau_json", 203, 1, Len(tableauJSONStr), tableauJSONStr) : cmd.Parameters.Append p
Set p = cmd.CreateParameter("date_envoi", 202, 1, 50, dateEnvoi) : cmd.Parameters.Append p

On Error Resume Next
cmd.Execute
If Err.Number <> 0 Then
    conn.Close
    SendJSON False, "Erreur lors de l'insertion : " & Err.Description
End If
On Error Goto 0

conn.Close
Set conn = Nothing

SendJSON True, ""
%>