<%@ LANGUAGE = VBScript%> <% ' Copyright 2003 D. P. Story ' All Rights Reserved ' See eq2dbman.pdf for some documentation ' NOTICE: This program can redistributed and/or modified under ' the terms of the LaTeX Project Public License ' Distributed from CTAN archives in directory ' macros/latex/base/lppl.txt; either version 1 of the ' License, or (at your option) any later version. ' This script is offered "as is", no guarantees are extended. ' eqRecord should be extensively tested on your own system ' until you are satisified with its functionality and ' reliability. Response.buffer = True Dim DebugTxt, DebugFDF Dim ErcStatus : ErcStatus = "Problems Reported: " Dim dotReplace : dotReplace = "_" DebugTxt = 0 DebugFDF = 0 If DebugTxt Then Response.ContentType = "text/html" Else Response.ContentType = "application/vnd.fdf" End If On error Resume Next Rem Create an FDF object Set FdfAcx = Server.CreateObject("FdfApp.FdfApp") Set FDFout = FdfAcx.FDFCreate Rem Parse Incoming Data Set FDFin = FdfAcx.FDFOpenFromBuf (Request.BinaryRead(Request.TotalBytes)) Rem Declare some variables Dim cBuf, cDbName, cTableName, cQuiz Dim cTime : cTime = Now ' Get Required info cDbName = FDFin.FDFGetValue("dbName") cTableName = FDFin.FDFGetValue("dbTable") cQuiz = FDFin.FDFGetValue("quizName") Rem Query the database On error Resume Next Set DataConn = Server.CreateObject("ADODB.Connection") ' DataConnConnecString = cDbName DataConn.Open cDbName Set RecSet = Server.CreateObject("ADODB.Recordset") RecSet.CursorType = 1 RecSet.LockType = 2 RecSet.ActiveConnection = DataConn RecSet.Source=cTableName DataConn.BeginTrans RecSet.Open If Err.Number <> 0 Then If DebugTxt Then Response.Write "Problems opening database
" End If End If RecSet.AddNew On error Resume Next RecSet("quizName") = cQuiz If Err.Number <> 0 Then If DebugTxt Then Response.Write "Problems storing quizName." &"
" End If Err.Clear End If If DebugTxt Then Response.Write "dbName: " & cDbName & "
" Response.Write "quizName = " & cQuiz &"
" End If RecSet("TimeOfQuiz") = cTime If Err.Number <> 0 Then If DebugTxt Then Response.Write "Problems storing time, possibly no TimeOfQuiz field" &"
" End If Err.Clear End If Dim currentField, dbCurrentField, currentValue, parent currentField = FDFin.FDFNextFieldName("") Do ' check for dots position = InStr(1,currentField, ".",0) ' We save only fields that have hierarchial names: In particular, ' we save fields with parent root of cQuiz or IdInfo. If position <> 0 Then parent = Trim(Mid(currentField,1,position-1)) If (parent = cQuiz) or (parent = "IdInfo") Then If DebugTxt Then Response.Write "currentField: " & currentField & "
" ' strip off parent name, and replace "." with dotReplace dbCurrentField = Replace(currentField, ".", dotReplace, position+1,-1,0) If DebugTxt Then Response.Write "dbCurrentField: " & dbCurrentField & "
" On error Resume Next currentValue = FDFin.FDFGetValue(currentField) If DebugTxt Then Response.Write "currentValue: " & currentValue & "
" If Err.Number <> 0 Then ReportError(Err) DebugMsg "Field Name: ",currentField Err.Clear currentValue = "" Else On error Resume Next RecSet(dbCurrentField) = currentValue If Err.Number <> 0 Then If DebugTxt Then Response.Write "dbCurrentField: " & dbCurrentField&"
" Response.Write "currentValue: " & currentValue&"
" Response.Write "Error Number: " & Err.Number&"
" Response.Write "Descripton: " & Err.Description&"
" Err.Clear End If If DebugFDF Then StatusErcMsg = StatusErcMsg & " Could "_ &" not Update the DB field, '"_ &dbCurrentField&"', using "_ &"the value from the form field, '"_ ¤tField&"'." & Err.Description &" " End If ' Ignore the error Err.Clear End If End If End If End If On error Resume Next currentField = FDFin.FDFNextFieldName(currentField) If currentField = "" Or Err.Number <> 0 Then Exit Do Loop If DataConn.Errors.Count > 0 Then If DebugTxt Then For each Error in DataConn.Errors Response.Write "Error Number: " & Error.Number &"
" Response.Write "Error Description: " & Error.Description &"
" Next End If DataConn.CancelUpdate DataConn.RollbackTrans CancelTableList = CancelTableList &", " & tableName Else On error Resume Next RecSet.Update If (Err.Number <> 0) OR (DataConn.Errors.Count > 0) Then If DebugTxt Then If Err.Number <> 0 Then Response.Write "Update Failed: " : ReportError(Err) For each Error in DataConn.Errors Response.Write "After update: Error Number: " & Error.Number &"
" Response.Write "Error Description: " & Error.Description &"
" Next End If DataConn.CancelUpdate DataConn.RollbackTrans cBuf = "There were some problems saving." Else DataConn.CommitTrans cBuf = "Your quiz results were successfully saved at " & cTime & "." End If End If If DebugFDF Then cBuf = cBuf & " " & ErcStatus FDFout.FDFSetStatus cBuf ' Send back to the browser Response.BinaryWrite FDFout.FDFSaveToBuf RecSet.Close Set RecSet = Nothing DataConn.Close Set DataConn = Nothing FDFin.FDFClose FDFout.FDFClose Set FdfAcx = Nothing Set FDFin = Nothing Set FDFout = Nothing Sub RecordError(field) If Err.Number <> 0 And DebugFDF Then ErcStatus = ErcStatus & " "&field&": " & Err.Description End If If Err.Number <> 0 And DebugTxt Then Response.Write "Set Error: "&field&": " & Err.Description & "
" End If Err.Clear End Sub Sub ReportError(ByRef localErr) DebugMsg "Err.Description: ", localErr.Description DebugMsg "Err.Number: ", localErr.Number localErr.Clear End Sub Sub DebugMsg(myText, myEval) If DebugTxt Then Response.Write myText & myEval &"
" End Sub %>