<%'This script is Copyright(c) Early Impact LLC, http://www.earlyimpact.com.
' ******************************************************************************
' This file dynamically generates meta tags to make ProductCart pages more
' search engine friendly. You will need to invoke this file from pc/header.asp
' as described below.
'
' Place the following code include file at the very top of the code
'
'
' Place the following code immediately after the opening tag
' Note that the ASP opening and closing tag here contain an extra space that needs
' to be removed after you copy this code into header.asp
' < % GenerateMetaTags() % >
'
' ******************************************************************************
' ******************************************************************************
' Edit the content for the following constants
' ******************************************************************************
' The following is used as the page title when the page that is being loaded is not
' a product or category page. If it is a product or category page, the page title is
' the product name and category name respectively. Replace the ProductCart title
' shown below with your own.
Const DefaultTitle = "Welcome To The Quilted Bear"
' The following is used as the "Content" for the default "Keywords" meta tag. When the
' page is a product or category page, the product or category names are also added to
' the keywords. Replace the following keywords with your own.
Const DefaultKeywords = "craft mall, craft store, crafter store, unique gifts, Jim Shore, Demdaco, home decor, willowtree, willow tree, Quilted Bear, The Quilted Bear"
' The following is used as the "Content" for the default "Description" meta tag. When the
' page is a product or category page, the product or category descriptions replace the
' default category description.
Const DefaultDescription = "The Quilted Bear - Unique Gifts, Decor, and More!"
' ******************************************************************************
' You should not need to edit the code after this point
' ******************************************************************************
Sub GenerateMetaTags()
Title = ""
Keywords = ""
mtDescription = ""
' ******************************************************************************
' Get Product and Category ID
' ******************************************************************************
GMidproduct=request("idproduct")
GMidcategory=request("idcategory")
GMpcCartIndex=request("pcCartIndex")
' ******************************************************************************
' PRODUCT-specific Meta Tags
' ******************************************************************************
if (GMidproduct="") and (GMpcCartIndex<>"") then
pcCartArray = Session("pcCartSession")
GMidproduct=pcCartArray(GMpcCartIndex,0)
end if
GMTags=False
if validNum2(GMidproduct) then
Set conn=Server.CreateObject("ADODB.Connection")
conn.Open scDSN
'// Get information from "products" table
query="select description,details,sDesc,pcprod_MetaTitle,pcprod_MetaDesc,pcprod_MetaKeywords from Products where idProduct=" & GMidproduct
set rsTagObj=server.CreateObject("ADODB.RecordSet")
set rsTagObj=conn.execute(query)
if not rsTagObj.eof then
GMTags=True
mtPName=rsTagObj("description")
mtPName=ClearHTMLTags2(mtPName,0)
mtPDesc=rsTagObj("details")
mtPDesc=ClearHTMLTags2(mtPDesc,0)
mtPsDesc=rsTagObj("sDesc")
if mtPsDesc<>"" then
mtPsDesc=ClearHTMLTags2(mtPsDesc,0)
mtPsDesc=Left(mtPsDesc,200)
else
mtPsDesc=Left(mtPDesc,200)
end if
mtPMetaTitle=rsTagObj("pcprod_MetaTitle")
mtPMetaTitle=ClearHTMLTags2(mtPMetaTitle,0)
mtPMetaDesc=rsTagObj("pcprod_MetaDesc")
mtPMetaDesc=ClearHTMLTags2(mtPMetaDesc,0)
mtPMetaKeywords=rsTagObj("pcprod_MetaKeywords")
set rsTagObj=nothing
' Get information from "Categories" table
myTest=0
If validNum2(GMidcategory) then
query="select categoryDesc from Categories where idcategory=" & GMidcategory
myTest=1
else
query="select categories.categoryDesc from Categories,Categories_Products where Categories_Products.idProduct=" & GMidproduct & " and Categories.idcategory=Categories_Products.idcategory"
end if
set rsTagObj=server.CreateObject("ADODB.RecordSet")
set rsTagObj=conn.execute(query)
mtCDesc=""
if not rsTagObj.eof then
mtCDesc=rsTagObj("categoryDesc")
mtCDesc=ClearHTMLTags2(mtCDesc,0)
if mtCDesc<>"" then
mtCDesc=Left(mtCDesc,200)
end if
end if
set rsTagObj=nothing
'// Product Details Page: TITLE
if not isNull(mtPMetaTitle) and mtPMetaTitle<>"" then
Title=mtPMetaTitle
else
if (myTest=1) and (mtCDesc<>"") then
Title=mtPName & " - " & mtCDesc
else
Title=mtPName
end if
end if
if scCompanyName<>"" then
Title=Title & " - " & scCompanyName
end if
'// Product Details Page: KEYWORDS
if not isNull(mtPMetaKeywords) and mtPMetaKeywords<>"" then
Keywords=mtPMetaKeywords
else
Keywords=mtPName & "," & mtCDesc & "," & DefaultKeywords & "," & scCompanyName
end if
'// Product Details Page: DESCRIPTION
if not isNull(mtPMetaDesc) and mtPMetaDesc<>"" then
mtDescription=mtPMetaDesc
else
mtDescription=mtPName & "," & mtPsDesc & "," & mtCDesc & "," & scCompanyName
end if
end if
conn.Close
set conn=nothing
end if
' ******************************************************************************
' END PRODUCT-specific Meta Tags
' ******************************************************************************
' ******************************************************************************
' CATEGORY-specific Meta Tags
' ******************************************************************************
if (GMTags=False) and (validNum2(GMidcategory)) then
Set conn=Server.CreateObject("ADODB.Connection")
conn.Open scDSN
query="select categoryDesc, SDesc, LDesc, pcCats_MetaTitle, pcCats_MetaDesc, pcCats_MetaKeywords from categories where idCategory=" & GMidcategory
set rsTagObj=server.CreateObject("ADODB.RecordSet")
set rsTagObj=conn.execute(query)
if not rsTagObj.eof then
GMTags=True
mtCName=rsTagObj("categoryDesc")
mtCName=ClearHTMLTags2(mtCName,0)
mtCsDesc=rsTagObj("SDesc")
mtCsDesc=ClearHTMLTags2(mtCsDesc,0)
mtCDesc=rsTagObj("LDesc")
mtCDesc=ClearHTMLTags2(mtCDesc,0)
mtCMetaTitle=rsTagObj("pcCats_MetaTitle")
mtCMetaTitle=ClearHTMLTags2(mtCMetaTitle,0)
mtCMetaDesc=rsTagObj("pcCats_MetaDesc")
mtCMetaDesc=ClearHTMLTags2(mtCMetaDesc,0)
mtCMetaKeywords=rsTagObj("pcCats_MetaKeywords")
set rsTagObj=nothing
if mtCsDesc<>"" then
mtCsDesc=Left(mtCsDesc,200)
else
if mtCDesc<>"" then
mtCsDesc=Left(mtCDesc,200)
end if
set rsTagObj=nothing
end if
if mtCDesc<>"" then
mtCDesc=Left(mtCDesc,200)
else
if mtCsDesc<>"" then
mtCDesc=Left(mtCsDesc,200)
end if
end if
'// Category Page: TITLE
if not isNull(mtCMetaTitle) and mtCMetaTitle<>"" then
Title=mtCMetaTitle
else
if scCompanyName<>"" then
Title=mtCName & " - " & scCompanyName
else
Title=mtCName
end if
end if
'// Category Page: KEYWORDS
if not isNull(mtCMetaKeywords) and mtCMetaKeywords<>"" then
Keywords=mtCMetaKeywords
else
Keywords=mtCName & "," & DefaultKeywords & "," & scCompanyName
end if
'// Category Page: DESCRIPTION
if not isNull(mtCMetaDesc) and mtCMetaDesc<>"" then
mtDescription=mtCMetaDesc
else
mtDescription=mtCName & "," & mtCsDesc & "," & mtCDesc
end if
end if
conn.Close
set conn=nothing
end if
' ******************************************************************************
' END CATEGORY-specific Meta Tags
' ******************************************************************************
'// Build the meta tags
'// Check to see if this is a content page
Dim pcIntIsContentPage
if request("idpage")<>"" then
pcIntIsContentPage=1
end if
if (GMTags=False) and (scCompanyName<>"") then
GMTags=True
Title= DefaultTitle & " - " & scCompanyName
Keywords = DefaultKeywords
mtDescription = DefaultDescription
end if
if (GMTags=False) then
Title=DefaultTitle
Keywords = DefaultKeywords
mtDescription = DefaultDescription
end if
Title=replace(Title,"""",""")
Title=replace(Title," - ,",",")
Keywords=replace(Keywords,"""","")
Keywords=replace(Keywords,""","")
'Keywords=replace(Keywords," - ,",",")
mtDescription=replace(mtDescription,"""","")
mtDescription=replace(mtDescription,""","")
mtDescription=replace(mtDescription," - ,",",")
if pcIntIsContentPage<>1 then
Response.Write "" & Title & "" & vbcrlf & _
"" & vbcrlf
else
Response.Write "" & vbcrlf
end if
Response.Write "" & vbcrlf & _
"" & vbcrlf & _
"" & vbcrlf
End Sub
'[ClearHTMLTags2]
'Coded by Jóhann Haukur Gunnarsson
'joi@innn.is
' Purpose: This function clears all HTML tags from a string using Regular Expressions.
' Inputs: strHTML2; A string to be cleared of HTML TAGS
' intWorkFlow2; An integer that if equals to 0 runs only the regEx2p filter
' .. 1 runs only the HTML source render filter
' .. 2 runs both the regEx2p and the HTML source render
' .. >2 defaults to 0
' Returns: A string that has been filtered by the function
function ClearHTMLTags2(strHTML2, intWorkFlow2)
'Variables used in the function
dim regEx2, strTagLess2
'---------------------------------------
strTagLess2 = strHTML2
'Move the string into a private variable
'within the function
'---------------------------------------
'---------------------------------------
'Early Impact codes
IF strTagLess2<>"" THEN
strTagLess2=replace(strTagLess2," "," ")
strTagLess2=replace(strTagLess2," "," ")
strTagLess2=replace(strTagLess2,"
"," ")
strTagLess2=replace(strTagLess2,"
"," ")
strTagLess2=replace(strTagLess2,"
"," ")
strTagLess2=replace(strTagLess2,""," ")
strTagLess2=replace(strTagLess2,vbcrlf," ")
strTagLess2=trim(strTagLess2)
do while instr(strTagLess2," ")>0
strTagLess2=replace(strTagLess2," "," ")
loop
END IF
'Modify the string to a friendly ONLY 1 LINE string
'---------------------------------------
IF strTagLess2<>"" THEN
'regEx2 initialization
'---------------------------------------
set regEx2 = New regExp
'Creates a regEx2p object
regEx2.IgnoreCase = True
'Don't give frat about case sensitivity
regEx2.Global = True
'Global applicability
'---------------------------------------
'Phase I
' "bye bye html tags"
if intWorkFlow2 <> 1 then
'---------------------------------------
regEx2.Pattern = "<[^>]*>"
'this pattern mathces any html tag
strTagLess2 = regEx2.Replace(strTagLess2, "")
'all html tags are stripped
'---------------------------------------
end if
'Phase II
' "bye bye rouge leftovers"
' "or, I want to render the source"
' "as html."
'---------------------------------------
'We *might* still have rouge < and >
'let's be positive that those that remain
'are changed into html characters
'---------------------------------------
if intWorkFlow2 > 0 and intWorkFlow2 < 3 then
regEx2.Pattern = "[<]"
'matches a single <
strTagLess2 = regEx2.Replace(strTagLess2, "<")
regEx2.Pattern = "[>]"
'matches a single >
strTagLess2 = regEx2.Replace(strTagLess2, ">")
'---------------------------------------
end if
'Clean up
'---------------------------------------
set regEx2 = nothing
'Destroys the regEx2p object
'---------------------------------------
END IF 'vefiry strTagLess2 (null strings)
'---------------------------------------
ClearHTMLTags2 = strTagLess2
'The results are passed back
'---------------------------------------
end function
'check for real integers
Function validNum2(strInput)
DIM iposition ' Current position of the character or cursor
validNum2 = true
if isNULL(strInput) OR trim(strInput)="" then
validNum2 = false
else
'loop through each character in the string and validate that it is a number or integer
For iposition=1 To Len(trim(strInput))
if InStr(1, "12345676890", mid(strInput,iposition,1), 1) = 0 then
validNum2 = false
Exit For
end if
Next
end if
end Function
%>
<%if pcv_PageName<>"" then%>
Welcome to The Quilted Bear
<%end if%>
<%GenerateMetaTags()%>
<%Response.Buffer=True%>
<%
Set conlayout=Server.CreateObject("ADODB.Connection")
conlayout.Open scDSN
Set RSlayout = conlayout.Execute("Select * From layout Where layout.ID=2")
Set rsIconObj = conlayout.Execute("Select * From icons WHERE id=1")
%>
The Quilted Bear
