<%' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' IsValidEmail ()
' Created Aug 9,1999
' Purpose: To test an Email address for errors before
' Storing it in the database.
'
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function IsValidEmail(Email)
Email = Replace (Email," ","")
ValidFlag = False
If (Email <> "") And (InStr(1, Email, "@") > 0) And (InStr(1, Email, ".") > 0) Then
atCount = 0
SpecialFlag = False
For atLoop = 1 To Len(Email)
atChr = Mid(Email, atLoop, 1)
If atChr = "@" Then atCount = atCount + 1
If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True
If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True
If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True
If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True
Next
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "@")
UserName = tAry1(0)
DomainName = tAry1(1)
If (UserName = "") Or (DomainName = "") Then BadFlag = True
If Mid(DomainName, 1, 1) = "." then BadFlag = True
If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True
ValidFlag = True
End If
End If
If BadFlag = True Then ValidFlag = False
IsValidEmail = ValidFlag
End Function
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^%>
<%' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' WriteToFile (Path,FileName,Text)
' Use this to Write descriptions etc to .txt files
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Sub WriteToFile (Path,FileName,Text)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WriteStream = FSO.CreateTextFile (Server.MapPath(Path)& "\" & FileName, true)
WriteStream.Write Text
WriteStream.Close
Set FSO = nothing
End Sub
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^%>
<%' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' ReadFromFile (Path,FileName)
' use this to Read descriptions etc From .txt files
' Path = d:\Inetpub\Directory\Directory
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Sub ReadFromFile (Path,FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists (Server.MapPath(Path)& "\" & FileName) then
Set ReadStream = FSO.OpenTextFile (Server.MapPath(Path)& "\" & FileName, 1)
TextFile = ReadStream.ReadAll
Response.Write (replace(TextFile,vbCrLf,"
"))
ReadStream.Close
End If
Set FSO = nothing
End Sub
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^%>
<% Function CheckForAssociatedProducts (Table, Category)
Dim nReturnValue
Sel = "SELECT * FROM " & Table & " where tCategory =" & int(Category)
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open Sel, DB, 1, 3
nReturnValue = rs.RecordCount
set rs = Nothing
CheckForAssociatedProducts = nReturnValue
End Function %>
<% Function GetCategoryName (CategoryID)
Sel = "SELECT * FROM Categories where kaID =" & int(CategoryID)
Set rs = DB.Execute (Sel)
If not rs.EOF then
CategoryName = rs("tCategory")
End if
rs.Close
GetCategoryName = CategoryName
End Function %>
<% Function NewID (Column,Table)
sql = "select newID = Max(" & Column & ") + 1 from " & Table
Set rsGetBasketID = DB.Execute(sql)
NewID = rsGetBasketID(0)
End Function %>
<% ' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Subscribe ()
' This function is used to add people to the mailing list
' To Use:
' 1: add the following line to your asp page:
' Subscribe Request.Form("txtEmailAddress")
' 2: Setup a table in the database according to the readme file.
Sub Subscribe (txtEmailAddress)
If Request.ServerVariables("REQUEST_METHOD") = "POST" and txtEmailAddress <> "" then
If IsValidEmail(txtEmailAddress) then
SelMAIL = "SELECT * FROM Subscribers where txtEmailAddress ='" & txtEmailAddress &"'"
Set rsMAIL = Server.CreateObject("ADODB.Recordset")
rsMAIL.Open SelMAIL, DB, 1, 3
If rsMAIL.EOF then
rsMAIL.AddNew
rsMAIL("txtEmailAddress") = txtEmailAddress
rsMAIL.Update
End IF %>
Thank you!You have been added to our mailing list. Keep an eye out for the "<%= NewsletterName %>" in your eMailbox soon.
<% Else %>
We're Sorry!The eMail address that you provided appears to be invalid... Please try again!
<% End IF
Else %>
Subscribe Now!
<% ReadFromFile "/_Descriptions/","Subscribe_Now.txt" %>
<% end IF
End Sub %>
<%
Function DisPrepText(astring)
If Trim(astring)<>"" then
astring=REPLACE(astring,vbcrlf,"
")
End If
DisPrepText=astring
End Function
%>
<%
Function tbPrep(astring)
If Trim(astring)<>"" then
astring=Replace(astring,"""","``")
End If
tbPrep=astring
End Function
%>
<%
Function Logged
If Request.Cookies("wades")("logged")="TRUE" then
Logged=True
Else
Logged=False
End If
End Function
%>