<% if session("username") = "" then Response.Redirect "login.asp" end if %> <% 'Database Connection String; 'Server.MapPath = the location of the database on the server 'please change the path to the correct path on your server Set objADO = Server.CreateObject("ADODB.Connection") sDSN = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("db\fsboREplus.mdb") & ";" objADO.Open sDSN 'Contact Variables; Used in contact.asp and other pages that contain the contact info. 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. ' Create a recordset object to store specific table information Set objConfig = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From TblConfig" 'Set the recordset object equal to the SQL query string objConfig.Open SQL, objADO, 1, 3 strVarCompany = objConfig("Company") strVarAddress = objConfig("CompanyAddress") strVarCity = objConfig("CompanyCity") strVarState = objConfig("CompanyState") strVarZip = objConfig("CompanyZip") strVarCountry = objConfig("CompanyCountry") strVarEmail = objConfig("CompanyEmail") strVarPhone = objConfig("CompanyPhone") strVarFax = objConfig("CompanyFax") strVarMainContact = objConfig("CompanyContact") strVarWebsite = objConfig("CompanyWebsite") strVarBGColor = objConfig("BGColor") strSlogan = objConfig("Slogan") strOfferAdvertising = objConfig("OfferAdvertising") str1000ImpressionsAdCost = objConfig("1000ImpressionsCost") str5000ImpressionsAdCost = objConfig("5000ImpressionsCost") str10000ImpressionsAdCost = objConfig("10000ImpressionsCost") str50000ImpressionsAdCost = objConfig("50000ImpressionsCost") str100000ImpressionsAdCost = objConfig("100000ImpressionsCost") strServiceType = objConfig("ServiceType") strServiceAdCost = objConfig("ServiceAdCost") strAgentList = objConfig("AgentList") strLogo = objConfig("logo") strKeywords = objConfig("Keywords") strMetaDescription = objConfig("MetaDescription") 'PAYPAL VARIABLES - See PaypalCode.doc located in the documentation folder 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. 'Email address the payment should be sent to strPayPalEmail = objConfig("PayPalEmail") strAgentFeatured1MonthCost = objConfig("AgentFeatured1MonthCost") strAgentFeatured3MonthCost = objConfig("AgentFeatured3MonthCost") strAgentFeatured6MonthCost = objConfig("AgentFeatured6MonthCost") strAgentFeatured12MonthCost = objConfig("AgentFeatured12MonthCost") strAgentStandard1MonthCost = objConfig("AgentStandard1MonthCost") strAgentStandard3MonthCost = objConfig("AgentStandard3MonthCost") strAgentStandard6MonthCost = objConfig("AgentStandard6MonthCost") strAgentStandard12MonthCost = objConfig("AgentStandard12MonthCost") strUserFeatured1MonthCost = objConfig("UserFeatured1MonthCost") strUserFeatured3MonthCost = objConfig("UserFeatured3MonthCost") strUserFeatured6MonthCost = objConfig("UserFeatured6MonthCost") strUserFeatured12MonthCost = objConfig("UserFeatured12MonthCost") strUserStandard1MonthCost = objConfig("UserStandard1MonthCost") strUserStandard3MonthCost = objConfig("UserStandard3MonthCost") strUserStandard6MonthCost = objConfig("UserStandard6MonthCost") strUserStandard12MonthCost = objConfig("UserStandard12MonthCost") 'Description of the service to appear on the Featured Listing receipt strFeaturedAdDescription = "Featured Listing on " & strVarWebsite 'Description of the service to appear on the Regular Listing receipt strStandardAdDescription = "Standard Listing on " & strVarWebsite 'Description of the service to appear on the Upgrade Listing receipt strUpgradeAdDescription = "Upgrade Listing on " & strVarWebsite 'Cost you want to charge for the listing strUpgradeAdCost = objConfig("UpgradeAdCost") 'whether ads are paid or free strListingType = objConfig("ListingType") 'Page that the user should return to after making payment for featured ad; 'They should return to page step1F.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1F.asp strPayPalReturnPageFeatured = strVarWebsite + "/featuredsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageRegular = strVarWebsite + "/standardsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageUpgrade = strVarWebsite + "/upgradesuccess.asp" 'Page that the user should return to if cancelling before completing PayPal payment; 'They should return to page cancel.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/cancel.asp strPayPalCancel = strVarWebsite + "/cancel.asp" %> <% Sub CreateRoomCombo(iCount)%> <% End Sub Sub CreateFlooringCombo(iCount)%> <% End Sub ' Formats a given 10 digit number into a nice looking phone number ' Example: given strNumber of 8005551212 you get (800) 555-1212 Function FormatPhoneNumber(strNumber) Dim strInput ' String to hold our entered number Dim strTemp ' Temporary string to hold our working text Dim strCurrentChar ' Var for storing each character for eval. Dim I ' Looping var ' Uppercase all characters for consistency strInput = UCase(strNumber) ' To be able to handle some pretty bad formatting, strip out ' all characters except for chars A to Z and digits 0 to 9 ' before proceeding. I left in the chars for slogan ' numbers like 1-800-GET-CASH etc... For I = 1 To Len(strInput) strCurrentChar = Mid(strInput, I, 1) ' Numbers (0 to 9) If Asc("0") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("9") Then strTemp = strTemp & strCurrentChar End If ' Upper Case Chars (A to Z) If Asc("A") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("Z") Then strTemp = strTemp & strCurrentChar End If Next 'I ' Swap strTemp back to strInput for next set of validation strInput = strTemp strTemp = "" ' Remove leading 1 if applicable If Len(strInput) = 11 And Left(strInput, 1) = "1" Then strInput = Right(strInput, 10) End If ' Error catch to make sure strInput is proper length now that ' we've finished manipulating it. If Not Len(strInput) = 10 Then ' Handle errors. Err.Raise 1, "FormatPhoneNumber function", _ "The phone number to be formatted must be a valid 10 digit US phone number!" End If ' If an error occurred then the rest of this won't get processed. ' Build the output formatted string ' (xxx) xxx-xxxx strTemp = "(" ' "(" strTemp = strTemp & Left(strInput, 3) ' Area code strTemp = strTemp & ") " ' ") " strTemp = strTemp & Mid(strInput, 4, 3) ' Exchange strTemp = strTemp & "-" ' "-" strTemp = strTemp & Right(strInput, 4) ' 4 digit part ' Set return value FormatPhoneNumber = strTemp End Function sub openrs(rs, sql) Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorLocation = adUseServer rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText end sub function ToHTML(strValue) if IsNull(strValue) then ToHTML = "" else ToHTML = Server.HTMLEncode(strValue) end if end function function ToURL(strValue) if IsNull(strValue) then strValue = "" ToURL = Server.URLEncode(strValue) end function function GetValueHTML(rs, strFieldName) GetValueHTML = ToHTML(GetValue(rs, strFieldName)) end function function GetValue(rs, strFieldName) on error resume next if rs is nothing then GetValue = "" elseif (not rs.EOF) and (strFieldName <> "") then res = rs(strFieldName) if isnull(res) then res = "" end if GetValue = res else GetValue = "" end if if bDebug then response.write err.Description end function function GetParam(ParamName) if Request.QueryString(ParamName).Count > 0 then Param = Request.QueryString(ParamName) elseif Request.Form(ParamName).Count > 0 then Param = Request.Form(ParamName) else Param = "" end if if Param = "" then GetParam = Empty else GetParam = Param end if end function Function ToSQL(Value, sType) Param = Value if Param = "" then ToSQL = "Null" else if sType = "Number" then ToSQL = CDbl(Param) else ToSQL = "'" & Replace(Param, "'", "''") & "'" end if end if end function function DLookUp(Table, fName, sWhere) on error resume next Res = cn.execute("select " & fName & " from " & Table & " where " & sWhere).Fields(0).Value if IsNull(Res) then Res = "" DLookUp = Res end function function getCheckBoxValue(sVal, CheckedValue, UnCheckedValue, sType) if isempty(sVal) then if UnCheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = UnCheckedValue else getCheckBoxValue = "'" & Replace(UnCheckedValue, "'", "''") & "'" end if end if else if CheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = CheckedValue else getCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'" end if end if end if end function function getValFromLOV(sVal, aArr) sRes = "" if (ubound(aArr) mod 2) = 1 then for i = 0 to ubound(aArr) step 2 if cstr(sVal) = cstr(aArr(i)) then sRes = aArr(i+1) next end if getValFromLOV = sRes end function function get_options(sql,is_search,is_required,selected_value) options_str="" if is_search then options_str=options_str&"" else if is_required then options_str=options_str&"" end if openrs tmprs,sql while not tmprs.EOF id=GetValue(tmprs, 0) value=GetValue(tmprs, 1) selected="" if CStr(id) = CStr(selected_value) then selected = "SELECTED" end if options_str = options_str & "" tmprs.MoveNext wend get_options = options_str end function Function ProceedError() if cn.Errors.Count > 0 then ProceedError = cn.Errors(0).Description & " (" & cn.Errors(0).Source & ")" elseif not (Err.Description = "") then ProceedError = Err.Description else ProceedError = "" end if end Function function CheckSecurity(iLevel) if Session("UserID") = "" then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) else if CLng(Session("UserRights")) < CLng(iLevel) then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) End if end function %> <% ' Create a recordset object to store specific table information Set objRS = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From TblConfig" 'Set the recordset object equal to the SQL query string objRS.Open SQL, objADO, 1, 3 'strUserName = objRs.fields("UserName") strCompanyName = objRs.fields("Company") strWebsite = objRs.fields("CompanyWebsite") strBGColor = objRs.fields("BGColor") strContact = objRs.fields("CompanyContact") strSlogan = objRs.fields("Slogan") strAddress = objRs.fields("CompanyAddress") strCity = objRs.fields("CompanyCity") strState = objRs.fields("CompanyState") strZip = objRs.fields("CompanyZip") strCountry = objRs.fields("CompanyCountry") strPhone = objRs.fields("CompanyPhone") strFax = objRs.fields("CompanyFax") strCompanyEmail = objRs.fields("CompanyEmail") 'strListingType = objRs.fields("ListingType") strPayPalEmail = objRs.fields("PayPalEmail") strLogo = objRS.Fields("Logo") strServiceType = objRs.fields("ServiceType") strServiceAdCost = objRs.fields("ServiceAdCost") strOfferAdvertising = objRs.fields("OfferAdvertising") str1000ImpressionsAdCost = objRs.fields("1000ImpressionsCost") str5000ImpressionsAdCost = objRs.fields("5000ImpressionsCost") str10000ImpressionsAdCost = objRs.fields("10000ImpressionsCost") str50000ImpressionsAdCost = objRs.fields("50000ImpressionsCost") str100000ImpressionsAdCost = objRs.fields("100000ImpressionsCost") strAgentList = objRs.fields("AgentList") 'Retrieving form input and assigning to a variable strContact2 = Request.Form("txtContact") strWebsite2 = Request.Form("txtWebsite") strBGColor2 = Request.Form("txtBGColor") strCompanyName2 = Request.Form("txtCompanyName") strSlogan2 = Request.Form("txtSlogan") strAddress2 = Request.Form("txtAddress") strCity2 = Request.Form("txtCity") strState2 = Request.Form("cboState") strZip2 = Request.Form("txtZip") strCountry2 = Request.Form("cboCountry") strPhone2 = Request.Form("txtPhone") strFax2 = Request.Form("txtFax") strCompanyEmail2 = Request.Form("txtCompanyEmail") strListingType2 = Request.Form("optListingType") strPayPalEmail2 = Request.form("txtPayPalEmail") strLogo2 = Request.Form("txtLogo") strAgentFeatured1MonthCost2 = Request.form("txtAgentFeatured1MonthCost") strAgentFeatured3MonthCost2 = Request.form("txtAgentFeatured3MonthCost") strAgentFeatured6MonthCost2 = Request.form("txtAgentFeatured6MonthCost") strAgentFeatured12MonthCost2 = Request.form("txtAgentFeatured12MonthCost") strAgentStandard1MonthCost2 = Request.form("txtAgentStandard1MonthCost") strAgentStandard3MonthCost2 = Request.form("txtAgentStandard3MonthCost") strAgentStandard6MonthCost2 = Request.form("txtAgentStandard6MonthCost") strAgentStandard12MonthCost2 = Request.form("txtAgentStandard12MonthCost") strUserFeatured1MonthCost2 = Request.form("txtUserFeatured1MonthCost") strUserFeatured3MonthCost2 = Request.form("txtUserFeatured3MonthCost") strUserFeatured6MonthCost2 = Request.form("txtUserFeatured6MonthCost") strUserFeatured12MonthCost2 = Request.form("txtUserFeatured12MonthCost") strUserStandard1MonthCost2 = Request.form("txtUserStandard1MonthCost") strUserStandard3MonthCost2 = Request.form("txtUserStandard3MonthCost") strUserStandard6MonthCost2 = Request.form("txtUserStandard6MonthCost") strUserStandard12MonthCost2 = Request.form("txtUserStandard12MonthCost") 'strUpgradeAdCost2 = Request.form("txtUpgradeAdCost") strServiceType2 = Request.Form("optServiceType") strServiceAdCost2 = Request.form("txtServiceAdCost") strOfferAdvertising2 = Request.form("optOfferAdvertising") str1000ImpressionsAdCost2 = Request.form("txt1000ImpressionsAdCost") str5000ImpressionsAdCost2 = Request.form("txt5000ImpressionsAdCost") str10000ImpressionsAdCost2 = Request.form("txt10000ImpressionsAdCost") str50000ImpressionsAdCost2 = Request.form("txt50000ImpressionsAdCost") str100000ImpressionsAdCost2 = Request.form("txt100000ImpressionsAdCost") strAgentList2 = Request.Form("optAgentList") WarningErrMsg = "" 'This code only runs if the submit button is clicked if Request.Form <> "" then 'Sets an error message if any required fields are left blank if strCompanyName2 = "" or strContact2 = "" or strAddress2 = "" or strCity2 = "" or StrState2 = "" or strZip2 = "" or strCountry2 = "" or strPhone2 = "" or strWebsite2 = "" or strCompanyEmail2 = "" then WarningErrMsg = warningErrMsg + "All fields marked with an * are required." end if if strPayPalEmail2 = "" then WarningErrMsg = warningErrMsg + "
You must specify a PayPal Email." end if 'if strListingType2 = "Paid" then 'if strFeaturedAdCost2 = "" or strStandardAdCost2 = "" or strUpgradeAdCost2 = "" then ' WarningErrMsg = warningErrMsg + "
Featured, Standard, and Upgrade listing cost fields are required for paid listings." 'end if 'end if 'if strListingType2 = "Free" then 'if strFeaturedAdCost2 <> "" or strStandardAdCost2 <> "" or strUpgradeAdCost2 <> ""then ' WarningErrMsg = warningErrMsg + "
Please leave featured, standard, and upgrade listing cost fields blank for free listings." 'end if 'end if if strOfferAdvertising2 = "Yes" then if str1000ImpressionsAdCost2 = "" or str5000ImpressionsAdCost2 = "" or str10000ImpressionsAdCost2 = "" or str50000ImpressionsAdCost2 = "" or str100000ImpressionsAdCost2 = "" then WarningErrMsg = warningErrMsg + "
Advertising Costs are required fields if you are offering advertising." end if end if if strOfferAdvertising2 = "No" then if str1000ImpressionsAdCost2 <> "" or str5000ImpressionsAdCost2 <> "" or str10000ImpressionsAdCost2 <> "" or str50000ImpressionsAdCost2 <> "" or str100000ImpressionsAdCost2 <> "" then WarningErrMsg = warningErrMsg + "
Please leave Advertising Cost blank if you are not offering advertising." end if end if 'Makes sure featured ad cost contains only numbers and a decimal if str1000ImpressionsAdCost2 <> "" and not isnumeric(str1000ImpressionsAdCost2) then WarningErrMsg = WarningErrMsg + "
Advertising Cost can only contain numbers and a decimal." end if 'Checks for a valid email address if strCompanyEmail2 <> "" and (instr( strCompanyEmail2, "@") = 0 or instr( strCompanyEmail2, ".") = 0) then WarningErrMsg = WarningErrMsg + "
Company Email must be in the form account@server.com." end if if strAgentFeatured1MonthCost2 = "" or strAgentFeatured3MonthCost2 = "" or strAgentFeatured6MonthCost2 = "" or strAgentFeatured12MonthCost2 = "" then WarningErrMsg = WarningErrMsg + "
Please input a value into all Agent Featured ad costs. If you want a listing type to be free, input the number zero." end if if strAgentStandard1MonthCost2 = "" or strAgentStandard3MonthCost2 = "" or strAgentStandard6MonthCost2 = "" or strAgentStandard12MonthCost2 = "" then WarningErrMsg = WarningErrMsg + "
Please input a value into all Agent Standard ad costs. If you want a listing type to be free, input the number zero." end if if strUserFeatured1MonthCost2 = "" or strUserFeatured3MonthCost2 = "" or strUserFeatured6MonthCost2 = "" or strUserFeatured12MonthCost2 = "" then WarningErrMsg = WarningErrMsg + "
Please input a value into all User Featured ad costs. If you want a listing type to be free, input the number zero." end if if strUserStandard1MonthCost2 = "" or strUserStandard3MonthCost2 = "" or strUserStandard6MonthCost2 = "" or strUserStandard12MonthCost2 = "" then WarningErrMsg = WarningErrMsg + "
Please input a value into all User Standard ad costs. If you want a listing type to be free, input the number zero." end if 'Checks for a valid email address if strPayPalEmail2 <> "" and (instr( strPayPalEmail2, "@") = 0 or instr( strPayPalEmail2, ".") = 0) then WarningErrMsg = WarningErrMsg + "
PayPal Email must be in the form account@server.com." end if 'Makes sure featured ad cost contains only numbers and a decimal 'if strFeaturedAdCost2 <> "" and not isnumeric(strFeaturedAdCost2) then ' WarningErrMsg = WarningErrMsg + "
Featured Ad Cost can only contain numbers and a decimal." 'end if 'Makes sure featured ad cost contains only numbers and a decimal 'if strStandardAdCost2 <> "" and not isnumeric(strStandardAdCost2) then ' WarningErrMsg = WarningErrMsg + "
Standard Ad Cost can only contain numbers and a decimal." 'end if 'Makes sure featured ad cost contains only numbers and a decimal 'if strUpgradeAdCost2 <> "" and not isnumeric(strUpgradeAdCost2) then ' WarningErrMsg = WarningErrMsg + "
Upgrade Ad Cost can only contain numbers and a decimal." 'end if 'If error message was not set, then all error checks were passed; Connect to the database if warningErrMsg = "" then objRs.fields("Company") = strCompanyName2 objRs.fields("Slogan") = strSlogan2 objRs.fields("CompanyAddress") = strAddress2 objRs.fields("CompanyCity") = strCity2 objRs.fields("CompanyState") = strState2 objRs.fields("CompanyZip") = strZip2 objRs.fields("CompanyCountry") = strCountry2 objRs.fields("CompanyPhone") = strPhone2 objRs.fields("CompanyFax") = strFax2 objRs.fields("CompanyEmail") = strCompanyEmail2 objRs.fields("CompanyWebsite") = strWebsite2 objrs.Fields("BGColor") = strBGColor2 objRs.fields("ListingType") = strListingType2 objRs.fields("PayPalEmail") = strPayPalEmail2 objRs.fields("AgentFeatured1MonthCost") = strAgentFeatured1MonthCost2 objRs.fields("AgentFeatured3MonthCost") = strAgentFeatured3MonthCost2 objRs.fields("AgentFeatured6MonthCost") = strAgentFeatured6MonthCost2 objRs.fields("AgentFeatured12MonthCost") = strAgentFeatured12MonthCost2 objRs.fields("AgentStandard1MonthCost") = strAgentStandard1MonthCost2 objRs.fields("AgentStandard3MonthCost") = strAgentStandard3MonthCost2 objRs.fields("AgentStandard6MonthCost") = strAgentStandard6MonthCost2 objRs.fields("AgentStandard12MonthCost") = strAgentStandard12MonthCost2 objRs.fields("UserFeatured1MonthCost") = strUserFeatured1MonthCost2 objRs.fields("UserFeatured3MonthCost") = strUserFeatured3MonthCost2 objRs.fields("UserFeatured6MonthCost") = strUserFeatured6MonthCost2 objRs.fields("UserFeatured12MonthCost") = strUserFeatured12MonthCost2 objRs.fields("UserStandard1MonthCost") = strUserStandard1MonthCost2 objRs.fields("UserStandard3MonthCost") = strUserStandard3MonthCost2 objRs.fields("UserStandard6MonthCost") = strUserStandard6MonthCost2 objRs.fields("UserStandard12MonthCost") = strUserStandard12MonthCost2 objRs.fields("UpgradeAdCost") = strUpgradeAdCost2 objRs.fields("OfferAdvertising") = strOfferAdvertising2 objRs.fields("1000ImpressionsCost") = str1000ImpressionsAdCost2 objRs.fields("5000ImpressionsCost") = str5000ImpressionsAdCost2 objRs.fields("10000ImpressionsCost") = str10000ImpressionsAdCost2 objRs.fields("50000ImpressionsCost") = str50000ImpressionsAdCost2 objRs.fields("100000ImpressionsCost") = str100000ImpressionsAdCost2 objrs.Fields("ServiceType") = strServiceType2 objrs.Fields("ServiceAdCost") = strServiceAdCost2 objRs.fields("CompanyContact") = strContact2 objRs.fields("AgentList") = strAgentList2 objRs.update warningErrMsg = "
Your site configuration has been saved. Please refresh your browser." end if end if %> <% 'Database Connection String; 'Server.MapPath = the location of the database on the server 'please change the path to the correct path on your server Set objADO = Server.CreateObject("ADODB.Connection") sDSN = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("db\fsboREplus.mdb") & ";" objADO.Open sDSN 'Contact Variables; Used in contact.asp and other pages that contain the contact info. 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. ' Create a recordset object to store specific table information Set objConfig = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From TblConfig" 'Set the recordset object equal to the SQL query string objConfig.Open SQL, objADO, 1, 3 strVarCompany = objConfig("Company") strVarAddress = objConfig("CompanyAddress") strVarCity = objConfig("CompanyCity") strVarState = objConfig("CompanyState") strVarZip = objConfig("CompanyZip") strVarCountry = objConfig("CompanyCountry") strVarEmail = objConfig("CompanyEmail") strVarPhone = objConfig("CompanyPhone") strVarFax = objConfig("CompanyFax") strVarMainContact = objConfig("CompanyContact") strVarWebsite = objConfig("CompanyWebsite") strVarBGColor = objConfig("BGColor") strSlogan = objConfig("Slogan") strOfferAdvertising = objConfig("OfferAdvertising") str1000ImpressionsAdCost = objConfig("1000ImpressionsCost") str5000ImpressionsAdCost = objConfig("5000ImpressionsCost") str10000ImpressionsAdCost = objConfig("10000ImpressionsCost") str50000ImpressionsAdCost = objConfig("50000ImpressionsCost") str100000ImpressionsAdCost = objConfig("100000ImpressionsCost") strServiceType = objConfig("ServiceType") strServiceAdCost = objConfig("ServiceAdCost") strAgentList = objConfig("AgentList") strLogo = objConfig("logo") strKeywords = objConfig("Keywords") strMetaDescription = objConfig("MetaDescription") 'PAYPAL VARIABLES - See PaypalCode.doc located in the documentation folder 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. 'Email address the payment should be sent to strPayPalEmail = objConfig("PayPalEmail") strAgentFeatured1MonthCost = objConfig("AgentFeatured1MonthCost") strAgentFeatured3MonthCost = objConfig("AgentFeatured3MonthCost") strAgentFeatured6MonthCost = objConfig("AgentFeatured6MonthCost") strAgentFeatured12MonthCost = objConfig("AgentFeatured12MonthCost") strAgentStandard1MonthCost = objConfig("AgentStandard1MonthCost") strAgentStandard3MonthCost = objConfig("AgentStandard3MonthCost") strAgentStandard6MonthCost = objConfig("AgentStandard6MonthCost") strAgentStandard12MonthCost = objConfig("AgentStandard12MonthCost") strUserFeatured1MonthCost = objConfig("UserFeatured1MonthCost") strUserFeatured3MonthCost = objConfig("UserFeatured3MonthCost") strUserFeatured6MonthCost = objConfig("UserFeatured6MonthCost") strUserFeatured12MonthCost = objConfig("UserFeatured12MonthCost") strUserStandard1MonthCost = objConfig("UserStandard1MonthCost") strUserStandard3MonthCost = objConfig("UserStandard3MonthCost") strUserStandard6MonthCost = objConfig("UserStandard6MonthCost") strUserStandard12MonthCost = objConfig("UserStandard12MonthCost") 'Description of the service to appear on the Featured Listing receipt strFeaturedAdDescription = "Featured Listing on " & strVarWebsite 'Description of the service to appear on the Regular Listing receipt strStandardAdDescription = "Standard Listing on " & strVarWebsite 'Description of the service to appear on the Upgrade Listing receipt strUpgradeAdDescription = "Upgrade Listing on " & strVarWebsite 'Cost you want to charge for the listing strUpgradeAdCost = objConfig("UpgradeAdCost") 'whether ads are paid or free strListingType = objConfig("ListingType") 'Page that the user should return to after making payment for featured ad; 'They should return to page step1F.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1F.asp strPayPalReturnPageFeatured = strVarWebsite + "/featuredsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageRegular = strVarWebsite + "/standardsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageUpgrade = strVarWebsite + "/upgradesuccess.asp" 'Page that the user should return to if cancelling before completing PayPal payment; 'They should return to page cancel.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/cancel.asp strPayPalCancel = strVarWebsite + "/cancel.asp" %> <% Sub CreateRoomCombo(iCount)%> <% End Sub Sub CreateFlooringCombo(iCount)%> <% End Sub ' Formats a given 10 digit number into a nice looking phone number ' Example: given strNumber of 8005551212 you get (800) 555-1212 Function FormatPhoneNumber(strNumber) Dim strInput ' String to hold our entered number Dim strTemp ' Temporary string to hold our working text Dim strCurrentChar ' Var for storing each character for eval. Dim I ' Looping var ' Uppercase all characters for consistency strInput = UCase(strNumber) ' To be able to handle some pretty bad formatting, strip out ' all characters except for chars A to Z and digits 0 to 9 ' before proceeding. I left in the chars for slogan ' numbers like 1-800-GET-CASH etc... For I = 1 To Len(strInput) strCurrentChar = Mid(strInput, I, 1) ' Numbers (0 to 9) If Asc("0") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("9") Then strTemp = strTemp & strCurrentChar End If ' Upper Case Chars (A to Z) If Asc("A") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("Z") Then strTemp = strTemp & strCurrentChar End If Next 'I ' Swap strTemp back to strInput for next set of validation strInput = strTemp strTemp = "" ' Remove leading 1 if applicable If Len(strInput) = 11 And Left(strInput, 1) = "1" Then strInput = Right(strInput, 10) End If ' Error catch to make sure strInput is proper length now that ' we've finished manipulating it. If Not Len(strInput) = 10 Then ' Handle errors. Err.Raise 1, "FormatPhoneNumber function", _ "The phone number to be formatted must be a valid 10 digit US phone number!" End If ' If an error occurred then the rest of this won't get processed. ' Build the output formatted string ' (xxx) xxx-xxxx strTemp = "(" ' "(" strTemp = strTemp & Left(strInput, 3) ' Area code strTemp = strTemp & ") " ' ") " strTemp = strTemp & Mid(strInput, 4, 3) ' Exchange strTemp = strTemp & "-" ' "-" strTemp = strTemp & Right(strInput, 4) ' 4 digit part ' Set return value FormatPhoneNumber = strTemp End Function sub openrs(rs, sql) Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorLocation = adUseServer rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText end sub function ToHTML(strValue) if IsNull(strValue) then ToHTML = "" else ToHTML = Server.HTMLEncode(strValue) end if end function function ToURL(strValue) if IsNull(strValue) then strValue = "" ToURL = Server.URLEncode(strValue) end function function GetValueHTML(rs, strFieldName) GetValueHTML = ToHTML(GetValue(rs, strFieldName)) end function function GetValue(rs, strFieldName) on error resume next if rs is nothing then GetValue = "" elseif (not rs.EOF) and (strFieldName <> "") then res = rs(strFieldName) if isnull(res) then res = "" end if GetValue = res else GetValue = "" end if if bDebug then response.write err.Description end function function GetParam(ParamName) if Request.QueryString(ParamName).Count > 0 then Param = Request.QueryString(ParamName) elseif Request.Form(ParamName).Count > 0 then Param = Request.Form(ParamName) else Param = "" end if if Param = "" then GetParam = Empty else GetParam = Param end if end function Function ToSQL(Value, sType) Param = Value if Param = "" then ToSQL = "Null" else if sType = "Number" then ToSQL = CDbl(Param) else ToSQL = "'" & Replace(Param, "'", "''") & "'" end if end if end function function DLookUp(Table, fName, sWhere) on error resume next Res = cn.execute("select " & fName & " from " & Table & " where " & sWhere).Fields(0).Value if IsNull(Res) then Res = "" DLookUp = Res end function function getCheckBoxValue(sVal, CheckedValue, UnCheckedValue, sType) if isempty(sVal) then if UnCheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = UnCheckedValue else getCheckBoxValue = "'" & Replace(UnCheckedValue, "'", "''") & "'" end if end if else if CheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = CheckedValue else getCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'" end if end if end if end function function getValFromLOV(sVal, aArr) sRes = "" if (ubound(aArr) mod 2) = 1 then for i = 0 to ubound(aArr) step 2 if cstr(sVal) = cstr(aArr(i)) then sRes = aArr(i+1) next end if getValFromLOV = sRes end function function get_options(sql,is_search,is_required,selected_value) options_str="" if is_search then options_str=options_str&"" else if is_required then options_str=options_str&"" end if openrs tmprs,sql while not tmprs.EOF id=GetValue(tmprs, 0) value=GetValue(tmprs, 1) selected="" if CStr(id) = CStr(selected_value) then selected = "SELECTED" end if options_str = options_str & "" tmprs.MoveNext wend get_options = options_str end function Function ProceedError() if cn.Errors.Count > 0 then ProceedError = cn.Errors(0).Description & " (" & cn.Errors(0).Source & ")" elseif not (Err.Description = "") then ProceedError = Err.Description else ProceedError = "" end if end Function function CheckSecurity(iLevel) if Session("UserID") = "" then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) else if CLng(Session("UserRights")) < CLng(iLevel) then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) End if end function %> <%= strVarCompany %> - <%= objConfig("Keywords") %> <% strUserName = session("UserName") %>
<% 'Database Connection String; 'Server.MapPath = the location of the database on the server 'please change the path to the correct path on your server Set objADO = Server.CreateObject("ADODB.Connection") sDSN = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("db\fsboREplus.mdb") & ";" objADO.Open sDSN 'Contact Variables; Used in contact.asp and other pages that contain the contact info. 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. ' Create a recordset object to store specific table information Set objConfig = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From TblConfig" 'Set the recordset object equal to the SQL query string objConfig.Open SQL, objADO, 1, 3 strVarCompany = objConfig("Company") strVarAddress = objConfig("CompanyAddress") strVarCity = objConfig("CompanyCity") strVarState = objConfig("CompanyState") strVarZip = objConfig("CompanyZip") strVarCountry = objConfig("CompanyCountry") strVarEmail = objConfig("CompanyEmail") strVarPhone = objConfig("CompanyPhone") strVarFax = objConfig("CompanyFax") strVarMainContact = objConfig("CompanyContact") strVarWebsite = objConfig("CompanyWebsite") strVarBGColor = objConfig("BGColor") strSlogan = objConfig("Slogan") strOfferAdvertising = objConfig("OfferAdvertising") str1000ImpressionsAdCost = objConfig("1000ImpressionsCost") str5000ImpressionsAdCost = objConfig("5000ImpressionsCost") str10000ImpressionsAdCost = objConfig("10000ImpressionsCost") str50000ImpressionsAdCost = objConfig("50000ImpressionsCost") str100000ImpressionsAdCost = objConfig("100000ImpressionsCost") strServiceType = objConfig("ServiceType") strServiceAdCost = objConfig("ServiceAdCost") strAgentList = objConfig("AgentList") strLogo = objConfig("logo") strKeywords = objConfig("Keywords") strMetaDescription = objConfig("MetaDescription") 'PAYPAL VARIABLES - See PaypalCode.doc located in the documentation folder 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. 'Email address the payment should be sent to strPayPalEmail = objConfig("PayPalEmail") strAgentFeatured1MonthCost = objConfig("AgentFeatured1MonthCost") strAgentFeatured3MonthCost = objConfig("AgentFeatured3MonthCost") strAgentFeatured6MonthCost = objConfig("AgentFeatured6MonthCost") strAgentFeatured12MonthCost = objConfig("AgentFeatured12MonthCost") strAgentStandard1MonthCost = objConfig("AgentStandard1MonthCost") strAgentStandard3MonthCost = objConfig("AgentStandard3MonthCost") strAgentStandard6MonthCost = objConfig("AgentStandard6MonthCost") strAgentStandard12MonthCost = objConfig("AgentStandard12MonthCost") strUserFeatured1MonthCost = objConfig("UserFeatured1MonthCost") strUserFeatured3MonthCost = objConfig("UserFeatured3MonthCost") strUserFeatured6MonthCost = objConfig("UserFeatured6MonthCost") strUserFeatured12MonthCost = objConfig("UserFeatured12MonthCost") strUserStandard1MonthCost = objConfig("UserStandard1MonthCost") strUserStandard3MonthCost = objConfig("UserStandard3MonthCost") strUserStandard6MonthCost = objConfig("UserStandard6MonthCost") strUserStandard12MonthCost = objConfig("UserStandard12MonthCost") 'Description of the service to appear on the Featured Listing receipt strFeaturedAdDescription = "Featured Listing on " & strVarWebsite 'Description of the service to appear on the Regular Listing receipt strStandardAdDescription = "Standard Listing on " & strVarWebsite 'Description of the service to appear on the Upgrade Listing receipt strUpgradeAdDescription = "Upgrade Listing on " & strVarWebsite 'Cost you want to charge for the listing strUpgradeAdCost = objConfig("UpgradeAdCost") 'whether ads are paid or free strListingType = objConfig("ListingType") 'Page that the user should return to after making payment for featured ad; 'They should return to page step1F.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1F.asp strPayPalReturnPageFeatured = strVarWebsite + "/featuredsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageRegular = strVarWebsite + "/standardsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageUpgrade = strVarWebsite + "/upgradesuccess.asp" 'Page that the user should return to if cancelling before completing PayPal payment; 'They should return to page cancel.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/cancel.asp strPayPalCancel = strVarWebsite + "/cancel.asp" %> <% Sub CreateRoomCombo(iCount)%> <% End Sub Sub CreateFlooringCombo(iCount)%> <% End Sub ' Formats a given 10 digit number into a nice looking phone number ' Example: given strNumber of 8005551212 you get (800) 555-1212 Function FormatPhoneNumber(strNumber) Dim strInput ' String to hold our entered number Dim strTemp ' Temporary string to hold our working text Dim strCurrentChar ' Var for storing each character for eval. Dim I ' Looping var ' Uppercase all characters for consistency strInput = UCase(strNumber) ' To be able to handle some pretty bad formatting, strip out ' all characters except for chars A to Z and digits 0 to 9 ' before proceeding. I left in the chars for slogan ' numbers like 1-800-GET-CASH etc... For I = 1 To Len(strInput) strCurrentChar = Mid(strInput, I, 1) ' Numbers (0 to 9) If Asc("0") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("9") Then strTemp = strTemp & strCurrentChar End If ' Upper Case Chars (A to Z) If Asc("A") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("Z") Then strTemp = strTemp & strCurrentChar End If Next 'I ' Swap strTemp back to strInput for next set of validation strInput = strTemp strTemp = "" ' Remove leading 1 if applicable If Len(strInput) = 11 And Left(strInput, 1) = "1" Then strInput = Right(strInput, 10) End If ' Error catch to make sure strInput is proper length now that ' we've finished manipulating it. If Not Len(strInput) = 10 Then ' Handle errors. Err.Raise 1, "FormatPhoneNumber function", _ "The phone number to be formatted must be a valid 10 digit US phone number!" End If ' If an error occurred then the rest of this won't get processed. ' Build the output formatted string ' (xxx) xxx-xxxx strTemp = "(" ' "(" strTemp = strTemp & Left(strInput, 3) ' Area code strTemp = strTemp & ") " ' ") " strTemp = strTemp & Mid(strInput, 4, 3) ' Exchange strTemp = strTemp & "-" ' "-" strTemp = strTemp & Right(strInput, 4) ' 4 digit part ' Set return value FormatPhoneNumber = strTemp End Function sub openrs(rs, sql) Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorLocation = adUseServer rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText end sub function ToHTML(strValue) if IsNull(strValue) then ToHTML = "" else ToHTML = Server.HTMLEncode(strValue) end if end function function ToURL(strValue) if IsNull(strValue) then strValue = "" ToURL = Server.URLEncode(strValue) end function function GetValueHTML(rs, strFieldName) GetValueHTML = ToHTML(GetValue(rs, strFieldName)) end function function GetValue(rs, strFieldName) on error resume next if rs is nothing then GetValue = "" elseif (not rs.EOF) and (strFieldName <> "") then res = rs(strFieldName) if isnull(res) then res = "" end if GetValue = res else GetValue = "" end if if bDebug then response.write err.Description end function function GetParam(ParamName) if Request.QueryString(ParamName).Count > 0 then Param = Request.QueryString(ParamName) elseif Request.Form(ParamName).Count > 0 then Param = Request.Form(ParamName) else Param = "" end if if Param = "" then GetParam = Empty else GetParam = Param end if end function Function ToSQL(Value, sType) Param = Value if Param = "" then ToSQL = "Null" else if sType = "Number" then ToSQL = CDbl(Param) else ToSQL = "'" & Replace(Param, "'", "''") & "'" end if end if end function function DLookUp(Table, fName, sWhere) on error resume next Res = cn.execute("select " & fName & " from " & Table & " where " & sWhere).Fields(0).Value if IsNull(Res) then Res = "" DLookUp = Res end function function getCheckBoxValue(sVal, CheckedValue, UnCheckedValue, sType) if isempty(sVal) then if UnCheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = UnCheckedValue else getCheckBoxValue = "'" & Replace(UnCheckedValue, "'", "''") & "'" end if end if else if CheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = CheckedValue else getCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'" end if end if end if end function function getValFromLOV(sVal, aArr) sRes = "" if (ubound(aArr) mod 2) = 1 then for i = 0 to ubound(aArr) step 2 if cstr(sVal) = cstr(aArr(i)) then sRes = aArr(i+1) next end if getValFromLOV = sRes end function function get_options(sql,is_search,is_required,selected_value) options_str="" if is_search then options_str=options_str&"" else if is_required then options_str=options_str&"" end if openrs tmprs,sql while not tmprs.EOF id=GetValue(tmprs, 0) value=GetValue(tmprs, 1) selected="" if CStr(id) = CStr(selected_value) then selected = "SELECTED" end if options_str = options_str & "" tmprs.MoveNext wend get_options = options_str end function Function ProceedError() if cn.Errors.Count > 0 then ProceedError = cn.Errors(0).Description & " (" & cn.Errors(0).Source & ")" elseif not (Err.Description = "") then ProceedError = Err.Description else ProceedError = "" end if end Function function CheckSecurity(iLevel) if Session("UserID") = "" then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) else if CLng(Session("UserRights")) < CLng(iLevel) then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) End if end function %> <% TodayDate = Now() TodayDate = FormatDateTime(TodayDate, VBShortDate) Set RS=Server.CreateObject("ADODB.RecordSet") SQL = vbNullString SQL = SQL & "UPDATE Clients " SQL = SQL & "SET Status='DontShow' WHERE ImpPur < ImpNow" objADO.execute(SQL) Set RS = Nothing Set RS=Server.CreateObject("ADODB.RecordSet") Query = "SELECT * FROM Clients WHERE Status='Show' AND StartDate <= #" & TodayDate & "#" RS.Open Query, objADO, 3, 3 IF (RS.EOF) THEN ShowBanner = "default" %> <% Else rndMax = CInt(RS.RecordCount) RS.MoveFirst Do While Not RS.EOF RS.MoveNext Loop RS.MoveFirst Randomize Timer rndNumber = Int(RND * rndMax) RS.Move rndNumber Id = RS("AdID") UrlTo = RS("LinkTo") GetImg = RS("ImgUrl") WriteSize1 = RS("SizeOf1") WriteSize2 = RS("SizeOf2") DisText = RS("TextUnder") ImpNow = RS("ImpNow") ImpNewNow = ImpNow + 1 Set RS = Nothing Set RS=Server.CreateObject("ADODB.RecordSet") SQL = vbNullString SQL = SQL & "UPDATE Clients " SQL = SQL & "SET ImpNow="&ImpNewNow&" WHERE AdID="&Id&"" objADO.execute(SQL) Set RS = Nothing End If %> <%=DisText%>
Home | Get Listed! | <% if strUserName = "" then %> Create An Account | <% end if %> <% if strUserName = "" then %> Member Login <% end if %> <% if strUserName <> "" then %> Logout <% end if %> | <% if strUserName <> "" then %> Control Panel | <% end if %> Search Listings | View Featured | Newest Properties | Testimonials
Seller Tools | Buyer Tools | Find An Agent | Services Directory | Mortgage Center <% if strOfferAdvertising = "Yes" then %> | Advertising <% end if %> | News | About Us | Contact
<% strMailSubmit = request("cmdMailSubmit") strSearchId = request("cmdSearchId") strEmail = request("txtEmail") strSiteId = request("txtSiteId") 'This code only runs if the submit button is clicked if Request.Form <> "" and strSearchId <> "" then if strSiteId = "" then SiteIdmsg = "You must enter a site id to search." end if if SiteIdmsg = "" then ' Create a recordset object to store specific table information Set objSearch = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From REListing where REListingId=" & strSiteId 'Set the recordset object equal to the SQL query string objSearch.Open SQL, objADO, 1, 3 if objSearch.EOF then SiteIdmsg = "Site Id " & strSiteId & " does not exist in our database. Please try again." else Response.Redirect "detail.asp?Id=" & strSiteId end if end if end if if Request.Form <> "" and strMailSubmit <> "" then if strEmail = "" then strMailWarning = "You must type an email address to join our mailing list." end if 'Make sure a valid email address if strEmail <> "" and (instr( strEmail, "@") = 0 or instr( strEmail, ".") = 0) then strMailWarning = "
Email Address must be in the form account@server.com." end if if strMailWarning = "" then ' Create a recordset object to store specific table information Set objEmail = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From TblEmail where (EmailAddress = '" + strEmail + "')" 'Set the recordset object equal to the SQL query string objEmail.Open SQL, objADO, 1, 3 if objEmail.EOF then objEmail.addnew objEmail("EmailAddress") = strEmail objEmail("DateAdded") = Date() objEmail.update strMailWarning ="
Your email address has been sucessfully added to our mailing list." 'Mail STATING you hate to see them go and link if they want to subscribe again. ' Create a recordset object to store specific table information strSubject = strVarCompany & " Mail Subscription Request" strBody = strBody + "Your email address has been successfully added to our mailing list." &vbcrlf strBody = strBody + "Thank you for being a subscriber." & vbcrlf strBody = strBody + "To unsubscribe, use the url " & strVarWebsite & "." & vbcrlf strBody = strBody + "Again thank you for being a subscriber." Set objNewMail = Server.CreateObject("CDONTS.NewMail") objNewMail.From = strVarEmail objNewMail.To = strEmail objNewMail.Subject = strSubject objNewMail.BodyFormat = 1 'objNewMail.MailFormat = 1 objNewMail.Body = strBody objNewMail.Send() else strMailWarning = "
That Email Address already joined our mailing list." end if end if end if %>
FEATURED PROPERTY LISTINGS
Feature your property on our site and sell fast!
Click Here to find out how.
<% 'Database Connection String; 'Server.MapPath = the location of the database on the server 'please change the path to the correct path on your server Set objADO = Server.CreateObject("ADODB.Connection") sDSN = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("db\fsboREplus.mdb") & ";" objADO.Open sDSN 'Contact Variables; Used in contact.asp and other pages that contain the contact info. 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. ' Create a recordset object to store specific table information Set objConfig = Server.CreateObject("ADODB.Recordset") 'Establish what records you want selected for the SQL query string SQL = "Select * From TblConfig" 'Set the recordset object equal to the SQL query string objConfig.Open SQL, objADO, 1, 3 strVarCompany = objConfig("Company") strVarAddress = objConfig("CompanyAddress") strVarCity = objConfig("CompanyCity") strVarState = objConfig("CompanyState") strVarZip = objConfig("CompanyZip") strVarCountry = objConfig("CompanyCountry") strVarEmail = objConfig("CompanyEmail") strVarPhone = objConfig("CompanyPhone") strVarFax = objConfig("CompanyFax") strVarMainContact = objConfig("CompanyContact") strVarWebsite = objConfig("CompanyWebsite") strVarBGColor = objConfig("BGColor") strSlogan = objConfig("Slogan") strOfferAdvertising = objConfig("OfferAdvertising") str1000ImpressionsAdCost = objConfig("1000ImpressionsCost") str5000ImpressionsAdCost = objConfig("5000ImpressionsCost") str10000ImpressionsAdCost = objConfig("10000ImpressionsCost") str50000ImpressionsAdCost = objConfig("50000ImpressionsCost") str100000ImpressionsAdCost = objConfig("100000ImpressionsCost") strServiceType = objConfig("ServiceType") strServiceAdCost = objConfig("ServiceAdCost") strAgentList = objConfig("AgentList") strLogo = objConfig("logo") strKeywords = objConfig("Keywords") strMetaDescription = objConfig("MetaDescription") 'PAYPAL VARIABLES - See PaypalCode.doc located in the documentation folder 'These variables are pulled from the table TblConfig and these values can 'be edited through the site admin control panel. Do not edit the values in this page. 'Email address the payment should be sent to strPayPalEmail = objConfig("PayPalEmail") strAgentFeatured1MonthCost = objConfig("AgentFeatured1MonthCost") strAgentFeatured3MonthCost = objConfig("AgentFeatured3MonthCost") strAgentFeatured6MonthCost = objConfig("AgentFeatured6MonthCost") strAgentFeatured12MonthCost = objConfig("AgentFeatured12MonthCost") strAgentStandard1MonthCost = objConfig("AgentStandard1MonthCost") strAgentStandard3MonthCost = objConfig("AgentStandard3MonthCost") strAgentStandard6MonthCost = objConfig("AgentStandard6MonthCost") strAgentStandard12MonthCost = objConfig("AgentStandard12MonthCost") strUserFeatured1MonthCost = objConfig("UserFeatured1MonthCost") strUserFeatured3MonthCost = objConfig("UserFeatured3MonthCost") strUserFeatured6MonthCost = objConfig("UserFeatured6MonthCost") strUserFeatured12MonthCost = objConfig("UserFeatured12MonthCost") strUserStandard1MonthCost = objConfig("UserStandard1MonthCost") strUserStandard3MonthCost = objConfig("UserStandard3MonthCost") strUserStandard6MonthCost = objConfig("UserStandard6MonthCost") strUserStandard12MonthCost = objConfig("UserStandard12MonthCost") 'Description of the service to appear on the Featured Listing receipt strFeaturedAdDescription = "Featured Listing on " & strVarWebsite 'Description of the service to appear on the Regular Listing receipt strStandardAdDescription = "Standard Listing on " & strVarWebsite 'Description of the service to appear on the Upgrade Listing receipt strUpgradeAdDescription = "Upgrade Listing on " & strVarWebsite 'Cost you want to charge for the listing strUpgradeAdCost = objConfig("UpgradeAdCost") 'whether ads are paid or free strListingType = objConfig("ListingType") 'Page that the user should return to after making payment for featured ad; 'They should return to page step1F.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1F.asp strPayPalReturnPageFeatured = strVarWebsite + "/featuredsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageRegular = strVarWebsite + "/standardsuccess.asp" 'Page that the user should return to after making payment for regular ad; 'They should return to page step1.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/step1.asp strPayPalReturnPageUpgrade = strVarWebsite + "/upgradesuccess.asp" 'Page that the user should return to if cancelling before completing PayPal payment; 'They should return to page cancel.asp under your domain; 'http://www.yourdomain.com/FSBO Auto Folder/cancel.asp strPayPalCancel = strVarWebsite + "/cancel.asp" %> <% Sub CreateRoomCombo(iCount)%> <% End Sub Sub CreateFlooringCombo(iCount)%> <% End Sub ' Formats a given 10 digit number into a nice looking phone number ' Example: given strNumber of 8005551212 you get (800) 555-1212 Function FormatPhoneNumber(strNumber) Dim strInput ' String to hold our entered number Dim strTemp ' Temporary string to hold our working text Dim strCurrentChar ' Var for storing each character for eval. Dim I ' Looping var ' Uppercase all characters for consistency strInput = UCase(strNumber) ' To be able to handle some pretty bad formatting, strip out ' all characters except for chars A to Z and digits 0 to 9 ' before proceeding. I left in the chars for slogan ' numbers like 1-800-GET-CASH etc... For I = 1 To Len(strInput) strCurrentChar = Mid(strInput, I, 1) ' Numbers (0 to 9) If Asc("0") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("9") Then strTemp = strTemp & strCurrentChar End If ' Upper Case Chars (A to Z) If Asc("A") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("Z") Then strTemp = strTemp & strCurrentChar End If Next 'I ' Swap strTemp back to strInput for next set of validation strInput = strTemp strTemp = "" ' Remove leading 1 if applicable If Len(strInput) = 11 And Left(strInput, 1) = "1" Then strInput = Right(strInput, 10) End If ' Error catch to make sure strInput is proper length now that ' we've finished manipulating it. If Not Len(strInput) = 10 Then ' Handle errors. Err.Raise 1, "FormatPhoneNumber function", _ "The phone number to be formatted must be a valid 10 digit US phone number!" End If ' If an error occurred then the rest of this won't get processed. ' Build the output formatted string ' (xxx) xxx-xxxx strTemp = "(" ' "(" strTemp = strTemp & Left(strInput, 3) ' Area code strTemp = strTemp & ") " ' ") " strTemp = strTemp & Mid(strInput, 4, 3) ' Exchange strTemp = strTemp & "-" ' "-" strTemp = strTemp & Right(strInput, 4) ' 4 digit part ' Set return value FormatPhoneNumber = strTemp End Function sub openrs(rs, sql) Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorLocation = adUseServer rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText end sub function ToHTML(strValue) if IsNull(strValue) then ToHTML = "" else ToHTML = Server.HTMLEncode(strValue) end if end function function ToURL(strValue) if IsNull(strValue) then strValue = "" ToURL = Server.URLEncode(strValue) end function function GetValueHTML(rs, strFieldName) GetValueHTML = ToHTML(GetValue(rs, strFieldName)) end function function GetValue(rs, strFieldName) on error resume next if rs is nothing then GetValue = "" elseif (not rs.EOF) and (strFieldName <> "") then res = rs(strFieldName) if isnull(res) then res = "" end if GetValue = res else GetValue = "" end if if bDebug then response.write err.Description end function function GetParam(ParamName) if Request.QueryString(ParamName).Count > 0 then Param = Request.QueryString(ParamName) elseif Request.Form(ParamName).Count > 0 then Param = Request.Form(ParamName) else Param = "" end if if Param = "" then GetParam = Empty else GetParam = Param end if end function Function ToSQL(Value, sType) Param = Value if Param = "" then ToSQL = "Null" else if sType = "Number" then ToSQL = CDbl(Param) else ToSQL = "'" & Replace(Param, "'", "''") & "'" end if end if end function function DLookUp(Table, fName, sWhere) on error resume next Res = cn.execute("select " & fName & " from " & Table & " where " & sWhere).Fields(0).Value if IsNull(Res) then Res = "" DLookUp = Res end function function getCheckBoxValue(sVal, CheckedValue, UnCheckedValue, sType) if isempty(sVal) then if UnCheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = UnCheckedValue else getCheckBoxValue = "'" & Replace(UnCheckedValue, "'", "''") & "'" end if end if else if CheckedValue = "" then getCheckBoxValue = "Null" else if sType = "Number" then getCheckBoxValue = CheckedValue else getCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'" end if end if end if end function function getValFromLOV(sVal, aArr) sRes = "" if (ubound(aArr) mod 2) = 1 then for i = 0 to ubound(aArr) step 2 if cstr(sVal) = cstr(aArr(i)) then sRes = aArr(i+1) next end if getValFromLOV = sRes end function function get_options(sql,is_search,is_required,selected_value) options_str="" if is_search then options_str=options_str&"" else if is_required then options_str=options_str&"" end if openrs tmprs,sql while not tmprs.EOF id=GetValue(tmprs, 0) value=GetValue(tmprs, 1) selected="" if CStr(id) = CStr(selected_value) then selected = "SELECTED" end if options_str = options_str & "" tmprs.MoveNext wend get_options = options_str end function Function ProceedError() if cn.Errors.Count > 0 then ProceedError = cn.Errors(0).Description & " (" & cn.Errors(0).Source & ")" elseif not (Err.Description = "") then ProceedError = Err.Description else ProceedError = "" end if end Function function CheckSecurity(iLevel) if Session("UserID") = "" then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) else if CLng(Session("UserRights")) < CLng(iLevel) then response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME"))) End if end function %> <% sSQL = "SELECT * FROM REListing where (AdType = '1')" Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sSQL, objADO, 1, 3 IF (RS.EOF) THEN %> There are not any featured properties. <% Else rndMax = CInt(RS.RecordCount) RS.MoveFirst Do While Not RS.EOF RS.MoveNext Loop RS.MoveFirst Randomize Timer rndNumber = Int(RND * rndMax) RS.Move rndNumber id = rs("REListingId") imgsrc = rs("REListingImage") 'UrlTo = RS("LinkTo") 'GetImg = RS("ImgUrl") 'WriteSize1 = RS("SizeOf1") 'WriteSize2 = RS("SizeOf2") 'DisText = RS("TextUnder") 'ImpNow = RS("ImpNow") 'ImpNewNow = ImpNow + 1 End If %> <% if not rs.eof then %>

