用XML组件生成静态首页

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

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


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

Class Htmlmaker

'相关问题请参看 http://www.pcer.cn
'/*************************
'/ 属性设置说明

'/ 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_month<10 then s_month="0"&s_month
        s_day=day(timestr)
        if s_day<10 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_hour<10 then s_hour="0"&s_hour
        s_minute=minute(timestr)
        if s_minute<10 then s_minute="0"&s_minute
        s_ss=second(timestr)
        if s_ss<10 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"
        HtmlContent=""
    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://www.pcer.cn/default.asp

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

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

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


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

注意本文由backer原创

俺自己网站上发表地址：http://www.pcer.cn/article/document/20063/346035191.asp





<%
Function GetPage(url)
'获得文件内容
dim Retrieval
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
   .Open "Get", url, False ', "", ""
   .Send
   GetPage = BytesToBstr(.ResponseBody)
End With
Set Retrieval = Nothing
End Function


Function BytesToBstr(body)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = "GB2312"
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function


on error resume next
Url="http://要读取的页面地址"    '要读取的页面地址
response.write "开始更新首页..."
wstr = GetPage(Url)


'response.write(wstr)
Set fs=Server.CreateObject("Scripting.FileSystemObject")


'if not MyFile.FolderExists(server.MapPath("/html/")) then
'MyFile.CreateFolder(server.MapPath("/html/"))'
'end if

'要存放的页面地址
dizhi=server.MapPath("index.htm")
If (fs.FileExists(dizhi)) Then
fs.DeleteFile(dizhi)
End If

Set CrFi=fs.CreateTextFile(dizhi)
Crfi.Writeline(wstr)
set CrFi=nothing
set fs=nothing
response.write "...<font color=red>更新完成！</font>"
%>



      代码算是最简单的，直接保存成一个asp文件即可，只要把URL(要转化的asp地址)和dizhi(要保存的html地址)设置好就可以了，一般这两个文件在同一个目录，才能保证图片或者css、js起作用。







<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<meta http-equiv="refresh" content="30;xhtml.asp" />
<!--<meta http-equiv="refresh" content="30;xhtml.asp" />这一段是自动刷新-->
<title>生成首页</title>
</head>

<body>
<%server.ScriptTimeout=900%>
<%
'常用函数
'1、输入url目标网页地址，返回值getHTTPPage是目标网页的html代码
function getHTTPPage(url)
dim Http
set Http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
if err.number<>0 then err.Clear
end function

'2、转换乱玛，直接用xmlhttp调用有中文字符的网页得到的将是乱玛，可以通过adodb.stream组件进行转换 Chinaz.com

Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
txtURL=server.MapPath("embed_index_xhtml.asp")
sText = getHTTPPage(txtURL)
Set FileObject=Server.CreateObject("Scripting.FileSystemObject")
filename="xhtml.htm"
Set openFile=FileObject.OpenTextfile(server.mapPath(filename),2,true) 'true为不存在自行建立
openFile.writeline(sText)
Set OpenFile=nothing
%>
<script>
alert("静态网页生成完毕");
history.back();
</script>

文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志: