diff options
Diffstat (limited to 'texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqRecord.asp')
-rw-r--r-- | texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqRecord.asp | 216 |
1 files changed, 216 insertions, 0 deletions
diff --git a/texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqRecord.asp b/texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqRecord.asp new file mode 100644 index 00000000..09dbd32f --- /dev/null +++ b/texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqRecord.asp @@ -0,0 +1,216 @@ +<%@ 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<br>" + 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." &"<br>" + End If + Err.Clear +End If +If DebugTxt Then + Response.Write "dbName: " & cDbName & "<br>" + Response.Write "quizName = " & cQuiz &"<br>" +End If + +RecSet("TimeOfQuiz") = cTime +If Err.Number <> 0 Then + If DebugTxt Then + Response.Write "Problems storing time, possibly no TimeOfQuiz field" &"<br>" + 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 & "<br>" + ' strip off parent name, and replace "." with dotReplace + dbCurrentField = Replace(currentField, ".", dotReplace, position+1,-1,0) + If DebugTxt Then Response.Write "dbCurrentField: " & dbCurrentField & "<br>" + + On error Resume Next + currentValue = FDFin.FDFGetValue(currentField) + If DebugTxt Then Response.Write "currentValue: " & currentValue & "<br>" + + 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&"<br>" + Response.Write "currentValue: " & currentValue&"<br>" + Response.Write "Error Number: " & Err.Number&"<br>" + Response.Write "Descripton: " & Err.Description&"<br>" + 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 &"<br>" + Response.Write "Error Description: " & Error.Description &"<br>" + 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 &"<br>" + Response.Write "Error Description: " & Error.Description &"<br>" + 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 & "<br>" + 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 &"<br>" +End Sub +%> |