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
|
<%@ 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.
'
' Note: You need to edit one line below. Search this file for the line that
' contains the string "mySMTP". Replace this string with your SMTP server.
Response.buffer = True
Dim DebugTxt, DebugFDF
Dim ErcStatus : ErcStatus = "Problems Reported: "
Dim dotReplace : dotReplace = "_"
DebugTxt = False
DebugFDF = False
' Send FDF file
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, cQuiz
Dim cTime : cTime = Now
'\eqSubmit{http://localhost/scripts/eqMail.asp\#FDF}{eqQuiz}{Math101}
Dim eqMail, cMailTo, cMailFrom, strMessage, eqTab, eqCR
eqTab = chr(9)
eqCR = chr(10)
' Get Required info
cMailTo = FDFin.FDFGetValue("mailTo")
cMailFrom = cMailTo
cCourseName = FDFin.FDFGetValue("courseName")
cQuiz = FDFin.FDFGetValue("quizName")
strMessage = "Course Information"
strMessage = strMessage & eqCR & eqTab & "Course Name: " & cCourseName
strMessage = strMessage & eqCR & eqTab & "Quiz: " & cQuiz
strMessage = strMessage & eqCR & eqTab & "TimeOfQuiz: " & cTime
strMessage = strMessage & eqCR & eqCR & "Student Results"
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
Else
On error Resume Next
strMessage = strMessage & eqCR & eqTab & dbCurrentField & ": " & currentValue
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 DebugFDF Then cBuf = cBuf & " " & ErcStatus
cBuf = "Quiz results successfully sent to your instructor!"
FDFout.FDFSetStatus cBuf
' Send back to the browser
Response.BinaryWrite FDFout.FDFSaveToBuf
FDFin.FDFClose
FDFout.FDFClose
Set FdfAcx = Nothing
Set FDFin = Nothing
Set FDFout = Nothing
' Construct and send e-mail
' CDONTS
'Set eqMail = Server.CreateObject("CDONTS.NewMail")
'eqMail.To = cMailTo
'position = InStr(1,cMailFrom,",",0)
'If position <> 0 Then
' cMailFrom = Trim(Mid(cMailFrom,1,position-1))
'End If
'eqMail.From = cMailFrom
'' eqMail.BCC = "dpstory@uakron.edu"
'eqMail.Subject = "Quiz Results: " & cQuiz & " of " & cCourseName
'eqMail.Body = strMessage
'eqMail.Send
'Set eqMail = Nothing
' Construct and send e-mail
' CDOSYS
Set eqMail = Server.CreateObject("CDO.Message")
eqMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
eqMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mySMTP"
eqMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
eqMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
' eqMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
eqMail.Configuration.Fields.Update
eqMail.To = cMailTo
' See if there is a comma in the cMailFrom string, if yes, then we have multiple address
' that we are sending to. We extract the first e-mail address as the one we will put in
' the eqMail.From address.
position = InStr(1,cMailFrom,",",0)
If position <> 0 Then cMailFrom = Trim(Mid(cMailFrom,1,position-1))
eqMail.From = cMailFrom
' Modify the subject to meet your needs
eqMail.Subject = "Quiz Results: " & cQuiz & " of " & cCourseName
eqMail.TextBody = strMessage
eqMail.Send
Set eqMail = Nothing
If DebugTxt Then
Response.Write strMessage
End If
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
%>
|