<% ' Site Map Generator 1.02 (Excel Version) ' [note: changed [fixed] items on page] ' !required file: article.settings.xml ' +added default template if not set 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() '[initializations] folder_root = Server.MapPath(".") 'fixed site root folder site_domain = "http://" & lcase(request.ServerVariables("SERVER_NAME")) blnError = false '[settings] file_settings = folder_root & "\" & "_article.settings.xml" '[requests] file_outsitemap = request.QueryString("sitemap") file_template = request.QueryString("template") 'file_template = folder_root & "\" & request.QueryString("template") if file_outsitemap = "" then file_outsitemap = "sitemap.htm" if file_template = "" then file_template = folder_root & "\_article.setting-template_sitemap.htm" else file_template = folder_root & "\" & file_template end if set objFS = Server.CreateObject("Scripting.FileSystemObject") 'read in settings if NOT objFS.FileExists(file_settings) then response.write("
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("exportdata").Text set objXML = nothing end if 'test if import file exists before running if NOT objFS.FileExists(file_data) then response.write("
Error: Data File " & file_data & " Not Found") blnError = true end if response.Write file_data & "_file_data" response.Write "
" & file_outsitemap & "_file_outsitemap" response.Write "
" & file_template & "_file_template" response.Write "
settings:" & file_settings response.Write "
folder_root:" & folder_root response.Write "
" if blnError = false then serverTimeout = server.ScriptTimeout server.ScriptTimeout = 3000 'read in headings imp_countcolumn = 10 redim ary_importhead(imp_countcolumn) ary_importhead(0) = "Filename" ary_importhead(1) = "Template" ary_importhead(2) = "Domain" ary_importhead(3) = "Path" ary_importhead(4) = "Meta Title" ary_importhead(5) = "Meta Keywords" ary_importhead(6) = "Meta Description" ary_importhead(7) = "Title" ary_importhead(8) = "Sub Title" ary_importhead(9) = "Body" ary_importhead(10) = "Site Name" 'START import main loop redim ary_import(imp_countcolumn) ary_import(0) = file_outsitemap ary_import(1) = file_template ary_import(2) = site_domain ary_import(3) = "/" ary_import(4) = "Site Map" ary_import(5) = "Site Map" ary_import(6) = "Site Map" ary_import(7) = "Site Map" ary_import(8) = "" ary_import(10) = "Toronto Salmon Charter Fishing on Lake Ontario" '[fixed] Set objXML = Server.CreateObject("MSXML2.DOMDocument.3.0") objXML.async = False objXML.load(file_data) Set rootNode = objXML.documentElement Set NodeList = rootNode.selectSingleNode("data").selectNodes("url") return_size = (NodeList.length) tmp_body = "" for tmp_count = 0 to return_size-1 tmp_field = "" tmp_field_secondary = "" tmp_name = NodeList.Item(tmp_count).selectSingleNode("name").Text tmp_url = NodeList.Item(tmp_count).selectSingleNode("loc").Text if NOT isEmpty(tmp_name) and NOT isEmpty(tmp_url) then tmp_body = addText(tmp_body,"" & tmp_name & "","
",1) end if next set objXML = nothing ary_import(9) = tmp_body folder_input = "" 'START [section: create static page from template and dynamic content] 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(1,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") code_size = (NodeList.length) for tmp_count = 0 to code_size-1 tmp_code = "" tmp_field = "" tmp_field_secondary = "" 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(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(1,count_markervalue) ary_codevalue(0,count_markervalue) = tmp_code ary_codevalue(1,count_markervalue) = tmp_value 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) template_writeln = Replace(template_writeln,ary_codevalue(0,tmp_count),carriageR(ary_codevalue(1,tmp_count)),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 response.write("
Action: Created File " & file_create) 'write statements to log else response.Write("
Error: Template File " & file_template & " Not Found") end if 'END [section] server.ScriptTimeout = serverTimeout end if response.Flush response.End %>