<%@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
%>
<%
'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
%>
<%
CONST Use_CDONTS = 1
CONST Use_PERSITS = 2
Dim Emailer_Type
Emailer_Type = Use_CDONTS '--->> TOGGLE this between Use_CDONTS or Use_PERSITS depending on your preference.
'Emailer_Type = Use_PERSITS '--->> TOGGLE this between Use_CDONTS or Use_PERSITS depending on your preference.
function Send_Email( from_email, from_ename, to_email, to_cc, to_bcc, email_subject, email_body )
CONST outgoing_server = "smtpout.secureserver.net"
CONST account_name = "support@pricedoppler.com"
CONST account_password = "gmm0support"
Dim ObjSendMail
Set ObjSendMail = CreateObject("CDO.Message")
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = outgoing_server
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = account_name
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = account_password
ObjSendMail.Configuration.Fields.Update
ObjSendMail.To = to_email
ObjSendMail.Cc = to_cc
ObjSendMail.Bcc = to_bcc
ObjSendMail.Subject = email_subject
ObjSendMail.From = from_email
'ObjSendMail.AddAttachment '--->> IF YOU WANT TO ADD ATTACHMENT, PLACE IT HERE.
ObjSendMail.HTMLBody = email_body
ObjSendMail.Send
Set ObjSendMail = Nothing
end function
function Send_Email2( emailfrom, emailname, emailto, emailcc, emailbcc, emailsubject, emailbody )
if Emailer_Type = 2 then
Persits_Email emailfrom, emailname, emailto, emailcc, emailbcc, emailsubject, emailbody
else
CDONTS_Email emailfrom, emailname, emailto, emailcc, emailbcc, emailsubject, emailbody
end if
end function
'CDONTS is the most common ASP Emailer component for servers. You may use PERSITS emailer if it's available
'in your domain host server. PERSISTS emailer code is below.
function CDONTS_Email( emailfrom, emailname, emailto, emailcc, emailbcc, emailsubject, emailbody )
errormsg = ""
Dim objNewMail
Set objNewMail = Server.CreateObject("CDONTS.NewMail")
objNewMail.From = emailname & " <" & emailfrom & ">"
objNewMail.To = emailto
if emailcc <> "" then objNewMail.cc = emailcc
if emailbcc <> "" then objNewMail.Bcc = emailbcc
objNewMail.Subject = emailsubject
objNewMail.BodyFormat = 0
objNewMail.MailFormat = 0
'objNewMail.isHTML = True
objNewMail.Body = emailbody
objNewMail.Send
If err.number <> 0 Then errormsg = "EMAIL SENDER COMPONENT Error: " & err.num & " - " & err.description
Set objNewMail = Nothing
CDONTS_Email = errormsg
end function
' If your domain host supports PERSITS, then you can use this emailer below.
' For more info about this component, visit http://www.aspemail.com
function Persits_Email( emailfrom, emailname, emailto, emailcc, emailbcc, emailsubject, emailbody )
MailHost = "69.25.72.181" '-->> YOU HAVE TO VERIFY THIS VALUE WITH YOUR DOMAIN HOST. THIS VARIES FROM SERVER TO SERVER.
errormsg = ""
Dim objNewMail
Set objNewMail = Server.CreateObject("Persits.MailSender")
objNewMail.Host = MailHost
objNewMail.From = emailfrom
objNewMail.FromName = emailname
objNewMail.AddAddress emailto
if emailcc <> "" then objNewMail.Addcc emailcc
if emailbcc <> "" then objNewMail.AddBcc emailbcc
objNewMail.Subject = emailsubject
objNewMail.Body = emailbody
objNewMail.Send
If err.number <> 0 Then errormsg = "PERSITS EMAIL SENDER COMPONENT Error: " & err.num & " - " & err.description
Set objNewMail = Nothing
Persits_Email = errormsg
end function
%>
<%
dim is_processed
dim notify_email
dim emailcc
dim emailbcc
notify_email = "eric@ericthetrainer.com"
emailcc = "steve@realizegroup.com"
dim cu_error_msg
submit_contactus = request("submit_contactus")
if submit_contactus <> "" then
cu_name = request("cu_name")
cu_email= request("cu_email")
cu_comments= request("cu_comments")
signup = request("signup")
' response.Write("singup=" & signup)
' response.End()
if cu_name = "" then cu_push_error "Please enter your name."
if NOT IsValidEmail(cu_email) then cu_push_error "Please enter a valid email address."
if cu_comments = "" then cu_push_error "Please enter your comments."
if signup = "1" then
if record_exists( "tbl_subscriber", "email", cu_email, 0) then cu_push_error "This email address is already subscribed."
end if
if cu_error_msg <> "" then
cu_error_msg = "" & cu_error_msg & "
"
else
is_processed = "1"
if signup = "1" then
Set rsSubs = Server.CreateObject("ADODB.Recordset")
rsSubs.ActiveConnection = MM_connection_STRING
rsSubs.Source = "insert into tbl_subscriber(name,email) values ('" & cu_name & "', '" & cu_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
rsSubs.Source = "SELECT * FROM tbl_subscriber where subscriber_id=" & id
rsSubs.Open()
c_name = rsSubs("name")
c_email = rsSubs("email")
rsSubs.Close
set rsSubs = Nothing
end if
Send_Email cu_email, cu_name, notify_email, emailcc, emailbcc, "Message from CONTACT US page", cu_comments
Set add_cmd = Server.CreateObject("ADODB.Command")
add_cmd.ActiveConnection = MM_Connection_String
arr_cols = "subscriber_id|name|email|comments"
if id = "" then
id = "0"
end if
arr_values = id & "|" & parse(cu_name) & "|" & parse(cu_email) & "|" & parse(cu_comments)
add_cmd.CommandText = insert_command("tbl_feedback", arr_cols, arr_values)
add_cmd.Execute
add_cmd.ActiveConnection.Close
end if
else
signup = "1"
end if
%>
Contact
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!