"> <%If (rs("REListingImage")) <> "upload" Then %> " border="0" width="160" height="120"> <% Else%> <%End If %>
<%=rs("REListingCity")%>, <%=rs("REListingState")%>   <%=rs("REListingZip")%>
<% if rs("REListingPrice") > "0" then %> <%= formatcurrency(rs("REListingPrice"))%> <% else %> Call For Price <% end if %>

Click here to view more featured properties. <% end if %>

<% if SiteIdMsg <> "" then %>
Message(s): <%= SiteIdMsg %>
<% end if %>
Site Id Search:

<% if strMailWarning <> "" then %>
Message(s): <%= strMailWarning %>
<% end if %>

Join Our Mailing List
Enter Your Email Address:

WEBSITE CONFIGURATION

Please complete the following form to edit your site's configuration.
Fields marked with an * are required.

<% if WarningErrMsg <> "" then %>
Message(s):<%= warningErrMsg %>
<% end if %>

<% sSQL = "SELECT * FROM TblStates order by StateId ASC" Set rsState = Server.CreateObject("ADODB.Recordset") rsState.Open sSQL, objADO, 3, 3 %> <% sSQL = "SELECT * FROM TblCountries order by Country_Id ASC" Set rsCountry = Server.CreateObject("ADODB.Recordset") rsCountry.Open sSQL, objADO, 3, 3 %>
CONTACT INFORMATION
Company Name: *
<% if Request.Form <> "" then %> <% else %> <% end if %>
Contact: *
Full name of the main contact for the site
<% if Request.Form <> "" then %> <% else %> <% end if %>
Company Email: *
This is the email address members will receive mail from.
All webforms and system generated emails will also send to this address. This needs to be an address @ your domain for auto emails sent from the website to function properly.
<% if Request.Form <> "" then %> <% else %> <% end if %>
Address: *
Street Address of your company
<% if Request.Form <> "" then %> <% else %> <% end if %>
City: *
City your company is located in
<% if Request.Form <> "" then %> <% else %> <% end if %>
State/Province/Territory: *
State, Province, or Territory your company is located in
Zip: *
Zip your company is located in
<% if Request.Form <> "" then %> <% else %> <% end if %>
Country: *
Country your company is located in
Phone: *
<% if Request.Form <> "" then %> <% else %> <% end if %>
Fax:
<% if Request.Form <> "" then %> <% else %> <% end if %>
WEBSITE INFORMATION
Company Website: *
Url of this website. Please use the full URL.
It is very important that you use the FULL URL. If not portions of the site will not work properly.
<% if Request.Form <> "" then %> <% else %> <% end if %>
Company Logo:
Logo for this website.
Would you like to upload a different logo for this website? Click Here To Upload
Background Color:
The color you want for the background of this site.
<% if Request.Form <> "" then %> <% else %> <% end if %>
Slogan:
Your company's slogan
<% if Request.Form <> "" then %> <% else %> <% end if %>
Are you going to allow Real Estate Agents to create their login?
<% if Request.Form <> "" then %> checked<% end if %>>Yes checked<% end if %>>No <% else %> checked<% end if %>>Yes checked<% end if %>>No <% end if %>
LISTING INFORMATION
Input the number zero for listing types that you would like to be free.

