<%Option Explicit Server.ScriptTimeout=3600%> <% Dim DB, Rs, Rs2, Rs3, sql, sql2 Sub OpenDB() Set DB = Server.CreateObject("ADODB.Connection") DB.ConnectionTimeout = 15 DB.CommandTimeout = 30 DB.Open Application("DBconn") End Sub Sub DBExecute(sql) Db.Execute(sql) End Sub Sub OpenRS(sql) Set Rs = Server.CreateObject("ADODB.Recordset") Rs.Cursortype = adOpenStatic Rs.Open sql, DB End Sub Sub OpenRs2(sql2) Set Rs2 = Server.CreateObject("ADODB.Recordset") Rs2.Cursortype = adOpenStatic Rs2.Open sql2, DB End Sub Sub OpenRs3(sql) Set Rs3 = Server.CreateObject("ADODB.Recordset") Rs3.Cursortype = adOpenStatic Rs3.Open sql, DB End Sub Sub CloseRs() Rs.Close End Sub Sub CloseRs2() Rs2.Close End Sub Sub CloseRs3() Rs3.Close End Sub Sub CloseDB() DB.Close Set DB = Nothing End Sub %> <% Sub CheckError() If Err.Number <> 0 Then msg = "DB Error " & Err.Number & ": " & Err.Description End If End Sub Function ConvertStringToDb(str) If str <> "" Then str = Replace(str,"'","''") str = Replace(str,vbCRLF,"
") End If ConvertStringToDb = str End Function Function ConvertStringFromDb(str) If str <> "" Then str = Replace(str,"''","'") str = Replace(str,Chr(34),""") End If ConvertStringFromDb = str End Function Function CheckEmail(email) Dim valid valid = True If Len(email) < 5 Then valid = False Else If Instr(1, email, " ") <> 0 Then valid = False Else If InStr(1, email, "@") < 2 Then valid = False Else If InStrRev(email, ".") < InStr(1, email, "@") + 2 Then valid = False End If End If End If End If CheckEmail = valid End Function 'validate zip code, valid codes are: 12345 or 12345-1234 /bea Function CheckZip(zip) zip = trim(zip) Dim bValid, iLen bValid = false iLen = len(zip) if iLen = 5 and isNumeric(zip) then bValid = true elseif iLen = 10 then if isNumeric(mid(zip, 1, 5)) then if inStr(1, zip, "-") = 6 then if isNumeric(mid(zip, 7, 10)) then bValid = true end if end if end if end if CheckZip = bValid End Function Function encrypt(enumber) '================= Encrypt a number enumber = "ft7d9s" & enumber * 6534 encrypt = enumber End Function Function decrypt(dnumber) '================= Decrypt a number dnumber = int(mid(dnumber, 7) / 6534) decrypt = dnumber End Function %> <% Function Sendmail(fromWho, toWho, Subject, Body) Dim objMail Set objMail = Server.CreateObject("CDONTS.Newmail") objMail.From = fromWho objMail.To = toWho objMail.Subject = Subject objMail.Body = Body objMail.Send 'objMail.Importance = 2 Set objMail = nothing Sendmail = "ok" End Function %> <% Function SendCDOEmail(sFrom,sTo,sSubject,sBody) On Error Resume Next dim objMessage,objConfig, Flds set objMessage = server.createobject("cdo.message") set objConfig = server.createobject("cdo.configuration") ' Setting the SMTP Server Set Flds = objConfig.Fields Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "localhost" Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "relay-hosting.secureserver.net" Flds.update Set objMessage.Configuration = objConfig objMessage.To = sTo 'objMessage.Cc = sCc objMessage.From = sFrom objMessage.Subject = sSubject 'objMessage.TextBody = sBody objMessage.HTMLBody = sBody objMessage.fields.update objMessage.Send set objMessage = nothing set objConfig = nothing If Err.number = 0 Then SendCDOEmail= True Else SendCDOEmail= False End Function %> <% Dim Referrer, I, y, D, M, j Dim REQemail, REQfname, REQlname, REQzip, REQdob, REQemail2 Dim msg, msg2, OUTregid Dim REQyyyy, REQm, REQd Dim REQadminemail, REQsubject, REQbody, OUTcc, REQtoemail, REQoutemail OpenDB() 'get inputs REQemail2 = Request("email2")'----email virification field REQfname = Request("fname") REQlname = Request("lname") REQemail = Request("email") REQzip = Request("Zip") REQyyyy = Request("YYYY") REQm = Request("M") REQd = Request("D") REQdob = REQm & "/" & REQd & "/" & REQyyyy 'REQdob = Cdate(REQdob) If Request("ActFirstBtn.X") <> "" Then '-----member login If REQemail2 <> "" Then 'all required fields are filled in If NOT CheckEmail(REQemail2) Then msg2 = "Invalid e-mail address" If msg2 = "" Then 'replace SQL unfriendly chars REQemail2 = ConvertStringToDb(REQemail2) 'does the member's account already exist? sql = "SELECT MemberID FROM Members WHERE Email = '" & REQemail2 & "'" OpenRs(sql) If NOT Rs.EOF Then '-----member profile already exists in DB-------- Response.Redirect "res_vip2.asp?em=" & REQemail2 response.End Else msg2 = "Invalid login information" 'REQemail2 = "" End If End If Else msg2 = "Please provide you email address" End If End If If Request("ActSecondBtn.X") <> "" Then REQemail2 = "" If REQemail <> "" AND REQfname <> "" AND REQlname <> "" AND REQzip <> "" AND REQdob <> "" Then 'all required fields are filled in If NOT IsDate(REQdob) Then msg = "Invalid birth date" If NOT CheckZip(REQzip) Then msg = "Invalid zip code" If NOT CheckEmail(REQemail) Then msg = "Invalid e-mail address" If msg = "" Then 'replace SQL unfriendly chars REQfname = ConvertStringToDb(REQfname) REQlname = ConvertStringToDb(REQlname) REQemail = ConvertStringToDb(REQemail) REQzip = ConvertStringToDb(REQzip) 'is this email address already in the DB sql = "SELECT MemberId, Email FROM Members WHERE Email = '" & REQemail & "'" 'response.write sql OpenRs(sql) If NOT Rs.EOF Then 'Response.Redirect "vip.asp" msg = "Your information already in our database." CloseRs() Else CloseRs() '----NEW MEMBER------ 'record member info to db sql = "INSERT INTO Members (Fname, Lname, Email, Zip, DOB) " &_ "VALUES ('" & REQfname & "','" & REQlname & "','" & REQemail & "','" & REQzip & "','" & REQdob & "')" 'response.write sql & "
" DB.Execute(sql) If Err.Number <> 0 Then msg = "Error: " & Err.Number & ": " & Err.Description Else '======send email confirmation============= REQadminemail = Application("AdminEmailFrom")'---from email address REQsubject = "Welcome Vintage VIP" REQbody = "" & vbCRLF &_ "" & vbCRLF &_ "" & vbCRLF &_ "" & vbCRLF &_ "" & vbCRLF &_ "" & vbCRLF &_ "

Thank you for registering as a Vintage Bar and Restaurant VIP. Click here to start accessing your VIP passes, coupons, and discount offers.

" 'send email sub is called from the include file email_cdo.asp On Error Resume Next REQoutemail= REQfname & " " & REQlname & " <" & REQemail & ">" Call SendCDOEmail(REQadminemail, REQoutemail , REQsubject, REQbody) msg = "We sent you an email with your login information." REQfname = "" REQlname = "" REQemail = "" REQzip = "" REQyyyy = "" REQm = "" REQd = "" End If End If End If Else msg = "Please fill in all fields!" End If End If If REQfname <> "" Then REQfname = Replace(REQfname,Chr(34),""") If REQlname <> "" Then REQlname = Replace(REQlname,Chr(34),""") If REQemail <> "" Then REQemail = Replace(REQemail,Chr(34),""") If REQzip <> "" Then REQzip = Replace(REQzip,Chr(34),""") %>

		<% If msg2 <> "" Then response.write msg2 End If%> If you have already registered, log-in using your email address: If not, register now for access to VIP passes, discount coupons, and free offers! By signing up, you are opting-in to the Vintage email list.  <% If msg <> "" Then response.write msg End If%> First Name Last Name Email Address Zip Code Birthdate [an error occurred while processing this directive] If you have something to say - say it - be it about the entertainment we have or you want us to have, the food, the drinks, the bartenders, anything, click here to let us know! We have a really easy unsubscribe system, if you ever decide to unsubscribe. But we know the offers will keep you right here with us. Invalid email addresses will be removed from the database and will not provide access to VIP offers.
	171 Main Street    White Plains, NY   10601  914.328.5803 across from the Macy's end of the Galleria Mall Full Lunch & Dinner Menu    Monday - Friday 11 am - 10 pm    Saturday 5pm - 10 pm