<%
' Page Generator 1.04 (Excel Version)
' !required file: article.settings.xml
' =won't try to make blank files now
blnRun = false
if blnRun = false then response.End 'when not in use do not allow script to be run
'START [functions]
Function ArrayPosition(value,arrayname)
fn_return = -1
if IsArray(arrayname) then
for fnc_count = 0 to ubound(arrayname)
if lcase(value) = lcase(arrayname(fnc_count)) then
fn_return = fnc_count
exit for
end if
next
end if
ArrayPosition = fn_return
End Function
Function MatchRegExp(byVal strText, byVal strPattern, byVal blnIgnoreCase, byVal blnGlobal)
Set re = new RegExp
With re
.Pattern = strPattern
.IgnoreCase = blnIgnoreCase
.Global = blnGlobal
End With
Set MatchRegExp = re.Execute(strText)
set re = nothing
End Function
Function IsRegExp(byVal strText, byVal strPattern, byVal blnIgnoreCase, byVal blnGlobal)
Set re = new RegExp
With re
.Pattern = strPattern
.IgnoreCase = blnIgnoreCase
.Global = blnGlobal
End With
IsRegExp = re.Test(strText)
set re = nothing
End Function
Function CarriageR(strText)
useText = strText
if NOT IsNull(useText) then carriageR = replace(replace(replace(useText,vbCrLf,"
"),vbLf,"
"),vbCr,"
")
End Function
Function isEmpty(byVal tmpVar)
select case VarType(tmpVar)
case 0, 1 'empty & null
isEmpty = true
case 8 'string
if len(tmpVar) = 0 then isEmpty = true
case 9 'object
tmpType = TypeName(tmpVar)
if tmpType = "Nothing" or tmpType = "Empty" then isEmpty = true
end select
End Function
Function readExl(strItem)
tmpItem = trim(strItem)
if isEmpty(tmpItem) then tmpItem = ""
readExl = tmpItem
End Function
Function addText(byVal build_text, byVal add_text, byVal seperator, byVal position)
if add_text <> "" then
if seperator <> "" then
select case position
case 0 'add seperator to end [when exists] / content to end
if build_text <> "" then add_text = add_text & seperator
case 1 'add seperator to start [when exists] / content to end
if build_text <> "" then add_text = seperator & add_text
case 2 'add seperator to start [always] / content to end
add_text = seperator & add_text
case 3 'add seperator to end [when exists] / content to start
if build_text <> "" then add_text = add_text & seperator
end select
end if
select case position
case 3
build_text = add_text & build_text
case else
build_text = build_text & add_text
end select
end if
addText = build_text
End Function
'END [functions]
'On Error Resume Next '[errortrap;notinuse]
'[declarations]
dim ary_importhead()
dim ary_import()
dim ary_codevalue()
dim ary_codenovalue()
dim ary_datacontent() : redim ary_datacontent(-1)
'[initializations]
folder_root = Server.MapPath(".") 'fixed site root folder
site_domain = "http://" & lcase(request.ServerVariables("SERVER_NAME"))
logFile = "_imp_article-log.txt"
conLOG = folder_root & "\" & logFile
dateNow = date()
adOpenStatic = 3
adLockReadOnly = 1
blnError = false
count_total = 0
'[settings]
file_settings = folder_root & "\" & "_article.settings.xml"
set objFS = Server.CreateObject("Scripting.FileSystemObject")
'open log file
set objTF = objFs.OpenTextFile(conLOG,2,True)
objTF.Writeline("Time Started: " & now())
'read in settings
if NOT objFS.FileExists(file_settings) then
objTF.Writeline("Error: Settings File " & file_settings & " Not Found")
blnError = true
else
Set objXML = Server.CreateObject("MSXML2.DOMDocument.3.0")
objXML.async = False
objXML.load(file_settings)
Set rootNode = objXML.documentElement
Set Node = rootNode.selectSingleNode("settings")
file_data = folder_root & "\" & Node.selectSingleNode("datafile").Text
file_outdata = folder_root & "\" & Node.selectSingleNode("exportdata").Text
file_outsitemap = folder_root & "\" & Node.selectSingleNode("exportsitemap").Text
set objXML = nothing
end if
response.Write file_data & "_file_data"
response.Write "
" & conLOG & "_conLOG"
response.Write "
" & file_outdata & "_file_outdata"
response.Write "
" & file_outsitemap & "_file_sitemap"
response.Write "
settings:" & file_settings
response.Write "
folder_root:" & folder_root
'test if import file exists before running
if NOT objFS.FileExists(file_data) then
objTF.Writeline("Error: Import File " & file_data & " Not Found")
blnError = true
end if
if blnError = false then
Set cnnExcel = Server.CreateObject("ADODB.Connection")
cnnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & file_data & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";" 'HDR:Header = No;IMEX:Driver = 1 (Import Mode/Force as text)
Set rstExcel = Server.CreateObject("ADODB.Recordset")
rstExcel.Open "SELECT * FROM [IQImport$];",cnnExcel,adOpenStatic,adLockReadOnly
'data export
if objFS.FileExists(file_outdata) then
set objXMLF = objFs.OpenTextFile(file_outdata,1)
inp_content = objXMLF.ReadAll
objXMLF.close
set objXMLF = nothing
ary_tmpdatacontent = split(inp_content,vbCrLf)
for tmp_count = 4 to ubound(ary_tmpdatacontent)
tmp_line = replace(ary_tmpdatacontent(tmp_count),vbTab,"")
blnFileExist = false
if NOT isEmpty(tmp_line) and instr(1,tmp_line,"") = 0 and instr(1,tmp_line,"") = 0 then
set objMatch = MatchRegExp(tmp_line,".+",True,False)
if objMatch.Count > 0 Then
for each item in objMatch
tmp_item = replace(replace(mid(item.Value,6,len(item.Value)-11),"://",""),"/","\")
idx_find = instr(1,tmp_item,"\")
tmp_item = mid(tmp_item,idx_find)
if objFS.FileExists(folder_root & tmp_item) then
blnFileExist = true
exit for
end if
next
end if
if blnFileExist = true then
redim preserve ary_datacontent(ubound(ary_datacontent)+1)
ary_datacontent(ubound(ary_datacontent)) = tmp_line
else
objTF.Writeline("Error: Existing Data File Not Found: " & tmp_item)
end if
end if
next
end if
'sitemap export '[notinuse: havent updated sitemap export to support updates like data export]
'set objSMF = objFs.OpenTextFile(file_outsitemap,2,True)
'objSMF.Writeline("")
'objSMF.Writeline("")
'objSMF.Writeline("")
'objSMF.Writeline("" & site_domain & "/")
'objSMF.Writeline("" & dateNow & "")
'objSMF.Writeline("monthly")
'objSMF.Writeline("0.5")
'objSMF.Writeline("")
serverTimeout = server.ScriptTimeout
server.ScriptTimeout = 3000
'read in headings
imp_countcolumn = rstExcel.Fields.Count-1
response.Write "
IMPORT FIELD COUNT: " & imp_countcolumn
redim ary_importhead(imp_countcolumn)
for tmp_count = 0 to imp_countcolumn
ary_importhead(tmp_count) = readExl(rstExcel.Fields.Item(tmp_count).Value)
response.write "
Header: " & ary_importhead(tmp_count)
next
rstExcel.MoveNext
response.Write "
"
'START import main loop
redim ary_import(imp_countcolumn)
do while NOT rstExcel.EOF
for tmp_count = 0 to imp_countcolumn
ary_import(tmp_count) = readExl(rstExcel.Fields.Item(tmp_count).Value)
next
if NOT isEmpty(ary_import(ArrayPosition("filename",ary_importhead))) then
'START [section: create folders]
folder_input = replace(ary_import(ArrayPosition("path",ary_importhead)),"/","\")
ary_folder = split(folder_input,"\")
tmp_folder = ""
for tmp_count = 0 to ubound(ary_folder)
if NOT isEmpty(ary_folder(tmp_count)) then
tmp_folder = addText(tmp_folder,trim(ary_folder(tmp_count)),"\",1)
folder_make = folder_root & "\" & tmp_folder
if NOT objFS.FolderExists(folder_make) then objFS.CreateFolder(folder_make)
end if
next
folder_input = tmp_folder
if folder_input <> "" then folder_input = "\" & folder_input
'END [section]
'START [section: create static page from template and dynamic content]
file_template = folder_root & "\" & ary_import(ArrayPosition("template",ary_importhead))
file_create = folder_root & folder_input & "\" & ary_import(ArrayPosition("filename",ary_importhead))
response.Write "
NEW FILE"
response.Write "
template:" & file_template
response.Write "
file_create:" & file_create
if objFS.FileExists(file_template) then
out_content = ""
count_markervalue = -1
count_markernovalue = -1
redim ary_codevalue(2,count_markervalue)
redim ary_codenovalue(count_markernovalue)
'create array of values to change
Set objXML = Server.CreateObject("MSXML2.DOMDocument.3.0")
objXML.async = False
objXML.load(file_settings)
Set rootNode = objXML.documentElement
Set NodeList = rootNode.selectSingleNode("articlecodes").selectNodes("code")
return_size = (NodeList.length)
for tmp_count = 0 to return_size-1
tmp_code = ""
tmp_field = ""
tmp_field_secondary = ""
tmp_markwithid = ""
if NOT isEmpty(NodeList.Item(tmp_count).selectSingleNode("tag")) then tmp_code = NodeList.Item(tmp_count).selectSingleNode("tag").Text
if NOT isEmpty(NodeList.Item(tmp_count).selectSingleNode("field")) then tmp_field = NodeList.Item(tmp_count).selectSingleNode("field").Text
if NOT isEmpty(NodeList.Item(tmp_count).selectSingleNode("fieldsecondary")) then tmp_field_secondary = NodeList.Item(tmp_count).selectSingleNode("fieldsecondary").Text
if NOT isEmpty(NodeList.Item(tmp_count).selectSingleNode("markwithid")) then tmp_markwithid = NodeList.Item(tmp_count).selectSingleNode("markwithid").Text
if NOT isEmpty(tmp_code) and NOT isEmpty(tmp_field) then
tmp_value = ""
if NOT isEmpty(tmp_field) then
if NOT isEmpty(ary_import(ArrayPosition(tmp_field,ary_importhead))) then tmp_value = ary_import(ArrayPosition(tmp_field,ary_importhead))
end if
if isEmpty(tmp_value) then
if NOT isEmpty(tmp_field_secondary) then
if NOT isEmpty(ary_import(ArrayPosition(tmp_field_secondary,ary_importhead))) then tmp_value = ary_import(ArrayPosition(tmp_field_secondary,ary_importhead))
end if
end if
if NOT isEmpty(tmp_value) then
'save code with content for template swapping
count_markervalue = count_markervalue +1
redim preserve ary_codevalue(2,count_markervalue)
ary_codevalue(0,count_markervalue) = tmp_code
ary_codevalue(1,count_markervalue) = tmp_value
ary_codevalue(2,count_markervalue) = tmp_markwithid
else
'save code without content to erase non-used tags
count_markernovalue = count_markernovalue + 1
redim preserve ary_codenovalue(count_markernovalue)
ary_codenovalue(count_markernovalue) = tmp_code
end if
end if
next
set objXML = nothing
Set objTSR = objFS.OpenTextFile(file_template, 1, False) 'open template file for reading
Set objTSW = objFS.OpenTextFile(file_create, 2, True) 'open create file for writing
do until objTSR.AtEndOfStream
template_readln = objTSR.readline
template_writeln = ""
if left(trim(template_readln),1) <> ";" then
template_writeln = template_readln
for tmp_count = 0 to ubound(ary_codevalue,2)
tmp_replace = carriageR(ary_codevalue(1,tmp_count))
if ary_codevalue(2,tmp_count) <> "" then tmp_replace = "" & tmp_replace & ""
template_writeln = Replace(template_writeln,ary_codevalue(0,tmp_count),tmp_replace,1,-1,0)
next
end if
if template_writeln <> "" then out_content = AddText(out_content,template_writeln,vbCrLf,1)
loop
out_content = AddText(out_content,"",vbCrLf,1)
if NOT isEmpty(out_content) then
'remove any remaining tags before saving
if ubound(ary_codenovalue) > -1 then
for tmp_count = 0 to ubound(ary_codenovalue)
out_content = Replace(out_content,ary_codenovalue(tmp_count),"",1,-1,0)
next
end if
objTSW.Write(out_content)
end if
objTSW.close
set objTSW = nothing
objTSR.close
set objTSR = nothing
objTF.Writeline("Action: Created File " & file_create) 'write statements to log
'data export
tmp_url = site_domain & replace(folder_input,"\","/") & "/" & ary_import(ArrayPosition("filename",ary_importhead))
if ArrayPosition("title",ary_importhead) > -1 then tmp_name = ary_import(ArrayPosition("title",ary_importhead))
if isEmpty(tmp_name) then tmp_name = tmp_url
'check if item already exists
tmp_itemnew = "" & server.HTMLEncode(tmp_url) & "" & server.HTMLEncode(tmp_name) & ""
blnFoundMatch = false
for tmp_count = 0 to ubound(ary_datacontent)
tmp_itemon = ary_datacontent(tmp_count)
'if the url matches replace content and do not add as new item
if instr(1,tmp_itemon,"" & tmp_url & "") > 0 then
ary_datacontent(tmp_count) = tmp_itemnew
blnFoundMatch = true
exit for
end if
next
'if item not matched add to end of list
if blnFoundMatch = false then
redim preserve ary_datacontent(ubound(ary_datacontent)+1)
ary_datacontent(ubound(ary_datacontent)) = tmp_itemnew
end if
'sitemap export
'objSMF.Writeline("")
'objSMF.Writeline("" & site_domain & replace(folder_input,"\","/") & "/" & ary_import(ArrayPosition("filename",ary_importhead)) & "")
'objSMF.Writeline("" & dateNow & "")
'objSMF.Writeline("monthly")
'objSMF.Writeline("0.5")
'objSMF.Writeline("")
count_total = count_total + 1
else
objTF.Writeline("Error: Template File " & file_template & " Not Found")
end if
'END [section]
end if
response.Flush
rstExcel.MoveNext
Loop
'END import main loop
rstExcel.Close
cnnExcel.Close
Set rstExcel = Nothing
Set cnnExcel = Nothing
'data export
if ubound(ary_datacontent) > -1 then
set objXMLF = objFs.OpenTextFile(file_outdata,2,True)
objXMLF.Writeline("")
objXMLF.Writeline("")
objXMLF.Writeline(vbTab & "" & now() & "")
objXMLF.Writeline(vbTab & "")
for tmp_count = 0 to ubound(ary_datacontent)
objXMLF.Writeline(vbTab & vbTab & ary_datacontent(tmp_count))
next
objXMLF.Writeline(vbTab & "")
objXMLF.Writeline("")
objXMLF.close
set objXMLF = nothing
end if
response.Write "
"
response.Write "
"
response.Write vbCrLf
response.Write vbCrLf
'sitemap export
'objSMF.Writeline("")
'objSMF.close
'set objSMF = nothing
server.ScriptTimeout = serverTimeout
end if
objTF.Write("Time Finished: " & now())
objTF.close
set objTF = nothing
set objFS = nothing
response.Write "Files Created: " & count_total
response.Flush
response.End
%>