<%OPTION EXPLICIT%>
<%
shopcheckadmin ""
'*****************************************************************************
' Version 6.50 Generate static html using template tmp_generate.htm
' shopa_generatehtml.asp
'
' Directory Exists Error Checking
' add max products per category index
' August 11, 2005
' Dec 31, 2005 added additional checks to convert to realname
'*****************************************************************************
const MaxProductPageCount=50
const catheaderfile="tmp_generateheader.htm"
const cattrailerfile="tmp_generatetrailer.htm"
const Listfiles="No" ' do not list products as they are generated
const AllowDeletes="Yes" ' Yes or No
dim rc ' used for handling deletes
dim objcatindexfile ' object for writing index.htm
dim msg ' work area
Dim generatedindex ' index nmae default=index.htm
Dim Generatedirectory ' folder default html
Dim generatetemplate ' product template tmp_generate.htm
dim catheaders(500),cattrailers(500), catheadercount, cattrailercount
dim dbc ' database connection
dim rs
dim i
dim filename
dim filecount ' count of files created
dim categoryfilecount ' count of category records written
dim saction ' form actions
dim f, closecount ' used for timeout handling
dim categoryextensioncount ' counts extension pages on category index record
dim GenerateIndexfile
saction=request("saction")
If saction="" then
saction=request("saction.x")
end if
'*******************************************************************
' see if anything entered on form
' If yes create the HTML files
'*********************************************************************
adminpageheader ' write page header
HandleDeletes rc ' see if we are deleting anything
if saction="" then
If rc=0 then ' not into delete logic
SetDefaults ' get all defaults
DisplayForm ' Se what person wants to do
end if
Else
ValidateData ' generation is starting
If serror="" then
PerformGenerateFiles ' go generate static html
else
DisplayForm ' redisplay the form
end if
End If
adminpagetrailer
'*********************************************************************
' allow merchant to select folder and template
'********************************************************************
Sub DisplayForm
GenerateDisplayHeader "Export Static HTML"
GenerateDisplayBodyHeader
If serror<>"" then
shopwriteerror serror
end if
%><%
GenerateDisplayBodyFooter
gethelp
End Sub
'************************************************************************
' need three things
' index file, folder and template
'************************************************************************
Sub ValidateData
dim rc
serror=""
generatetemplate=TRIM(Request.Form("txtgeneratetemplate"))
GenerateIndexfile=TRIM(Request.Form("txtGenerateIndexfile"))
Generatedirectory=TRIM(Request.Form("txtgeneratedirectory"))
if generatetemplate="" then
serror = serror & getlang("LangProductTemplate") & "
"
end if
if generateIndexfile="" then
serror = serror & getlang("LangGenerateIndexFile") & "
"
end if
if generatedirectory="" then
serror = serror & getlang("Langgeneratedirectory") & "
"
end if
If serror<>"" then
sError = sError & getlang("LangCustRequired") & "
"
End if
If serror="" then
VerifyOutputFile
end if
If Serror="" then
Shopfileexists generatetemplate, rc
if rc>0 then
Serror=Serror & getlang("LangReadfail") & " " & generatetemplate & "
"
end if
end if
End Sub
Sub PerformGenerateFiles
'*************************************************************
' Generate main logic is here
'Three types of files are generated
' Index file that includes all categories/subcategories
' Next generate one record for each category/subcategory
' Next generate one record for each product
'****************************************************************
generatedisplayheader "Static HTML Generator"
generatedisplaybodyheader
%><%
shopopendatabaseP dbc ' open database
Server.ScriptTimeout = 3600
CreateCategoryIndex ' generate category index
CreateCategoryRecords ' generfate category records
CreateProductRecords ' generfate product records
shopclosedatabase dbc ' close database
WriteInfoMessage ' describe what we have done
%><%
generatedisplaybodyfooter
end sub
'******************************************************************************
' create a full index of all categories/subcategories
'*****************************************************************************
Sub CreateCategoryIndex
getcatheaders ' get header and trailers for category record
CreateCatIndexFile objCatIndexFile, GenerateIndexFile ' create index.htm
displaycategories ' write all categories/subcategories
CloseCatIndexFile objcatindexfile ' finish writing index.html and write trailer records
end sub
'**********************************************************************************
'go through all categories and subcategories and write the index.htm file
'***********************************************************************************
Sub Displaycategories
dim sql, rs, level, rc, catdescription, spacing, categoryid
dim highercategoryid, hassubcategory
highercategoryid=0
Generatecatsql sql, highercategoryid
set rs=dbc.execute(sql)
do while not rs.eof
Getcategoryfields rs,categoryid, hassubcategory, catdescription, rc
If rc=0 then
spacing=0
Formatcategory rs, categoryid, catdescription, spacing
If hassubcategory<>"" then
Formatsubcategories categoryid,spacing
end if
end if
rs.movenext
loop
closerecordset rs
Writeline objCatIndexFile,""
end sub
'*******************************************************************************************
' get all categories or sub categories
'******************************************************************************************
Sub Generatecatsql (sql, highercategoryid)
SQL="Select * from categories "
sql = Sql & " where highercategoryid=" & highercategoryid
sql=sql & " order by " & Getconfig("xsortcategories")
end sub
'*************************************************************************************************
' now have a category that needs written out
' do any subcategory spacing then write it out
'************************************************************************************************
Sub Formatcategory (rs, id, name, spacing)
dim i
dim strindexfile ' filename to be linked to
dim spacingfield ' subcategory spacing
dim realname, spacingfields
generatecategoryfilename rs, strIndexFile, categoryextensioncount
spacingfields=""
If spacing>0 then
for i = 0 to spacing
spacingfields=spacingfield & " "
next
end if
WriteCatIndexRecord name, strIndexFile, objCatIndexFile,spacingfields
end sub
'****************************************************************************************
' generate subcatories
'***************************************************************************************
Sub Formatsubcategories (categoryid, spacing)
dim sql, rs, rc, catdescription, hassubcategory
Generatecatsql sql, categoryid
Set rs=dbc.execute(sql)
spacing=spacing+1
do while not rs.eof
Getcategoryfields rs,categoryid, hassubcategory, catdescription, rc
If rc=0 then
Formatcategory rs, categoryid, catdescription, spacing
If hassubcategory<>"" then
Formatsubcategories categoryid, spacing
end if
end if
rs.movenext
loop
spacing=spacing-1
closerecordset rs
end sub
'***************************************************************************************
' get category fields. dont display hidden categories
'**************************************************************************************
Sub Getcategoryfields (rs, categoryid, hassubcategory, strcategory, rc)
dim strcathide
categoryid=rs("categoryid")
strcategory=rs("catdescription")
hassubcategory=rs("hassubcategory")
If isnull(hassubcategory) then
hassubcategory=""
end if
strcathide=rs("cathide") ' hide field
if isnull(strcathide) then
rc=0
else
rc=4
end if
end sub
'********************************************************************************
' create index.htm in the folder supplied by merchant
' header records are written into this file
'*******************************************************************************
Sub CreateCatIndexfile (objFile, filename)
dim catalogid,objfs, serverfilename
If generatedirectory<>"" then
serverfilename=generatedirectory & "/" & filename
Else
serverfilename=filename
End if
generatedindex=serverfilename
Set objFS = CreateObject("Scripting.FileSystemObject")
serverfilename = Server.Mappath(serverfilename)
Set objFile = objFS.CreateTextFile(serverfilename)
WriteCatIndexHeader objfile
end sub
'******************************************************************************
' put all the category header records from the template into the category
' file pointed to by objfile
' start table generation
'*****************************************************************************
Sub WriteCatIndexHeader (objfile)
dim msg
for i = 0 to catheadercount-1
msg=catheaders(i)
Writeline objfile, msg
next
Writeline objfile, tabledef
End Sub
'**************************************************************************************
' write one record into the index.htm file that points to subcategory category record
' if there are no subcategories, it points to product record
'**************************************************************************************
Sub WriteCatIndexRecord (strCatName, strCatFileName, objCatIndex, spacing)
dim msg, url
msg=tablerow & tablecolumn
msg=msg & spacing
url=generateurl (strCatFileName, strCatName)
msg=msg & url
msg=msg & tablecolumnend & tablerowend
Writeline objCatIndexfile, msg
end sub
'******************************************************************************
' Close the index.htm file after witing trailer records
'******************************************************************************
Sub CloseCatIndexFile(objFile)
dim i, msg
Writeline objfile, tabledefend
for i =0 to cattrailercount-1
msg=cattrailers(i)
Writeline objfile, msg
next
objFile.Close
Set objFile = Nothing
End Sub
'******************************************************************************
' create one record for each category/subcategory
'*****************************************************************************
Sub CreateCategoryRecords
dim sql, objfile, filename, serverfilename, rs
sql="select * from categories where cathide is null order by categoryid"
set rs=dbc.execute(sql) ' get all products
categoryfilecount=0
categoryextensioncount=0
do while not rs.eof
CreateCategoryOutputfile rs, filename, objfile, serverfilename, categoryextensioncount ' create physical file
WriteCategoryOutputFile rs, filename, objfile ' format using template
objfile.close
set objfile=nothing
handletimeout
categoryfilecount=categoryfilecount+1 ' count product records created
rs.movenext
loop
closerecordset rs
end sub
'*******************************************************************
' create file in form catdescription_xxx.htm
'*****************************************************************
Sub CreateCategoryOutputfile (rs, filename, objfile, serverfilename, categoryextensioncount)
dim categoryid,objFS, cname, tmpfile
categoryid=rs("categoryid")
cname=rs("catdescription")
generatecategoryfilename rs, filename,categoryextensioncount
tmpfile=filename
If generatedirectory<>"" then
serverfilename=generatedirectory & "/" & filename
Else
serverfilename=filename
End if
Set objFS = CreateObject("Scripting.FileSystemObject")
serverfilename = Server.Mappath(serverfilename)
Set objFile = objFS.CreateTextFile(serverfilename)
If Listfiles="Yes" then
response.write "Creating filename=" & filename & "
"
end if
end sub
'*****************************************************************************************
' a category record includes links to each product in that category
' Vp-ASP uses the prodcategories table to find products beloswing to a category/subcategory
' so we need to get all those records and the product record and generate a hyperlink
' in this category record. In addition we allow merchnat to use their own
' themplates to format the head and trailer of the index record
'****************************************************************************************
sub WriteCategoryOutputFile (rs, filename, objfile )
dim catsql, catrs, psql, prs, categoryid, catalogid, productcount, categorypagecount
WriteCategoryHeader objfile ' Write template header for this category
categoryid=rs("categoryid") ' this is category we are dealing wiyj
catsql="select intcatalogid from prodcategories where intcategoryid=" & categoryid
set catrs=dbc.execute(catsql)
productcount=0 ' products in this page
categoryextensioncount=0 ' number of category pages created for one category
do while not catrs.eof
catalogid=catrs("intcatalogid") ' get product catalogid
if Not isNull(catalogID) Or catalogid <> "" then 'VP-ASP 6.09 - Check if catalogid is null
psql="select * from products where catalogid=" & catalogid & " and hide=0"
set prs=dbc.execute(psql)
if not prs.eof then
if productcount>=MaxProductPageCount then ' have we exceeded products per page
productcount=0
categoryextensioncount=categoryextensioncount+1
WriteCategoryExtension rs, categorypagecount, objfile, filename, categoryextensioncount
end if
WritecategoryProductrecord objfile, prs 'format it into a record
end if
closerecordset prs ' close product record
end if 'VP-ASP 6.09 - Check if catalogid is null
catrs.movenext ' go to next product
productcount=productcount+1
loop
WritecategoryTrailer objfile ' write trailer for this category
end sub
'****************************************************************************************
' exceeded number of products per category index page
' close the category page
' generate a new file
'***************************************************************************************
sub WriteCategoryExtension (rs, categorypagecount, objfile, filename, categoryextensioncount)
dim serverfilename, url
dim i,msg
Writeline objfile, tabledefend
generatecategoryfilename rs, filename,categoryextensioncount
url=generateurl(filename, getlang("LangNextpage"))
writeline objfile, url
for i = 0 to cattrailercount-1
msg=cattrailers(i)
Writeline objfile, msg
next
objfile.close
set objfile=nothing
categoryfilecount=categoryfilecount+1
CreateCategoryOutputfile rs, filename, objfile, serverfilename, categoryextensioncount
WriteCategoryHeader objfile ' Write template header for this category
end sub
'***************************************************************
' Write start of index file
'*****************************************************************
Sub WriteCategoryHeader (objfile)
dim i, msg
For i = 0 to catheadercount-1
msg=catheaders(i)
Writeline objfile, msg
next
Writeline objfile, tabledef
End Sub
'****************************************************************
' Write 1 line of index file in category record
' It is a hyperlink to product record
'**************************************************************
Sub WritecategoryProductRecord (objfile, prs)
dim msg, filename, cname , url
generateproductfilename prs, filename ' create productfilenmae
cname=prs("cname")
msg=tablerow & tablecolumn
url=generateurl(filename, cname)
msg=msg & url
msg=msg & tablecolumnend & tablerowend
Writeline objfile, msg
end sub
'******************************************************************************
' create aurl based on name and filename
'********************************************************************************
Function Generateurl(filename, description)
dim url, tmpname
tmpname=server.urlencode(filename)
tmpname=filename
url="" & description & ""
generateurl=url
end function
'**********************************************************
' write end of category record index file
'*************************************************************
Sub WriteCategoryTrailer (objfile)
Writeline objfile, tabledefend
dim i,msg
for i = 0 to cattrailercount-1
msg=cattrailers(i)
Writeline objfile, msg
next
end sub
'******************************************************************************
'if a catdescription exists filename= catdesciption_cxxx
'otherwise filename = c_xxx
' xxx is the categoryid
'******************************************************************************
Sub GenerateCategoryfilename (rs, filename,categoryextensioncount)
dim categoryid, catdescription, prefix
categoryid=rs("categoryid")
catdescription=rs("catdescription")
if not isnull(catdescription) then
filename=converttorealname(catdescription)
else
filename="c"
end if
prefix="c" & categoryid
If categoryextensioncount>0 then
prefix=prefix & "e_" & categoryextensioncount
end if
filename=prefix & filename & ".htm"
end sub
'******************************************************************************
' create one record for each Product
'*****************************************************************************
Sub CreateProductRecords
dim sql, objfile, filename, serverfilename, rs
sql="select * from products where hide=0 order by catalogid"
set rs=dbc.execute(sql) ' get all products
do while not rs.eof
CreateProductOutputfile rs, filename, objfile, serverfilename ' create physical file
WriteProductOutputFile rs, filename, objfile ' format using template
objfile.close
set objfile=nothing
handletimeout
filecount=filecount+1 ' count product records created
rs.movenext
loop
closerecordset rs
end sub
'*******************************************************************
' create file in form pxxx.htm
'*****************************************************************
Sub CreateProductOutputfile (rs, filename, objfile, serverfilename)
dim catalogid,objFS, cname, tmpfile
generateproductfilename rs, filename
tmpfile=filename
If generatedirectory<>"" then
serverfilename=generatedirectory & "/" & filename
Else
serverfilename=filename
End if
Set objFS = CreateObject("Scripting.FileSystemObject")
serverfilename = Server.Mappath(serverfilename)
Set objFile = objFS.CreateTextFile(serverfilename)
If Listfiles="Yes" then
response.write "Creating filename=" & filename & "
"
end if
end sub
'******************************************************************************
'if a cname exists filename= cname_xxx
'otherwise filename = pxxxcname
' xxx is the catalogid
'******************************************************************************
Sub GenerateProductfilename (rs, filename)
dim catalogid, cname
catalogid=rs("catalogid")
cname=rs("cname")
if not isnull(cname) then
filename=converttorealname(cname)
else
filename=""
end if
filename="p" & catalogid & filename & ".htm"
end sub
'************************************************************************************
' using a template, create records for product and then write it out
'*************************************************************************************
Sub WriteProductoutputfile (rs, filename, rsfile)
dim template, textarray(1000), textcount
template=generatetemplate
ShopTemplateArray template, rs, textarray, textcount
if textcount=0 then
debugwrite "No records created for " & filename
exit sub
end if
for i = 0 to textcount-1
Writeline rsfile, textarray(i)
next
end sub
Sub Writeline(rsfile, record)
rsfile.WriteLine record
end sub
Sub WriteInfoMessage
msg="
Number of product HTML files created=" & filecount
shopwriteheader msg & "
"
%>
" target="_blank"><%=GenerateIndexfile%>
<%
end sub
'**************************************************************************************
' before we do anything we really meed to know if folder exists and that
' we can write to it.
' This does those checks
'***********************************************************************************
Sub Verifyoutputfile
on error resume next
dim folder
dim serverfilename, objfs, objfile
If generatedirectory<>"" then
serverfilename=generatedirectory & "/" & "test.htm"
Else
serverfilename=filename
End if
Set objFS = CreateObject("Scripting.FileSystemObject")
serverfilename = Server.Mappath(serverfilename)
If generatedirectory <>"" then
If NOT (ReportFolderStatus(Server.Mappath(generatedirectory))) then
serror="Unable to find directory
"
exit sub
end if
End If
Set objFile = objFS.CreateTextFile(serverfilename)
Writeline objfile, "Site Index File"
if err.number<>0 then
serror="Unable Write to directory
"
exit sub
end if
end sub
Function ReportFolderStatus(fldr)
Dim fso, boolExists
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(fldr)) Then
boolExists=True
Else
boolExists=False
End If
Set fso=Nothing
ReportFolderStatus = boolExists
End Function
Sub ShopFileExists(filename, rc)
dim fso, newfile
newfile=server.mappath(filename)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(newfile) Then
rc=0
else
rc=4
end if
set fso=nothing
end sub
Sub SetDefaults
Generatedirectory=Getconfig("xstatichtmldirectory")
If generatedirectory="" then
generatedirectory="html"
end if
generatetemplate=Getconfig("xstaticHTMLtemplate")
if generatetemplate="" then
generatetemplate="tmp_generate.htm"
end if
generateIndexFile=Getconfig("xstaticHTMLIndexfile")
If GenerateIndexfile="" then
GenerateIndexfile="index.htm"
end if
end sub
'************************************************************************************
' categories have two templates. These are read into arrays catheaders and cat trailers
' This saves lots of time rereading them
'*************************************************************************************
Sub GetCatHeaders
dim filename
dim parsearray(50)
filename=catheaderfile
ShopReadEntireFile Filename, catheaders, catheadercount, parsearray
'debugwrite "catheadercount=" & catheadercount
filename=cattrailerfile
ShopReadEntireFile Filename, cattrailers, cattrailercount, parsearray
'debugwrite "cattrailercount=" & cattrailercount
end sub
'********************************************************************************
' there are two possible delete buttons. Delete and deleteconfirm
' delete is a first time request
'delete confirm is a second confirmmation
'*********************************************************************************
Sub HandleDeletes (rc)
rc=0
If allowDeletes<>"Yes" then exit sub
dim deleterequest, deleteconfirm
deleterequest=request("delete")
if deleterequest="" then
deleterequest=request("delete.x")
end if
deleteconfirm=request("deleteconfirm")
if deleteconfirm="" then
deleteconfirm=request("deleteconfirm.x")
end if
if deleterequest<>"" then
PerformDeleteRequest ' first time, write a confirm request
rc=4
else
if deleteconfirm<>"" then
PerformDeleteconfirm ' confirmed, delete the files
end if
end if
end sub
'*****************************************************************************************
' merchant wants files deleted, we ask him a question to make sure it really should be done
' add hidden files of folder
'*****************************************************************************************
Sub PerformDeleteRequest
dim msg
Generatedirectory=TRIM(Request.Form("txtgeneratedirectory"))
generatedisplayheader getlang("LangOrderDeleteRecords")
generatedisplaybodyheader
response.write ""
Shopwriteheader getlang("LangOrderDeleteRecords")
Response.Write("")
response.write ""
generatedisplaybodyfooter
end sub
'******************************************************************************************
' Merchnat has confirmed delete. Now do it
'***************************************************************************************
Sub PerformDeleteConfirm
If allowDeletes<>"Yes" then exit sub
dim files, extension
extension="*.htm"
Generatedirectory=TRIM(Request.Form("txtgeneratedirectory"))
if generatedirectory="" then
serror = serror & getlang("Langgeneratedirectory") & "
"
end if
If serror<>"" then
sError = sError & getlang("LangCustRequired") & "
"
exit sub
End if
'Turn off error handling
'On Error Resume Next
'Create an instance of the FileSystemObject
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
files=server.mappath(generatedirectory) & "\" & extension
shopwriteheader "Deleting " & files
'Delete the file
objFSO.DeleteFile(files)
set objfso=nothing
End Sub
'************************************************************************
' take the name and remove blanks, quotes and html
'***********************************************************************
function converttorealname(name)
dim newname,CR
newname=name
CR=""
newname=replace(newname," ","")
newname=replace(newname,"'","")
newname=replace(newname,"&","and")
newname=replace(newname,"/"," ")
newname=replace(newname,","," ")
newname=replace(newname,"""","")
newname=replace(newname,":","")
newname=replace(newname,";","")
newname=replace(newname,chr(10),"")
newname=replace(newname,chr(13),"")
'VP-ASP 6.09 - extra escape characters
newname=replace(newname,".","")
newname=replace(newname,"\","")
newname=replace(newname,"<","")
newname=replace(newname,">","")
newname=replace(newname,"-","")
newname=replace(newname,"*","")
newname=replace(newname,"?","")
newname=removehtmlfileio(newname,CR)
converttorealname=newname
end function
'**********************************************************************************************
' need browser to do something to avoid timing out
'*********************************************************************************************
Sub HandleTimeout
closecount=closecount+1
if closecount>= 100 then
closecount=0
response.flush
Server.ScriptTimeout = 3600
end if
If Listfiles="Yes" then exit sub
f=f+1
IF f>200 then
f=0
Response.Write("
")
end if
if ((f mod 5) = 0) then
Response.Write(".")
Response.Flush
end if
end sub
%>