<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
DIM pref_paypal_account, LOG_FILE, VENDOR_IDENTITY, VENDOR_NAME, VENDOR_EMAIL, VENDOR_EMAIL_CC, VENDOR_EMAIL_BCC, DATABASE_PATH, MM_connection_STRING
'*** CHANGE THE FOLLOWIN TO YOUR OWN CONFIGURATION ***
pref_paypal_account = "services@ericthetrainer.com"
pref_private_path = "../private"
paypal_notify_url = "http://www.EricTheTrainer.com/ipn_processor.asp"
return_url = "http://www.ericthetrainer.com/purchase_confirm.asp"
cancel_url = "http://www.ericthetrainer.com/purchase_cancel.asp"
login_url = "http://www.EricTheTrainer.com/login.asp"
VENDOR_NAME = "ERIC THE TRAINER" '*--> NAME OF YOUR COMPANY
VENDOR_EMAIL = "services@ericthetrainer.com" '*--> YOUR PRIMARY EMAIL REGISTERED WITH PAYPAL
VENDOR_EMAIL_CC = "" '*--> CC EMAIL - FOR ADDITIONAL NOTIFICATION EMAIL - OPTIONAL
VENDOR_EMAIL_BCC = "" '*--> BCC EMAIL - FOR ADDITIONAL NOTIFICATION EMAIL - OPTIONAL
CONST TERMINATE_ON_SYSTEM_ERROR = FALSE '*IF THERE IS A SERIOUS SYSTEM ERROR TRAPPED BY THE SYSTEM SUCH AS FAILURE TO
'*CREATE A SERVER OBJECT, YOU MAY CHOOSE TO TERMINATE THE SCRIPT RIGHT AWAY.
'*JUST SET TERMINATE_ON_SYSTEM_ERROR TO "TRUE"
CONST AUDIT_TRAIL_ON = False ' SET THIS TO TRUE TO ENABLE TEXT LOG FILE
LOG_FILE = "PAYPAL.txt" '*PAYPAL AUDIT TRAIL LOG FILE
'*NOTE: FOR ADDED SECURITY, IT IS BEST TO STORE THE LOG FILE OUTSIDE THE ROOT FOLDER
'*EX. "../Private/paypal.txt" --> here folder "Private" is outside the HTTP REACH
const remote_admin_login = "ett"
const remote_admin_password = "ettadmin"
%>
<%
'Dim MM_connection_STRING
'dim DB
'editted MapPath and removed .. from "../private/ett_db.mdb"
'the ".." convention is not available
'DB = Server.MapPath("/private/ett_db.mdb")
DB = Server.MapPath("/access_db/ett_db.mdb")
'MM_connection_STRING = "Provider=MSDASQL; Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & DB
MM_connection_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DB
%>
Educators & Parents
SIGN-UP/LOGIN
<%
'1. function parse (str) : parse all incoming submissions
'2. function unparse (str) : opposite of parse
'3. function record_exists( tbl_name, column_name, the_value)
' : checks for duplicate record based on 1 primary column -- used in adding records
'4. function record_exists_ext( tbl_name, column_name_1, column_name_2, the_value_1, the_value_2)
' : checks for duplicate record based on 2 columns -- used in updating records
'5. function insert_command(tbl_name, arr_cols, arr_values)
' : constructs an insert command
' : makes insertions of quotes and commas a breeze
'6. function update_command(tbl_name, idcol, idval, arr_cols, arr_values)
' : constructs and edit command
' : makes insertions of quotes and commas a breeze
%>
<%
function parse (str)
parse = trim(replace(replace(str, "'", "''"), "|", ""))
end function
function unparse (str)
if str <> "" then
unparse = trim(replace(str, "''", "'"))
else
unparse = ""
end if
end function
function record_exists( tbl_name, column_name, the_value, isInteger)
Dim quote
quote = "'"
if isInteger=1 then quote = ""
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = MM_Connection_STRING
rs.Source = "SELECT * FROM " & tbl_name & " WHERE " & column_name & " = " & quote & the_value & quote
'response.write rs.Source
'response.End()
rs.CursorType = 0
rs.CursorLocation = 2
rs.LockType = 1
rs.Open()
if rs.eof then
record_exists = false
else
record_exists = true
end if
rs.Close()
Set rs = Nothing
end function
function record_exists_ext( tbl_name, column_name_1, column_name_2, the_value_1, value_1_isInt, the_value_2, value_2_isInt)
Dim quote1
Dim quote2
quote1 = "'"
quote2 = "'"
if value_1_isInt = 1 then quote1 = ""
if value_2_isInt = 1 then quote2 = ""
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = MM_Connection_STRING
rs.Source = "SELECT * FROM " & tbl_name & " WHERE " & column_name_1 & " = " & quote1 & the_value_1 & quote1 & " AND " & column_name_2 & " = " & quote2 & the_value_2 & quote2
' response.write rs.Source
' response.end()
rs.CursorType = 0
rs.CursorLocation = 2
rs.LockType = 1
rs.Open()
if rs.eof then
record_exists_ext = false
else
record_exists_ext = true
end if
rs.Close()
Set rs = Nothing
end function
function record_exists_edit_level_1( tbl_name, column_name_1, column_name_2, the_value_1, value_1_isInt, the_value_2, value_2_isInt)
Dim quote1
Dim quote2
quote1 = "'"
quote2 = "'"
if value_1_isInt = 1 then quote1 = ""
if value_2_isInt = 1 then quote2 = ""
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = MM_Connection_STRING
rs.Source = "SELECT * FROM " & tbl_name & " WHERE " & column_name_1 & " = " & quote1 & the_value_1 & quote1 & " AND " & column_name_2 & " <> " & quote2 & the_value_2 & quote2
' response.write rs.Source
' response.end()
rs.CursorType = 0
rs.CursorLocation = 2
rs.LockType = 1
rs.Open()
if rs.eof then
record_exists_edit_level_1 = false
else
record_exists_edit_level_1 = true
end if
rs.Close()
Set rs = Nothing
end function
function record_exists_edit_level_2( tbl_name, column_name_1, column_name_2, column_name_3, the_value_1, value_1_isInt, the_value_2, value_2_isInt, the_value_3, value_3_isInt)
Dim quote1
Dim quote2
quote1 = "'"
quote2 = "'"
quote3 = "'"
if value_1_isInt = 1 then quote1 = ""
if value_2_isInt = 1 then quote2 = ""
if value_3_isInt = 1 then quote3 = ""
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = MM_Connection_STRING
rs.Source = "SELECT * FROM " & tbl_name & " WHERE " & column_name_1 & " = " & quote1 & the_value_1 & quote1 & " AND " & column_name_2 & " <> " & quote2 & the_value_2 & quote2 & " AND " & column_name_3 & " = " & quote3 & the_value_3 & quote3
' response.write rs.Source
' response.end()
rs.CursorType = 0
rs.CursorLocation = 2
rs.LockType = 1
rs.Open()
if rs.eof then
record_exists_edit_level_2 = false
else
record_exists_edit_level_2 = true
end if
rs.Close()
Set rs = Nothing
end function
function insert_command(tbl_name, arr_cols, arr_values)
dim i
cols = split(arr_cols, "|")
vals = split(arr_values, "|")
ub_arr = ubound(cols)
str = "INSERT INTO " & tbl_name & "("
scol = ""
sval = ""
for i = 0 to ub_arr
if i < ub_arr then
scol = scol & cols(i) & ","
sval = sval & "'" & vals(i) & "',"
else
scol = scol & cols(i)
sval = sval & "'" & vals(i) & "'"
end if
next
str = str & scol & ") VALUES (" & sval & ")"
insert_command = str
end function
function update_command(tbl_name, idcol, idcol_isInt, idval, arr_cols, arr_values)
dim i
if idcol_isInt = 1 then
quote1 = ""
else
quote1 = "'"
end if
cols = split(arr_cols, "|")
vals = split(arr_values, "|")
ub_arr = ubound(cols)
str = "UPDATE " & tbl_name & " SET "
s = ""
for i = 0 to ub_arr
if i < ub_arr then
s = s & cols(i) & "='" & vals(i) & "',"
else
s = s & cols(i) & "='" & vals(i) & "'"
end if
next
str = str & s & " WHERE " & idcol & "=" & quote1 & idval & quote1
update_command = str
end function
function update_all_command(tbl_name, arr_cols, arr_values)
dim i
cols = split(arr_cols, "|")
vals = split(arr_values, "|")
ub_arr = ubound(cols)
str = "UPDATE " & tbl_name & " SET "
s = ""
for i = 0 to ub_arr
if i < ub_arr then
s = s & cols(i) & "='" & vals(i) & "',"
else
s = s & cols(i) & "='" & vals(i) & "'"
end if
next
str = str & s & " "
update_all_command = str
end function
function delete_command(tbl_name, idcol, idval )
if isnumeric(idval) then
str = "DELETE FROM " & tbl_name & " WHERE " & idcol & "=" & idval
else
str = "DELETE FROM " & tbl_name & " WHERE " & idcol & "='" & idval & "'"
end if
delete_command = str
end function
Function IsValidEmail(sText)
'validate email address
Dim i
Dim iTmpChar
Dim sDomainExt
Dim vEmail
Dim vDomain
IsValidEmail = False
'check for 1 @ symbol
vEmail = Split(sText, "@")
If UBound(vEmail) <> 1 Then Exit Function
If vEmail(0) = "" Or vEmail(1) = "" Then Exit Function
'validate account
For i = 1 To Len(vEmail(0))
'check for valid characters
iTmpChar = Asc(Mid(LCase(vEmail(0)), i, 1))
'test for letters
If Not (iTmpChar >= Asc("a")) And (iTmpChar <= Asc("z")) Then
'test for numbers
If Not IsNumeric(Chr(iTmpChar)) Then
'test for exceptions
If Chr(iTmpChar) <> "." And Chr(iTmpChar) <> "_" And Chr(iTmpChar) <> "-" Then Exit Function
End If
End If
Next
'validate domain
For i = 1 To Len(vEmail(1))
'check for valid characters
iTmpChar = Asc(Mid(LCase(vEmail(1)), i, 1))
'test for letters
If Not (iTmpChar >= Asc("a")) And (iTmpChar <= Asc("z")) Then
'test for numbers
If Not IsNumeric(Chr(iTmpChar)) Then
'test for exceptions
If Chr(iTmpChar) <> "." And Chr(iTmpChar) <> "-" Then Exit Function
End If
End If
Next
'validate domain extension
vDomain = Split(vEmail(1), ".")
sDomainExt = vDomain(UBound(vDomain))
If Len(sDomainExt) < 2 Or Len(sDomainExt) > 4 Then Exit Function
'test for letters
For i = 1 To Len(sDomainExt)
iTmpChar = Asc(Mid(LCase(sDomainExt), i, 1))
If Not (iTmpChar >= Asc("a")) And (iTmpChar <= Asc("z")) Then Exit Function
Next
IsValidEmail = True
End Function
%>
<%
dim subs_error_msg
subscribe = trim(request("subscribe"))
if subscribe <> "" then
name = trim(request("name"))
email = trim(request("email"))
if name = "" then subs_push_error "Please enter your name."
if NOT IsValidEmail(email) then subs_push_error "Please enter a valid email address."
if record_exists( "tbl_subscriber", "email", email, 0) then subs_push_error "This email address is already subscribed."
if subs_error_msg <> "" then
subs_error_msg = "" & subs_error_msg & "
"
else
Set rsSubs = Server.CreateObject("ADODB.Recordset")
rsSubs.ActiveConnection = MM_connection_STRING
rsSubs.Source = "insert into tbl_subscriber(name,email) values ('" & name & "', '" & email & "')"
rsSubs.CursorType = 0
rsSubs.CursorLocation = 2
rsSubs.LockType = 1
rsSubs.Open()
rsSubs.Source = "SELECT max(subscriber_id) as id FROM tbl_subscriber"
rsSubs.Open()
id = rsSubs("id")
rsSubs.Close
set rsSubs = Nothing
name = ""
email = ""
response.Redirect("subsribed_confirm.asp?id=" & id )
response.End()
end if
end if
%>
<%
sub subs_push_error (str)
if subs_error_msg = "" then
subs_error_msg = "* " & str
else
subs_error_msg = subs_error_msg & " * " & str
end if
end sub
%>
THE FITCALL
Introducing the NEW Fitcall:
Do The Sleeping Beauty Workout from the comfort of your own home!
Eric the Trainer is an advocate for teaching children about good health that will last them a lifetime. It’s about making it fun for kids and accessible and informative to parents.
Eric is currently involved teaching health and fitness each Friday to elementary school children. He covers all of the basics and providing a way to make health and fitness fun. He is giving them the tools to be healthy and develop the tools to make smart choices now and in the future.
To receive information regarding Eric’s tools for children, parents, and teachers please feel free to email us at info@ericthetrainer.com.
Download Educational Worksheets for Kids
The major muscle groups Help your children learn each of the major muscle groups on a cool image of Eric and the kids! Download PDF (180k)
The Four Major Food Groups
Let your children draw or write each of the listed foods in their correct food group. They can add their own favorite foods as they go down the list. This worksheet is a great way for children to learn which food group their favorite foods are in and how much of it they should be eating.
Download PDF (40k)
