≮崩溃≯不劳阁,俺的blog纯粹属于好玩,如有雷同 纯属巧合!
25 Jan
1.使用FSO生成
<%
'使用FSO生成
Set fs = CreateObject("Scripting.FileSystemObject")
NewFile=Server.MapPath("ud03/fso.htm")
'新建一文件fso.htm,若该文件已存在,则覆盖它
Set a = fs.CreateTextFile(NewFile, True)
Response.Write"新文件已建立!"
a.close
File=Server.MapPath("ud03/fso.htm")
Set txt=fs.OpenTextFile(File,8,True) '打开成可以在结尾写入数据的文件
data1="这句话是使用WriteLine方法写入的。!<Br>"
txt.WriteLine data1
data2="这句话是使用Write方法写入的。<Br>"
txt.Write data2
txt.Close
%>
2.使用XMLHTTP生成
<%
'使用XMLHTTP生成
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
'把下面的地址替换成你的首页的文件地址,一定要用http://开头的绝对路径,不能写相对路径
xml.Open "GET", " ****(抓取页面) ", False
xml.Send
BodyText=xml.ResponseBody
BodyText=BytesToBstr(BodyText,"gb2312")
Set xml = Nothing
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile= fso.CreateTextFile(server.MapPath("index.htm"), True) '生成的html的文件名
MyFile.WriteLine(BodyText)
MyFile.Close
'使用Adodb.Stream处理二进制数据
Function BytesToBstr(strBody,CodeBase)
dim objStream
set objStream = Server.CreateObject("Adodb.Stream")
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write strBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeBase
BytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End Function
%>
3.使用XMLHTTP批量生成
<%
'使用XMLHTTP批量生成
dim strUrl,Item_Classid,id,FileName,FilePath,Do_Url,Html_Temp
Html_Temp="<UL>"
For i=1 To 30 '需要生成的id:1到30
Html_Temp = Html_Temp&"<LI>"
Item_Classid = i
FileName = "Archives_"&Item_Classid&".htm" '生成的html文件名
FilePath = Server.MapPath("/")&"\"&FileName
Html_Temp = Html_Temp&FilePath&"</LI>"
Do_Url = " ****(抓取页面) " 'WEB路径
Do_Url = Do_Url&"?p="&Item_Classid 'WEB路径之后的ID
strUrl = Do_Url
dim objXmlHttp
set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP")
objXmlHttp.open "GET",strUrl,false
objXmlHttp.send()
Dim binFileData
binFileData = objXmlHttp.responseBody
Dim objAdoStream
set objAdoStream = Server.CreateObject("ADODB.Stream")
objAdoStream.Type = 1
objAdoStream.Open()
objAdoStream.Write(binFileData)
objAdoStream.SaveToFile FilePath,2
objAdoStream.Close()
Next
Html_Temp = Html_Temp&"<UL>"
%>
<%
Response.Write ( "成功生成文件:" )
Response.Write ( "<BR>" )
Response.Write Html_Temp
%>
4.自动按模板生成网站首页
<%
Response.Expires = 0
Response.expiresabsolute = Now() - 1
Response.addHeader "pragma", "no-cache"
Response.addHeader "cache-control", "private"
Response.CacheControl = "no-cache"
Response.Buffer = True
Response.Clear
Server.ScriptTimeOut=999999999
on error resume next
'***************************************************************
'* 定义 从模板从读取首页 函数
'* 说明:模板文件名为:index_Template.asp
'***************************************************************
Function GetPage(url)
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
'***************************************************************
'* 生页首页,文件名为:default.htm
'***************************************************************
dim Tstr
Tstr = GetPage(" ****(抓取页面) ")
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(Server.MapPath(".")&"/default.htm")
fout.Write Tstr
fout.close
Response.write"<script>alert(""生成首页成功!\n\n文件名为:default.htm"");location.href=' ****(返回页面) ' </script>"
Response.end
%>
5.将asp页面转换成htm页面
<%
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=" *****(抓取页面) " '要读取的页面地址
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>"
%>
6.自己经常用的
<%
Function getHttpXML()
Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP")
dim lResolve,lConnect,lSend,lReceive
lResolve = 5*1000
lConnect = 5*1000
lSend = 15*1000
lReceive = 15*1000
Http.setTimeouts lResolve,lConnect,lSend,lReceive
Http.open "POST"," ******(抓取页面) "," false '抓取需要生成html的页面
Http.Send()
if Http.readystate =1 then str1=timer()
if Http.readystate =4 then str2=timer()
if Http.readystate <> 4 then
exit Function
end if
'if Http.readystate =0 then str1=timer()
'getHttpXML=BytesToBstr(Http.responseBody,"utf-8")
getHttpXML=Http.responseBody
'getHttpXML=FormatNumber((str2-str1)/1000,3)
if err.Number<>0 then err.Clear
End Function
'生成文件
Function SaveToFile()
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With objStream
.Type = 1
.Open
.Charset = "utf-8"
.write getHttpXML
.SaveToFile Server.MapPath("index.html"),2
.Close
End With
Set objStream = Nothing
End Function
call SaveToFile()
%>
好东西,收藏了!以后能用上!
谢谢博主分享
好东西
新年快乐,谢谢分享
我想把页面生成静态,去试试
◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。