怎么能让asp+ajax 实现边采集边显示采集结果呢?
我这自己写了个采集程序,是asp+ajax的。
采集界面就两个按钮,一个开始采集 一个停止采集
当点击的开始采集的时候 就通过ajax异步调用采集文件news_gathering_key.asp。
news_gathering_key.asp 这文件里面有显示采集标题、日期、源地址等等信息。
现在采集一切正常,可就是很不友好,我点击开始采集,页面什么都没动,值得采集完了,才全部显示出来。。。
我现在想的是怎么能实现 采集一条显示一条的采集结果呢?
news_gathering_key.asp:
call getpbody("http://tech.qq.com/l/it/itnews/itnews.htm")
function getpbody(url)
dim objxml
on error resume next
set objxml = createobject("microsoft.xmlhttp")
with objxml
.open "get", url, false, "", ""
.send
getbody = .responsebody
end with
getbody=bytestobstr(getbody,"gb2312")
if len(getbody)<>0 then
call splitre(getbody)
end if
'response.Write getbody
set objxml = nothing
end function
function getcbody(url,k)
dim objxmlx
on error resume next
set objxmlx = createobject("microsoft.xmlhttp")
with objxmlx
.open "get", url, false, "", ""
.send
getbody = .responsebody
end with
getbody=bytestobstr(getbody,"gb2312")
if len(getbody)<>0 then
call splitrc(getbody,k)
end if
'response.Write getbody
set objxmlx = nothing
end function
'使用adodb.stream处理二进制数据
function bytestobstr(strbody,codebase)
dim objstream
set objstream = server.createobject("adodb.stream")
objstream.type = 1
objstream.mode =3
objstream.open
objstream.write strbody
objstream.position = 0
objstream.type = 2
objstream.charset = codebase
bytestobstr = objstream.readtext
objstream.close
set objstream = nothing
end function
function splitre(str)
Dim strurl(10000),strtxt(10000),strtim(10000),strContent(10000)
str=replace(str,"""","'")
str1=split(str,"<div class='mod newslist'>")
str2=split(str1(1),"</div>")
strx=replace(replace(replace(replace(str2(0),"<ul><li>",""),"<a target='_blank' href='",""),"</ul>",""),"</li>","")
strx=replace(replace(replace(replace(replace(replace(strx,"<li>",""),"<span class='pub_time'>",""),"</span>","|||"),"·",""),"'>","|"),"</a> ","|")
strx=replace(strx," "," ")
strxx=split(strx,"|||")
for i=0 to ubound(strxx)
strtex=split(strxx(i),"|")
if ubound(strtex)>=2 then
response.Write "<font color=blue>开始采集新闻:"&strtex(1)&" 新闻地址:"&strtex(0)&"</font><br><br>"
set ck=server.CreateObject("adodb.recordset")
ck.open "select * from News_gathering where url='"&strtex(0)&"'",conn,1,1
if not ck.eof then
cktemp=1
else
cktemp=0
end if
ck.close
set ck=nothing
strurl(i)=strtex(0)
strtxt(i)=strtex(1)
if cktemp=1 then
response.Write "<font color=red>新闻:"&strtxt(i)&" 已经存在,不予采集。</font><br><br>"
else
response.Write "<font color=green>新闻:"&strtex(1)&" 采集完毕</font><br><br>"
end if
strtim(i)=strtex(2)
end if
next
for i=0 to ubound(strurl)
if len(strurl(i))<=0 then exit for
on error resume next
set objxmlx = createobject("microsoft.xmlhttp")
with objxmlx
.open "get", strurl(i), false, "", ""
.send
getbody = .responsebody
end with
getbody=bytestobstr(getbody,"gb2312")
if len(getbody)<>0 then
strx=strCut(getbody,"<div id=""Cnt-Main-Article-QQ"" bossZone=""content"">","</div>",2)
'response.Write strx
strContent(i)=strx
end if
set objxmlx = nothing
next
tjnum=0
for i=0 to ubound(strurl)
if len(strurl(i))<=0 then exit for
set ck=server.CreateObject("adodb.recordset")
ck.open "select * from News_gathering where url='"&strurl(i)&"'",conn,1,1
if ck.eof then
set rscj=server.CreateObject("adodb.recordset")
rscj.open "select * from News_gathering",conn,1,3
rscj.addnew
rscj("url")=strurl(i)
rscj("title")=strtxt(i)
rscj("content")=strContent(i)
rscj("timex")=strtim(i)
rscj("addtime")=now()
rscj("nindex")=0
rscj.update
rscj.close
set rscj=nothing
end if
ck.close
set ck=nothing
'response.Write "<table width=100% style='margin-bottom:10px;border:3px solide #ff3300;' border='1' cellpadding='0' cellspacing='0' bordercolor='#000000'><tr><td align=center><h3>"&strtxt(i)&"</h3></td></tr><tr><td align=right>日期:"&strtim(i)&"</td></tr><tr><td style='line-height:23px;padding:15px;'>"&strContent(i)&"</td></tr></table>"
next
'response.Write tjnum
'for i=0 to ubound(strContent)
'if len(strContent(i))<=0 then exit for
'response.Write strContent(i)&"<br><br><br><br>"
'next
end function
'for i=0 to ubound(strurl)
'if len(strurl(i))<=0 then exit for
'response.Write strurl(i)&"<br>"
'next
'response.Write "<br>文章标题列表:<br>"
'for i=0 to ubound(strtxt)
'if len(strtxt(i))<=0 then exit for
'response.Write strtxt(i)&"<br>"
'next
'response.Write "<br>时间:<br>"
'for i=0 to ubound(strtim)
'if len(strtim(i))<=0 then exit for
'response.Write strtim(i)&"<br>"
'next
'截取字符串,1.包括起始和终止字符,2.不包括
'strcut(str,"<!-- 正文内容 begin -->","<!-- 正文内容 end -->",2)
Function strCut(strContent,StartStr,EndStr,CutType)
Dim strHtml,S1,S2
strHtml = strContent
On Error Resume Next
Select Case CutType
Case 1
S1 = InStr(strHtml,StartStr)
S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)
Case 2
S1 = InStr(strHtml,StartStr)+Len(StartStr)
S2 = InStr(S1,strHtml,EndStr)
End Select
If Err Then
strCute = "<p align=’center’>没有找到需要的内容。</p>"
Err.Clear
Exit Function
Else
strCut = Mid(strHtml,S1,S2-S1)
End If
End Function ajax asp 采集 边显示边采集
[解决办法]
不知道你使用的是什么浏览器,如果是firefox支持streaming ajax,readystate为3就可以读数据了,参考:firefox Streaming AJAX实现源代码
if cktemp=1 then
response.Write "<font color=red>新闻:"&strtxt(i)&" 已经存在,不予采集。</font><br><br>"
else
response.Write "<font color=green>新闻:"&strtex(1)&" 采集完毕</font><br><br>"
end if
response.Flush''''''''''''增加这句马上输出内容,firefox下ajax就能获取数据了
set fso=server.CreateObject("scripting.filesystemobject")
set s=fso.OpenTextFile(server.MapPath("abc.txt"),ForAppending,true)
if cktemp=1 then
s.WriteLine "<font color=red>新闻:"&strtxt(i)&" 已经存在,不予采集。</font><br><br>"
else
s.WriteLine "<font color=green>新闻:"&strtex(1)&" 采集完毕</font><br><br>"
end if
s.close
set fso=nothing