ASP采集页面内容组件Microsoft.XMLHTTP

最新推荐文章于 2022-01-16 17:10:15 发布

thx_bj

最新推荐文章于 2022-01-16 17:10:15 发布

阅读量2k

点赞数

分类专栏： ASP 文章标签： asp function url action file input

ASP 专栏收录该内容

22 篇文章 0 订阅

订阅专栏

<%
'=================================================
'过程名：getHTTPPage
'作用：获取页面内容
'参数：url ----绝对地址
'=================================================
on error resume Next

Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
   strReturn = strReturn & Chr(ThisCharCode)
Else
   NextCharCode = AscB(MidB(vIn,i+1,1))
   strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
   i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

Function NewString(wstr,strng)
NewString=Instr(wstr,strng)
End Function

function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function

If request("action")="go" then
url = request("url")

wstr = getHTTPPage(url)
wstr=replace(wstr,"<head>","<head><base href="""&url&""">")

if err.number=0 Then
response.Write "<div align='center'>采集已完成，请点此<a href='http://www.officefinder.com.cn/我爱你.谭洪星'>查看采集的文件</a></div>"
End If

Else

%>
<form action="">请输入网络绝对路径：<input type="text" name="url"><input type="hidden" name="action" value="go"><input

type="submit" value="提交"></form>
<%End if%>

<%
FilePathHTML=server.MapPath("我爱你.谭洪星")
set obj_fso=server.createobject("scripting.filesystemobject")
obj_fso.CreateTextFile FilePathHTML,true
set obj_file=obj_fso.opentextfile(FilePathHTML,2)
obj_file.write wstr
obj_file.close
set obj_file=nothing
%>