用XML组件生成静态首页

【 tulaoshi.com - Web开发 】

　　第 1 页 利用Msxml2.ServerXMLHTTP抓取网页内容
　　第 2 页 用ADODB.Stream将抓取内容写入文件
　　第 3 页 具体的举一个例子
　　了解asp的人应该都知道asp是一种解释执行的脚本程序语言,而脚本程序的执行效率往往都是很低的,如果站点的访问量相对较高的话服务器就会非常消耗资源,表现的结果就是站点访问速度急速下降.解决的方法,除了优化程序提高执行效率,还有一个方法就是将网站内的访问量大的页面定时的生成静态html文件,这样可以非常有效的解决访问速度问题,当然前提是你的服务器速度也要不是很慢了,不然怎么弄都是没有效果的. 　　下面我介绍一种利用Msxml2.ServerXMLHTTP组件来抓取您所要生成静态的网页,然后再利用fso,或者ado来写入文件的一种方法,需要注意的是本文例子全部采用utf-8编码,如果改为gb2312需要做相应属性的修改! 先给处下面的函数:
　　!--'相关问题可访问http://school.cnd8.com

　　Function GetURL(URL)
　　'下载主函数
　　const TimeInterval=60
　　'设定时间间隔
　　'如果下载时间很慢，就写成120秒
　　'Response.LCID=2052
　　const lResolve=6
　　'解析域名超时时间,秒
　　const lConnect=6
　　'连接站点超时时间,秒
　　const lSend=6
　　'发送数据请求超时时间,秒
　　const lReceive=40
　　'下载数据超时时间,秒
　　on error resume Next
　　Dim http
　　Set http = Server.CreateObject("Msxml2.ServerXMLHTTP")
　　http.setTimeouts lResolve*1000,lConnect*1000,lSend*1000,lReceive*1000
　　http.Open "GET",URL,False
　　http.Send
　　Select Case http.readyState
　　Case 0
　　GetURL="对象初始化失败"
　　Err.Clear
　　set http=nothing
　　Exit Function
　　Case 1
　　GetURL="域名分析超时/连接站点超时"
　　Err.Clear
　　set http=nothing
　　Exit Function
　　Case 2
　　GetURL="发送数据请求超时,是不是服务器出故障了"
　　Err.Clear
　　set http=nothing
　　Exit Function
　　Case 3
　　GetURL="数据下载超时/等待反馈时间超时"
　　Err.Clear
　　set http=nothing
　　Exit Function
　　Case 4
　　'下载成功
　　End Select
　　If http.status200  then
　　GetURL="下载失败"&Err.description
　　Err.Clear
　　set http=nothing
　　Exit Function
　　END IF
　　If http.status="200" then
　　GetURL=http.ResponseText
　　'GetURL=SaveFile()
　　End If
　　set http=nothing
　　End Function
　　--

　　
　　主要功能是抓取地址参数的网页文件的内容　　使用方法varia=GetURL("http://school.cnd8.com"),如果是本地测试地址可以写成http://localhost/default.asp 　　使用此函数需要注意的是Response.LCID=2052属性在windows server 2000下不被支持,不过问题不大只要注释掉即可正常使用! 　　还有一些超时属性可以根据需要自定义,但注意不要设置的时间太短,否则如果文件大或者地址访问速度较慢就容易抓取失败! 这让我们就可以利用此函数来抓取你想要生成的网页文件内容了.将内容存入变量,等着写入文件吧!

　　
　　下面给出这个类,用来将刚刚利用函数抓取的内容写入相应文件,这样就大功告成了! 直接生成你所要生成的网页吧,非常方便而且不用修改原来的文件!

　　Class Htmlmaker

　　'相关问题请参看 http://school.cnd8.com
　　'/*************************
　　'/ 属性设置说明

　　'/ foldename "文件夹名"
　　'/ 如果不设置,将自动生成[年月日]时间格式的文件夹名

　　'/ Filename "文件名"(含前后缀)
　　'/ 如果不设置,将自动生成[时分秒]时间格式的文件名,后缀为.html

　　'/ Htmlstr "生成的代码内容"
　　'/*************************

　　
　　Private HtmlFolder,HtmlFilename,HtmlContent

　　Public property let foldename(str)
　　HtmlFolder=str
　　End property

　　Public property let Filename(str)
　　HtmlFilename=str
　　End property

