summaryrefslogtreecommitdiff
path: root/texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqRecord.asp
blob: 09dbd32fe33e42d2fe39c66ae660e7fdd998e8dd (plain)
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, '"_
                        &currentField&"'." & 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
%>