www.u8686.com-信息发布平台
利用MSXML2_XmlHttp和Adodb_Stream获取网页的源程序
<%@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" />
<title>无标题文档</title>
</head>
<body>
<%
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 HtmlSave(Url,FileSavePath)
Dim Fso,Str
HtmlSave=false
Str=GetHttpPage(Url)
If Str="" Then Exit Function
If FsObject1=0 Then
Set Fso = server.CreateObject("scripting."&"filesystemobject")
Set Fso = Fso.CreateTextFile(Server.mappath(FileSavePath))
Fso.Write Str
Fso.Close:Set Fso=NoThing
Else
Set Fso = Server.CreateObject("ADODB.Stream")
Fso.Type = 2
Fso.Open
Fso.Charset = "GB2312"
Fso.Position = Fso.Size
Fso.WriteText Str
Fso.SaveToFile FileSavePath,2
Fso.close:Set Fso=Nothing
End If
HtmlSave=True
Str = Empty
Fso = Empty
End Function
Function GetHttpPage(HttpUrl)
dim http
Set http=server.createobject("MSXML2.XmlHttp")
http.open "POST",HttpUrl,false
On Error Resume Next
Http.send()
If Http.readystate<>4 Then Exit Function
GetHttpPage=BytesToBstr(Http.ResponseBody,"GB2312")
If InStr(Lcase(getHTTPPage), "charset=utf-8") Then GetHttpPage=Http.responseText
Set http=nothing
if err.number<>0 Then err.Clear
Http=Empty
End Function
%>
<%
'response.Write GetHttpPage("http://www.u8686.com")
call HtmlSave("http://www.u8686.com","u8686.txt")%>
</body>
</html>