| |
<%
'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
%> |
|