　　Public property let Htmlstr(str)
　　HtmlContent=str
　　End property

　　'/*************************
　　'/ 文件名转换日期函数
　　'/*************************

　　    Private Function Datename1(timestr)
　　        dim s_year,s_month,s_day
　　        s_year=year(timestr)
　　        if len(s_year)=2 then s_year="20"&s_year
　　        s_month=month(timestr)
　　        if s_month10 then s_month="0"&s_month
　　        s_day=day(timestr)
　　        if s_day10 then s_day="0"&s_day
　　        Datename1=s_year & s_month & s_day
　　    End Function

　　    Private Function Datename2(timestr)
　　        dim s_hour,s_minute,s_ss
　　        s_hour=hour(timestr)
　　        if s_hour10 then s_hour="0"&s_hour
　　        s_minute=minute(timestr)
　　        if s_minute10 then s_minute="0"&s_minute
　　        s_ss=second(timestr)
　　        if s_ss10 then s_ss="0"&s_ss
　　        Datename2 = s_hour & s_minute & s_ss
　　    End Function

　　'/*************************
　　'/ 初试化
　　'/*************************

　　    Private Sub class_initialize()
　　        HtmlFolder=Datename1(now)
　　        HtmlFilename=Datename2(now)&".html"
　　        HtmlC
　　    End Sub

　　    Private Sub class_terminate()
　　    End Sub

　　
　　'/*************************
　　'/ Html文件生成
　　'/*************************

　　    Public Sub Htmlmake()
　　    '    On Error Resume Next
　　        dim filepath,fso,fout
　　        filepath = HtmlFolder&"/"&HtmlFilename
　　        Set fso = Server.CreateObject("Scripting.FileSystemObject")
　　        If fso.FolderExists(Server.MapPath(HtmlFolder)) Then
　　        Else
　　        fso.CreateFolder(Server.MapPath(HtmlFolder))
　　        End If
　　    '    Set fout = fso.CreateTextFile(Server.MapPath(filepath),true)
　　    '    fout.WriteLine HtmlContent
　　    '    fout.close
　　        dim objFSO,adTypeText,adSaveCreateOverWrite,Charsett,objAdoStream
　　        Charsett = "utf-8"
　　        set objAdoStream = Server.CreateObject("ADODB.Stream")
　　        adTypeText  = 2
　　        adSaveCreateOverWrite = 2
　　        objAdoStream.Type = adTypeText
　　        objAdoStream.Open
　　        objAdoStream.Charset = Charsett
　　        objAdoStream.WriteText(HtmlContent)
　　        objAdoStream.SaveToFile Server.MapPath(filepath),2
　　        objAdoStream.Close
　　    End Sub

　　'/*************************
　　'/ Html文件删除
　　'/*************************

　　
　　    Public Sub Htmldel()
　　    dim filepath,fso
　　    filepath = HtmlFolder&"/"&HtmlFilename
　　    Set fso = CreateObject("Scripting.FileSystemObject")
　　    if fso.FileExists(Server.MapPath(filepath)) then
　　        fso.DeleteFile(Server.mappath(filepath))
　　    end if
　　    Set fso = nothing
　　    End Sub

　　End class

　　
　　下面为了让大家更好的学习给出具体的举一个实例:

　　我们有一个网站地址是 http://school.cnd8.com/

　　我们要将其首页也就是default.asp生成静态的htm文件

　　我们先建立个文件:makeindex.asp

　　!--#include file="function_class.asp"--
　　%
　　dim indexhtmlstr
　　indexhtmlstr=GetURL("http://school.cnd8.com/default.asp")
　　dim indexfilename
　　indexfilename="index.htm"
　　dim actionstat
　　if len(indexhtmlstr) 200 then
　　    acti&indexfilename&"文件时遇到"&indexhtmlstr&"错误"
　　else
　　    dim myhtml
　　    set myhtml= new Htmlmaker
　　    myhtml.foldename = "../.."
　　    myhtml.Filename = indexfilename
　　    myhtml.Htmldel
　　    myhtml.Htmlstr = indexhtmlstr
　　    myhtml.Htmlmake
　　    set myhtml=nothing
　　    acti&indexfilename&"文件"
　　end if
　　response.write actionstat
　　%

　　
　　文件function_class.asp的内容主要包括前面给出的函数和生成文件的类就可以了!
　　运行makeindex.asp就可以生成htm文件了!