<%OPTION EXPLICIT%>
<%
shopcheckadmin ""
'*****************************************************************************
' Version 6.50 Generate static html for one product
'
' Directory Exists Error Checking
' Dec 5, 2006 hk created
'*****************************************************************************
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="No" ' Yes or No
dim rc ' used for handling deletes
dim msg ' work area
Dim generatedindex ' index nmae default=index.htm
Dim Generatedirectory ' folder default html
Dim generatetemplate ' product template tmp_generate.htm
dim dbc ' database connection
dim rs
dim i
dim filename
dim filecount ' count of files created
dim saction ' form actions
dim f, closecount ' used for timeout handling
dim which
dim displayfilename
'*******************************************************************
' see if anything entered on form
' If yes create the HTML files
'*********************************************************************
adminpageheader ' write page header
which=request("which")
saction=request("saction")
If saction="" then
saction=request("saction.x")
end if
if which="" then
shopwriteerror "Missing product catalogid"
else
if not isnumeric(which) then
shopwriteerror "Missing product catalogid"
end if
end if
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 "Generate Product 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"))
Generatedirectory=TRIM(Request.Form("txtgeneratedirectory"))
if generatetemplate="" then
serror = serror & getlang("LangProductTemplate") & "
"
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
CreateProductRecords ' generfate product records
shopclosedatabase dbc ' close database
WriteInfoMessage ' describe what we have done
%><%
generatedisplaybodyfooter
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
'******************************************************************************
' create one record for each Product
'*****************************************************************************
Sub CreateProductRecords
dim sql, objfile, filename, serverfilename, rs
sql="select * from products where catalogid=" & which
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
response.write "" & getlang("langcommonview") & "
"
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
Displayfilename=serverfilename
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)
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 & "
"
response.write ""
response.write ""& getlang("langcommoncontinue") & "
" & vbcrlf
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
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
%>