asp快速生成靜態頁面一個方法(不用模板)
發布時間:2013/6/14 14:10:19 作者: 閱讀:1352
廣告:
判斷是否真正靜態頁:javascript:alert(document.lastModified) (地址欄輸入)
生成真正靜態頁:
<%
dim haodomain
haodomain="http://127.0.0.1"
function getHTTPPage(url)
dim http
On Error Resume Next
set http=server.createobject("MSXML2.ServerXMLHTTP")
'------------------------------------------------------------
lresolveTimeout = 20000 ' 解析DNS名字的超時時間,20秒
lconnectTimeout = 20000 ' 建立Winsock連接的超時時間,20秒
lsendTimeout = 20000 ' 發送數據的超時時間,20秒
lreceiveTimeout = 30000 ' 接收response的超時時間,30秒
http.setTimeouts lresolveTimeout,lconnectTimeout,lsendTimeout,lreceiveTimeout
'可用這句替代 http.setTimeouts(20000,20000,20000,20000)
http.open "POST",url,false 'url為絕對路徑
'http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'http.setRequestHeader "CONTENT-TYPE","text/html"
'http.setRequestHeader "Charset", "gb2312"
http.send()
if Http.readystate<>4 then
response.write "失敗"
response.end
exit function
end if
if http.status <> 200 then
response.write "采集網頁失敗!"
response.end
end if
'以下為測試信息------------------------------------
'response.write http.statusText
'response.contenttype = "text/html"
'Response.Write Http.responseBody
'response.end
'Response.Write http.responsexml.xml 'responseStream 'responsetext'responsexml
'完-------------------------------
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
if err.number<>0 then err.Clear
end function
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
'老的函數,沒用
'Function GetBody(url)
'on error resume next
'Set Retrieval = CreateObject("Microsoft.XMLHTTP")
'Retrieval.Open "post", url, False, "",""
'Retrieval.Send
'GetBody =Retrieval.responsebody
'Set Retrieval = Nothing
'End Function
'老的函數,沒用
dim body1
dim urlhao
dim body2
dim usl1
dim filename
dim body3
url1=http://www.cha600.com/
filename="index.asp"
filename2="index.htm"
targetfile=server.mappath("/make/index.htm") '此處為物理路徑
body2=getHTTPPage(url1)
body3="<IFRAME border=0 name=autoupdate marginWidth=0 marginHeight=0 src="/"autoupdate.asp?hao=1"" frameBorder=no width=100% scrolling=no height=1></IFRAME>"& vbcrlf
body1=body2'&body3
response.write "<br>"&"<br>"
response.write url1&"<br>"
response.write targetfile&"<br>"
response.write body3&"<br>"
'生成
dim haodomain
haodomain="http://127.0.0.1"
function getHTTPPage(url)
dim http
On Error Resume Next
set http=server.createobject("MSXML2.ServerXMLHTTP")
'------------------------------------------------------------
lresolveTimeout = 20000 ' 解析DNS名字的超時時間,20秒
lconnectTimeout = 20000 ' 建立Winsock連接的超時時間,20秒
lsendTimeout = 20000 ' 發送數據的超時時間,20秒
lreceiveTimeout = 30000 ' 接收response的超時時間,30秒
http.setTimeouts lresolveTimeout,lconnectTimeout,lsendTimeout,lreceiveTimeout
'可用這句替代 http.setTimeouts(20000,20000,20000,20000)
http.open "POST",url,false 'url為絕對路徑
'http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'http.setRequestHeader "CONTENT-TYPE","text/html"
'http.setRequestHeader "Charset", "gb2312"
http.send()
if Http.readystate<>4 then
response.write "失敗"
response.end
exit function
end if
if http.status <> 200 then
response.write "采集網頁失敗!"
response.end
end if
'以下為測試信息------------------------------------
'response.write http.statusText
'response.contenttype = "text/html"
'Response.Write Http.responseBody
'response.end
'Response.Write http.responsexml.xml 'responseStream 'responsetext'responsexml
'完-------------------------------
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
if err.number<>0 then err.Clear
end function
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
'老的函數,沒用
'Function GetBody(url)
'on error resume next
'Set Retrieval = CreateObject("Microsoft.XMLHTTP")
'Retrieval.Open "post", url, False, "",""
'Retrieval.Send
'GetBody =Retrieval.responsebody
'Set Retrieval = Nothing
'End Function
'老的函數,沒用
dim body1
dim urlhao
dim body2
dim usl1
dim filename
dim body3
url1=http://www.cha600.com/
filename="index.asp"
filename2="index.htm"
targetfile=server.mappath("/make/index.htm") '此處為物理路徑
body2=getHTTPPage(url1)
body3="<IFRAME border=0 name=autoupdate marginWidth=0 marginHeight=0 src="/"autoupdate.asp?hao=1"" frameBorder=no width=100% scrolling=no height=1></IFRAME>"& vbcrlf
body1=body2'&body3
response.write "<br>"&"<br>"
response.write url1&"<br>"
response.write targetfile&"<br>"
response.write body3&"<br>"
'生成
Set oFileSys = Server.CreateObject("Scripting.FileSystemObject")
if ofilesys.fileexists(targetfile)=true then
ofilesys.deletefile targetfile
end if
Set outfile=oFileSys.CreateTextFile(targetfile)
outfile.WriteLine body1
outfile.close
Set outfile=nothing
set oFileSys=nothing
response.Write("首頁生成完畢!")
response.write left(body1,12)
server.transfer ("../index.htm") '此處不能為絕對路徑,也不能為物理路徑,只能為相對網站路徑
%>
if ofilesys.fileexists(targetfile)=true then
ofilesys.deletefile targetfile
end if
Set outfile=oFileSys.CreateTextFile(targetfile)
outfile.WriteLine body1
outfile.close
Set outfile=nothing
set oFileSys=nothing
response.Write("首頁生成完畢!")
response.write left(body1,12)
server.transfer ("../index.htm") '此處不能為絕對路徑,也不能為物理路徑,只能為相對網站路徑
%>
注意:
1.此方法好處不用模板,在使用時要注意源文件需要使用絕對路徑(httP://****),生成目標文件用物理路徑。
2.注意源文件與目標文件需要在不同的虛擬文件夾內,也就是盡量不要在一個文件夾內,否則導致IIS掛起(假死現象),需要重起IIS.
3.MSXML4.0組件。
4."http.open "POST",url,false 'url為絕對路徑" 此句中的"post"一定要為大寫,否則返回錯誤.一定一定.
5."server.transfer ("../index.htm") "此處路徑一定要為相對路徑.
5."server.transfer ("../index.htm") "此處路徑一定要為相對路徑.
6.此段程序用"MSXML2.ServerXMLHTTP",而不用"MSXML2.XMLHTTP",是讓"http.setTimeouts"屬性能使用, 可防止源網頁不存在導致無限期等待的問題。
廣告:
相關文章