1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
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
%>
|