China Tour 2000: Bulletin Board

<% 'Option Explicit On Error Resume Next Dim RS 'Recordset object Dim SQL 'SQL query string Dim Result 'Error or status messages Dim EmailRecipient 'Receipient address of account authorizer Dim EmailSender 'Sender address of e-mail message Dim EmailSubject 'Subject of e-mail message to be sent to account authorizer Dim SMTPServer 'SMTP server to use to send e-mail Dim UserID 'UserID for use in authorization EmailSubject = "New Account Authorization" SMTPServer = "xl1.xlstar.com:25" EmailRecipient = "jwarrick@ntjazz.com" EmailSender = EmailRecipient If Request.ServerVariables("REQUEST_METHOD") = "POST" Then Result = CreateAccount() If Result = "" Then Response.Redirect "register_end.asp" Else Result = "There was a problem creating your account:
" & vbCrLf & _ Result & "" End If End If Function CreateAccount() Dim Result Dim JMail If ExistsUsername() Then Result = Result & "Username already exists. Please choose a different Username.
" & vbCrLf CreateAccount = Result Exit Function End If Result = Result & CheckEmptyFields() If Result <> "" Then CreateAccount = Result Exit Function End If Result = Result & CheckDataIntegrity() If Result <> "" Then CreateAccount = Result Exit Function End If Result = Result & AddRecord() If Result <> "" Then CreateAccount = Result Exit Function End If Set JMail = Server.CreateObject("JMail.SMTPMail") ' This is my local SMTP server JMail.ServerAddress = SMTPServer ' This is me.... JMail.Sender = EmailSender JMail.Subject = EmailSubject ' Get the recipients mailbox from a form (note the lack of a equal sign). JMail.AddRecipient EmailRecipient ' The body property is bodth read and write. ' If you want to append text to the body you can ' use JMail.Body = JMail.Body & "Hello world!" ' or you can use JMail.AppendText "Hello World!" ' which in many cases is easier to use. JMail.Body = CreateEmailBody() ' 1 - highest priority (Urgent) ' 3 - normal ' 5 - lowest JMail.Priority = 1 ' Send it... JMail.Execute Set JMail = Nothing CreateAccount = Result End Function '---------------------------------------------------------------------------- ' ExistsUsername() ' ' Check to see whether or not the username already exists. ' Function ExistsUsername() Dim RS Dim SQL Set RS = Server.CreateObject("ADODB.RecordSet") SQL = "SELECT Username FROM Users WHERE (UCase(Username) = '" & UCase(Request.Form("Username")) & "')" RS.Open SQL, Application("CHINA_ConnectionString"), 2, 2 ExistsUsername = Not RS.EOF RS.Close Set RS = Nothing Exit Function End Function '---------------------------------------------------------------------------- ' CreateEmailBody() ' ' Construct the body of the e-mail message to be sent to the account ' authorizer. ' Function CreateEmailBody() Dim Result Dim Field Result = Result & _ "A new account has been created. " & _ "Please review the following information for accuracy and correctness. " & _ vbCrLf & vbCrLf For Each Field In Fields If Field <> "Password" Then Result = Result & Field & ": " & Request.Form(Field) & vbCrLf End If Next Result = Result & vbCrLf & vbCrLf & _ "To grant this user access and/or correct this information, click http://ntjazz.com/chinatour/bulletinboard/authorize.asp?UserID=" & UserID & "&Authorized=1" & vbCrLf & _ "To deny this user access, do nothing or click http://ntjazz.com/chinatour/bulletinboard/authorize.asp?UserID=" & UserID & "&Authorized=0" & vbCrLf CreateEmailBody = Result End Function '---------------------------------------------------------------------------- ' AddRecord() ' ' Add a new user record to the user database and set the appropriate field ' values. Stores the UserID in global variable UserID. ' Function AddRecord() Dim Result Dim RS Dim SQL Dim Field Set RS = Server.CreateObject("ADODB.RecordSet") 'Make a connection to the Users table RS.Open "SELECT TOP 1 * FROM Users", Application("CHINA_ConnectionString"), 2, 2, 1 If Err.Number <> 0 Then Result = Result & "There was a problem connecting to the database.
" & vbCrLf AddRecord = Result Exit Function End If 'Create a new blank record RS.AddNew If Err.Number <> 0 Then Result = Result & "There was a problem adding a new record.
" & vbCrLf AddRecord = Result Exit Function End If For Each Field In Fields If Field = "Password" Then RS(Field) = Server.URLEncode(Request.Form(Field)) Else RS(Field) = Request.Form(Field) End If Next RS("Authorized") = False 'Update the database with new information RS.Update If Err.Number <> 0 Then Result = Result & "There was a problem updating the record.
" & vbCrLf AddRecord = Result Exit Function End If RS.Close 'Get the UserID of the new user SQL = "SELECT TOP 1 UserID FROM Users ORDER BY AddDate DESC" RS.Open SQL, Application("CHINA_ConnectionString"), 2, 2 If Err.Number <> 0 Then Result = Result & "There was a problem retrieving the UserID.
" & vbCrLf AddRecord = Result Exit Function End If If RS.EOF Then Result = Result & "There was a problem retrieving the UserID.
" & vbCrLf AddRecord = Result Exit Function Else UserID = RS("UserID") End If RS.Close Set RS = Nothing AddRecord = Result End Function Function CheckEmptyFields() Dim Result Dim Field For Each Field In Fields If Field = "Addr2" Or Field = "Instrument" Then 'Do Nothing ElseIf Request.Form(Field) = "" Then Result = Result & Field & " cannot be blank.
" & vbCrLf End If Next CheckEmptyFields = Result End Function Function CheckDataIntegrity() Dim Result IF Request.Form("Password") <> Request.Form("Password2") Then Result = Result & "Passwords do not match.
" & vbCrLf End If If Len(Request.Form("Password")) < 4 Then Result = Result & "Password must be at least 4 characters long.
" & vbCrLf End If If Len(Request.Form("ParentEmail")) < 9 Then Result = Result & "Invalid Parent e-mail address.
" & vbCrLf End If CheckDataIntegrity = Result End Function %> China Tour 2000: Bulletin Board

Go to China Tour Home

new trier high school chamber orchestra / jazz ensemble

Bulletin Board

Create a New Account

To visit the Bulletin Board and Tour Personnel pages, a password is necessary. The purpose of the Bulletin Board is for people to ask questions and receive answers for all to see. We hope to use it during the trip to send and receive messages from students. You must register and choose a username and password in order to access this area. Have you already registered but forgotten your password?
<% If Result <> "" Then %>
<%= Result %> <% End If %>

Please choose an easy-to-remember Username
for your family to use to access the Bulletin Board
and enter it below.
(use letters and digits only)

Please choose an easy-to-remember Password
(enter twice to confirm) for accessing the Bulletin
Board. Your password can be a four-digit PIN
number or combination of letters that's easy for
your to remember.
(minimum 4 characters in length)
(enter again to confirm)

Student's First and Last Name:
">">
Parent's First and Last Name:
">">
Instrument Played by the student or Role of traveler:
">
Ensemble in which the student participates:

Home Address for receiving important mailings:
"> (Line 1)
"> (Line 2)
City, State ZIP:
">, ">
Home Phone Number:
"> (e.g. 847-nnn-nnnn)
Student's E-mail Address:
"> (e.g. jwarrick@ntjazz.com)
Parent's E-mail Address:
"> (e.g. roshegep@nttc.com)