<!--#include file="conn.asp"-->
<%
response.Buffer=true '开启缓冲
server.ScriptTimeout=999999
function filego(folder) '判断目录是否存在 不存在则建立目录
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if (fso.FolderExists(Server.MapPath(folder))) then
'判断如果存在就不做处理
else
'判断如果不存在则建立新文件夹
fso.CreateFolder(Server.MapPath(folder))
end if
end function
'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组件进行转换
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
set rs=Server.CreateObject("adodb.recordset")
sql="select bt,nr,id,fbsj,lb from [info] order by id desc "
rs.open sql,conn,1,1
do while not rs.eof
Url="")
response.Write(url&"<br>")
xnr1=getHTTPPage(Url)
str=rs("id")&".html"
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreatetextFile(Server.MapPath("/")&"/html/"&str)
fout.Write xnr1
fout.close
response.Flush()
rs.movenext
loop
%>