Agent Featured Listing Costs:
One Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Three Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Six Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Twelve Month:
<% if Request.Form <> "" then %> <% else %> <% end if %>
Agent Standard Listing Costs:
One Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Three Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Six Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Twelve Month:
<% if Request.Form <> "" then %> <% else %> <% end if %>
User Featured Listing Costs:
One Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Three Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Six Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Twelve Month:
<% if Request.Form <> "" then %> <% else %> <% end if %>
User Standard Listing Costs:
One Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Three Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Six Month:
<% if Request.Form <> "" then %> <% else %> <% end if %> 		Twelve Month:
<% if Request.Form <> "" then %> <% else %> <% end if %>
PayPal Email:
Email address you use to receive money at Paypal.
Your paypal account must be a premier or business account.
You must list a paypal email address if selecting paid listings. <% if Request.Form <> "" then %> <% else %> <% end if %>
SERVICE DIRECTORY INFORMATION
What type of service directory listings are you going to offer to the public? <% if Request.Form <> "" then %> checked<% end if %>>Paid checked<% end if %>>Free <% else %> checked<% end if %>>Paid checked<% end if %>>Free <% end if %>
Service Listing Cost:
What you want to charge for service listings. Numbers Only.
Leave blank for free listings. Required for paid listings.
<% if Request.Form <> "" then %> <% else %> <% end if %>
ADVERTISING INFORMATION
Are you going to offer advertising to the public on your site?
<% if Request.Form <> "" then %> checked<% end if %>>Yes checked<% end if %>>No <% else %> checked<% end if %>>Yes checked<% end if %>>No <% end if %>
Advertising Cost:
What you want to charge for 1,000 banner impressions? Numbers Only
Leave blank if not offering advertising. Required if offering advertising.
<% if Request.Form <> "" then %> <% else %> <% end if %>

What you want to charge for 5,000 banner impressions? Numbers Only
Leave blank if not offering advertising. Required if offering advertising.
<% if Request.Form <> "" then %> <% else %> <% end if %>

What you want to charge for 10,000 banner impressions? Numbers Only
Leave blank if not offering advertising. Required if offering advertising.
<% if Request.Form <> "" then %> <% else %> <% end if %>

What you want to charge for 50,000 banner impressions? Numbers Only
Leave blank if not offering advertising. Required if offering advertising.
<% if Request.Form <> "" then %> <% else %> <% end if %>

What you want to charge for 100,000 banner impressions? Numbers Only
Leave blank if not offering advertising. Required if offering advertising.
<% if Request.Form <> "" then %> <% else %> <% end if %>


(c) <%= year(date) %> <%= strVarCompany %>
Read our Terms & Conditions, and Privacy Policy
Website Development Provided By: Development Solutions