通过XMLHTTP实现首页生成，大家分享一下，可提出修改建议！

[rober0371]

调用：GreateHttpFile 动态页面地址,要保存的路径及文件名
代码：
Sub GreateHttpFile(Url,FilePath)
Dim MyFile,HtmlContent
On Error Resume Next
If Url = "" Or FilePath = "" Then
ErrMsg "<li>Url参数或FilePath参数为空，请与管理员联系！"
Response.End
End If
HtmlContent = GetHttpPage(Url)
Set MyFile=Server.CreateObject("Scripting.FileSystemObject")
Set CrFi=MyFile.CreateTextFile(Server.MapPath(""&Filepath&""),true)
CrFi.Writeline(""&HtmlContent&"")
CrFi.close
If Err.Number = 0 then
Err.Clear
Response.write "<script>alert('操作成功！');history.back();</script>"
Response.End
Else
Err.Clear
Response.write "<script>alert('操作失败，网页地址可能出错，请与管理员联系！');history.back();</script>"
Response.End
End If
End Sub

Function GetHttpPage(url)
Dim Http
Set Http=server.createobject("MSXML2.XMLHTTP")
'Set Http=server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
'Http.open "POST",url,false
Http.send()
If Http.readystate<>4 then
exit Function
End If
GetHttpPage = BytesToBstr(Http.responseBody,"GB2312")
'GetHttpPage = bytesToBSTR(Http.responseBody,"Shift-JIS")
Set Http=Nothing
If Err.Number<>0 then
Err.Clear
End If
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

[phyllis2001]

感觉不怎么样,你这个生成首页,是捉别人网站的页面,然后保存成你自己的页面而已,但一点忽略了,就是如果你捉的那个页面如果有图片有flash,js,css什么的,你又没保存下来,这样生成的页面因为没了那些东西,显示起来肯定乱七八糟的,又有什么用呢?

[iamgsyy]

还要好好完善啊！
你可以偷好几个站的新闻然后生成自己的首页

[xilo]

觉得功能还不够

[rober0371]

我这个主要是本站首页生成时使用的，不需要建立模版！
大家可以补充，或者共享一下您的代码！
感谢大家参与！

[cqq]

嗯， 差不多

www.up114.com 的部分页面就是通过这种方式实现的。