Give the GooglesItemap function ASP (transferred foreigner)

<%@Language = "VBScript" CodePage = "65001"%>

<%

Response.charset = "UTF-8"

Server.scripttimeout = 50000

'Sitemap_gen.asp

'A SIMPLE SCRIP to Automatical PRODUCE SITEMAPS for a Webserver, in the Google Sitemap Protocol (GSP)

'by FranceSco Passantino

'www.iteam5.net/FranceSco/sitemap

'V0.2 Released 5 June 2005

session ("server") = "http://7thpark.com/" '"Your domain name

VDIR = "/" 'Sitemap directory, relative directory (relative to the root directory)

set objfso = createObject ("scripting.filesystemObject")

root = server.mappath (VDIR)

'Response.contenttype = "Text/XML"

'Response.write "<? Xml Version =' 1.0 'Encoding =' UTF-8 '?>"

'Response.write "<urlset xmlns =' http://www.google.com/schemas/sitemap/0.84 '>"

Str = "<? xml Version = '1.0' Encoding = 'UTF-8'?>" & VBCRLF '

Str = str & "<urlset xmlns = 'http://www.google.com/schemas/sitemap/0.84'>" & vBCRLFFF

Set objfolder = objfso.getFolder (root)

'Response.write getfilelink (objfolder.path, objfolder.dateLastModify)

Set colors = objfolder.files

For Each Objfile in Colfiles

'Response.write getfilelink (objfile.path, objfile.datelastmodify)

Str = Str & GetFileLink (Objfile.Path, Objfile.datelastmodify) & VBCRLF

Next

Showsubfolders (Objfolder)

'Response.write "</urlset>" "

Str = Str & "</urlset>" & vBCrlf

set fSO = Nothing

Set objstream = server.createObject ("adodb.stream")

With objstream

'.Type = adtypetext

'.Mode = admodeReadwrite

.Opeen

.Charset = "UTF-8"

.Position = objstream.size

.Writetext = STR

.Savetofile server.mappath ("/sitmap.xml"), 2' -generated xml file name

.Close

End with

Set objstream = Nothing

If NOT ERR THEN

Response.write (<Script> Alert ('Successful generating site map!'); History.back (); </script> ")

Response.end

End if

Sub showsubfolders (Objfolder)

Set colorders = objfolder.subfolders

For Each Objsubfolder in Colfolders

If FolderPerMission (Objsubfolder.Path) then

'Response.write getfilelink (Objsubfolder.Path, Objsubfolder.datelastmodify)

Str = Str & GetFileLink (Objsubfolder.path, Objsubfolder.dateLastModify) & VBCRLF

Set colors = objsubfolder.files

For Each Objfile in Colfiles

'Response.write getfilelink (objfile.path, objfile.datelastmodify)

Str = Str & GetFileLink (Objfile.Path, Objfile.datelastmodify) & VBCRLF

Next

Showsubfolders (Objsubfolder)

end if

Next

End sub

Function getfilelink (file, dataFile)

file = replace (file, root, "")

file = replace (file, "/", "/")

If fileXTENSIONISBAD (File) then exit function

if Month (datafile) <10d filedatem = "0"

if day (datafile) <10 thatn filedated = "0"

FileDate = Year (DataFile) & "-" & FileDatem & Month (DataFile) & "-" & Filedated & Day (DataFile)

GetfileLink = "<url> <Loc>" & Server.htmlenCode (Session ("Server") & VDIR & File) & "</LOC> <Lastmod>" & FileDate & "</Lastmod> <CHANGEFREQ> DAILY </</ Changefreq> <Priority> 1.0 </priority> </url> ""

Response.flush

End function

Function FolderPerMission (PathName)

'The directory that needs to be filtered (not listed in Sitemap)

Pathexclusion = Aray ("/Temp", "/_ vti_cnf", "_ vti_pvt", "_ vti_log", "cgi-bin", "/admin", "/edu")

FolderPermission = TRUE

For Each Pathexcluded in Pathexclusion

If Instr (UCASE (PATHNAME), UCASE (Pathexcluded))> 0 then

FOLDERPERMISSION = FALSE

exit for

end if

next

End function

Function FileEXTENSIONISBAD (SFILENAME)

DIM SFILEEXTENSION, BFileeXTENSIONISVALID, Sfileext

'Modify for your file extension (http://www.googleguide.com/file_type.html)

Extensions = array ("png", "gif", "jpg", "jpeg", "zip", "pdf", "ps", "html", "htm", "pHP", "wk1", "wk2 wk2" ","wk3","wk4","wk5","wki","wks","wku","lwp","mw","xls","ppt","doc","swf", "WKS", "WPS", "WDB", "WRI", "RTF", "Ans", "TXT")

'Set the file name of the list, if the extension is not among it, Sitemap will not include the file of the extended name