summaryrefslogtreecommitdiff
path: root/texmf-dist/source/latex/eq2db/Scripts/FDF_submit/eqEmail.asp
blob: 7defff99ec80943fc89079f0b0720445010179e4 (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
<%@ 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
%>