<%
' Copyright (C) 1998-2005 Cyberstrong Internet Services, Inc. All Rights Reserved
'
' This file has been seeded with unique information at point of sale and
' is traceable to its purchaser.
'
' Your license agreement forbids the removal of this notice.
Dim FileObj, FileOutIndex, ProductIndexIntro
' bldCat() - Build search engine pages.
Public Sub bldCat(ByVal argReturnTo)
Dim SQL, AbsFileName, Template, Body, i
Dim FileIn, FileOut, rsProducts
Dim FieldDef, Substitute
' We do will our own error handling ...
On Error Resume Next
' This text will be displayed at the top of the index page, before the links ...
ProductIndexIntro = _
"Here is a current list of all the products we carry at " & cstCatalogName & ". " & _
"For more information on each product listed, please click the link below."
' Write page start and standard heading...
wl("")
Call DisplayPageHeader("", "Building Search Engine Pages...", "") : wl(" ")
' Connect to the database ...
Set Conn = dbOpen("r")
' Get Product record set ...
set rsProducts = Server.CreateObject("ADODB.Recordset")
SQL = ""
SQL = SQL & "SELECT * FROM Products"
SQL = SQL & " WHERE "
If (cstDisplayDatesEnabled) Then
SQL = SQL & " ((ProductStartDate Is Null) OR (ProductStartDate <= {fn Now()})) AND "
SQL = SQL & " ((ProductEndDate Is Null) OR (ProductEndDate >= {fn Now()})) AND "
End If
If (cstProductHideEnabled) Then
SQL = SQL & " {fn LCase(ProductHide)} <> 'yes' AND "
End If
SQL = SQL & "(1 = 1) "
SQL = SQL & "ORDER BY ProductName"
rsProducts.Open SQL, Conn, adOpenKeyset, adLockOptimistic
' Start file operations ...
Set FileObj = Server.CreateObject("Scripting.FileSystemObject")
' Get template file ...
Err.Clear
Set FileIn = FileObj.OpenTextFile(RootPath & "\custom\cart\tCatalog.htm", ForReading, False)
If (Err) Then
wl("Unable to open template file custom\cart\tCatalog.htm, operation canceled.")
Set FileObj = Nothing
Set FileIn = Nothing
Response.End
End If
Template = FileIn.ReadAll
FileIn.Close
' Create destination folder ...
Call CreateFolder(RootPath & "catalog")
' Index file open ...
Call WriteIndexFile("open", "")
' Write the static pages ...
i = 0
Do While (Not rsProducts.EOF)
If (Trim(rsProducts("ProductName")) <> "") Then
' Substitute user variables ...
Body = Template
' Replace fields in template ...
For Each FieldDef in rsProducts.Fields
Substitute = ""
Select Case FieldDef.Name
Case "ProductKeywords"
If (cstKeywordsEnabled) Then
Substitute = Replace(rsProducts("ProductKeywords"), """", "")
End If
Case "ProductImageSmall"
Substitute = GetProductImagePath(rsProducts("ProductImageSmall"))
Case "ProductImageLarge"
Substitute = GetProductImagePath(rsProducts("ProductImageLarge"))
Case "ProductDescriptionLong"
Substitute = Replace(StripHTML(GetLongDescription(rsProducts("ProductDescription"), rsProducts("ProductDescriptionLong"))), """", "")
Case "ListPrice", "SalePrice", "UnitPrice"
Substitute = OurFormatCurrency(rsProducts(FieldDef.Name))
Case Else
Substitute = Replace(StripHTML(rsProducts(FieldDef.Name)), """", "")
End Select
Body = Replace(Body, "$(" & FieldDef.Name & ")", Substitute)
Next
' Replace selected parms in template ...
Body = Replace(Body, "$(ProductImageFolder)", cstProductImageFolder)
Body = Replace(Body, "$(CatalogName)", cstCatalogName)
Body = Replace(Body, "$(NotifyAddress1)", cstNotifyAddress1)
Body = Replace(Body, "$(NotifyAddress2)", cstNotifyAddress2)
Body = Replace(Body, "$(SecurePrefix)", AdjustPrefix(cstSecurePrefix))
Body = Replace(Body, "$(NonSecurePrefix)", AdjustPrefix(cstNonSecurePrefix))
Body = Replace(Body, "$(HomeURL)", AdjustURL(cstHomeURL))
Body = Replace(Body, "$(BrowseStartPageURL)", AdjustURL(cstBrowseStartPageURL))
' Open a file for write ...
AbsFileName = RootPath & "catalog/" & rsProducts("ProductID") & ".htm"
Set FileOut = FileObj.CreateTextFile(AbsFileName, True)
FileOut.WriteLine(Body)
FileOut.Close
' Index file link ...
Call WriteIndexFile("link", "" & rsProducts("ProductName") & "")
End If ' (Trim(rsProducts("ProductName")) <> "")
i = i + 1
' Progress report ...
Call ReportProgress("" & _
FormatNumber(((i / rsProducts.RecordCount) * 100.00), 0) & "% Complete. ", 10)
Response.Flush
rsProducts.MoveNext
Loop
' Index page close ...
Call WriteIndexFile("close", "")
rsProducts.Close
set rsProducts = Nothing
set FileObj = Nothing
set FileIn = Nothing
set FileOut = Nothing
wl("100% Complete. ")
wl(" [ Continue ] ")
wl("")
dbClose(Conn)
End Sub
' WriteIndexFile() - Writes index file to guide search engines to static pages.
' - Link this file from somewhere on your site ...
Public Sub WriteIndexFile(ByVal argMode, ByVal argData)
Dim AbsFileName
' Do our own error handling ...
On Error Resume Next
Select Case argMode
Case "open"
AbsFileName = RootPath & "catalog/ProdList.htm"
Err.Clear
Set FileOutIndex = FileObj.CreateTextFile(AbsFileName, True)
If (Err) Then
wl("Unable to create search engine page index catalog/ProdList.htm, check server folder permissions here.")
Set FileOutIndex = Nothing
Response.End
End If
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("" & cstCatalogName & ": Product Index")
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("
")
FileOutIndex.WriteLine("
Product Index")
FileOutIndex.WriteLine("
" & ProductIndexIntro & "
")
Case "link"
FileOutIndex.WriteLine("" & argData & " ")
Case "close"
FileOutIndex.WriteLine("")
FileOutIndex.Close
' Create "default.htm" file to vector folder-only references ...
AbsFileName = RootPath & "catalog/default.htm"
Err.Clear
Set FileOutIndex = FileObj.CreateTextFile(AbsFileName, True)
If (Err) Then
wl("Unable to create re-direct page (default.htm), check server folder permissions here.")
Set FileOutIndex = Nothing
Response.End
End If
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("
")
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("")
FileOutIndex.WriteLine("")
FileOutIndex.Close : set FileOutIndex = Nothing
End Select
End Sub
' AdjustURL - Adjust relative URL, leave others as is ...
Public Function AdjustURL(ByVal argURL)
If (LCase(Left(argURL, 4)) = "http" OR Left(argURL, 1) = "/" OR Left(argURL, 1) = "\") Then
AdjustURL = argURL
Else
AdjustURL = "../" & argURL
End If
End Function
' AdjustPrefix - Adjust secure or nonsecure prefix to account for demo mode ...
Public Function AdjustPrefix(ByVal argPrefix)
If (InStr(LCase(argPrefix), "yourdomain.com") <> 0) Then
AdjustPrefix = "../"
Else
AdjustPrefix = argPrefix
End If
End Function
' CreateFolder()- Create a folder to hold static pages ...
Public Sub CreateFolder(ByVal argFolderName)
On Error Resume Next
' Delete existing folder and all files within ...
' Fails if folder does not exist, that's ok.
FileObj.DeleteFolder argFolderName, False
Err.Clear
' Create it new ...
FileObj.CreateFolder argFolderName
If (Err) Then
wl("Unable to create catalog folder, check server folder permissions here.")
Set FileOutIndex = Nothing
Set FileObj = Nothing
Response.End
End If
End Sub
%>
