发送文章__当百网

文章·资料	电脑软件	手机软件	网站源码
电脑·手机·网络学习话题娱乐故事文化·历史国学典籍法律法规	操作系统网络办公·文件音频视频图形图像硬件·驱动程序行业教学学习编程游戏	安卓苹果鸿蒙其他	ASP ASP.NET JSP PHP HTML·CSS·JavaScript

本站搜索

发送文章

xmlhttp 抓取网页内容

〖评论()〗〖留言〗〖收藏〗

收信地址

填写收信人的电子邮箱

邮件主题

填写邮件主题

邮件内容

%On Error Resume NextServer.ScriptTimeOut=9999999Function getHTTPPage(Path)t = GetBody(Path)getHTTPPage=BytesToBstr(t,"GB2312")End function
Function bytes2BSTR(vIn)strReturn = "" For j = 1 To LenB(vIn) ThisCharCode = AscB(MidB(vIn,j,1)) If ThisCharCode  H80 Then strReturn = strReturn  Chr(ThisCharCode) Else NextCharCode = AscB(MidB(vIn,j+1,1)) strReturn = strReturn  Chr(CLng(ThisCharCode) * H100 + CInt(NextCharCode)) j = j + 1 End If Next bytes2BSTR = strReturn End Function 
Function GetBody(url) on error resume nextSet Retrieval = CreateObject("Microsoft.XMLHTTP") 
Retrieval.Open "Get", url, False, "", "" Retrieval.Send GetBody =Retrieval.responsebody
Set Retrieval = Nothing End Function
Function BytesToBstr(body,Cset)dim objstreamset objstream = Server.CreateObject("adodb.stream")objstream.Type = 1objstream.Mode =3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset = CsetBytesToBstr = objstream.ReadText objstream.Closeset objstream = nothingEnd FunctionFunction Newstring(wstr,strng)Newstring=Instr(lcase(wstr),lcase(strng))if Newstring=0 then Newstring=Len(wstr)End Function
%
%Dim wstr,str,url,start,over,citycity = Request.QueryString("id")url="http://cn.finance.yahoo.com/q?s=USDKRW=Xd=c"wstr=getHTTPPage(url)start=Newstring(wstr,"最後交易")over=Newstring(wstr,"买方出价")body=mid(wstr,start,over-start)
start2=Instr(body,"b")+3over2=Instr(body,"/b")body2=mid(body,start2,over2-start2)
response.write body2%抓取网页。偶要实现实实更新天气预报。利用了XMLHTTP组件，抓取网页的指定部分。需要分件html源代码此例中的被抓取的html源代码如下p align=left2004年8月24日星期二；白天：晴有时多云南风3—4级；夜间：晴南风3—4级；气温：最高29℃最低19℃ /p而程序中是从以2004年8月24日为关键字搜索，直到/p结速而抓取的内容就变成了"2004年8月24日星期二；白天：晴有时多云南风3—4级；夜间：晴南风3—4级；气温：最高29℃最低19℃ "干干净净的了。记录一下。
%On Error Resume NextServer.ScriptTimeOut=9999999Function getHTTPPage(Path)t = GetBody(Path)getHTTPPage=BytesToBstr(t,"GB2312")End function Function GetBody(url) on error resume nextSet Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBodyEnd With Set Retrieval = Nothing End Function
Function BytesToBstr(body,Cset)dim objstreamset objstream = Server.CreateObject("adodb.stream")objstream.Type = 1objstream.Mode =3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset = CsetBytesToBstr = objstream.ReadText objstream.Closeset objstream = nothingEnd FunctionFunction Newstring(wstr,strng)Newstring=Instr(lcase(wstr),lcase(strng))if Newstring=0 then Newstring=Len(wstr)End Function%
html
BODY bgColor=#ffffff leftMargin=0 topMargin=0 MARGINHEIGHT=0 MARGINWIDTH=0!-- 开始 -- 
%Dim wstr,str,url,start,over,dtimedtime=Year(Date)"年"Month(Date)"月"Day(Date)"日"url="http://www.qianhuaweb.com/"wstr=getHTTPPage(url)start=Newstring(wstr,dtime)over=Newstring(wstr,"/p")body=mid(wstr,start,over-start)
response.write "MARQUEE onmouseover=this.stop(); onmouseout=this.start();"body"/marquee"

%!-- 结束 --/body/html<br /><br />文章网址：<a href="https://dangbai.cn/Article.asp?ID=10000186" target="_blank">https://dangbai.cn/Article.asp?ID=10000186</a>

填写邮件内容

发信地址

填写发信人的电子邮箱

邮件签名

填写邮件签名

验证码

填写验证码，单击刷新验证码

发送协议

·欢迎使用本站在线文章发送系统。
·不得使用本站在线发送邮件系统发送垃圾邮件、广告邮件。
·如果收信人地址或其服务器出现错误，可能无法成功发送。
·如果有什么问题，或者意见建议，请联系［网站管理员］。

当百网

本站使用【啊估文章软件站】网站系统〖网站管理员留言簿〗