<%'//这个程序运行成功了，但一些函数没写好，包括去除脚本的函数getbody()。其他地方含有很多错误。帮我把*后面的中文翻译成计算机语句，然后修改一下不好的地方。
Dim Url,Html,i
set conn=server.CreateObject("adodb.connection")conn.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};" & "DBQ=" & "C:/Inetpub/wwwroot/1/wo.mdb"'//用的access数据库wo.mdb，包括tnet表，表中包含字段：网址编号netid,网址link,对应的网页标题title,可显示文本body,包含的链接数nlink.conn.openset rs=Server.CreateObject("ADODB.recordset")set rs.activeconnection=connrs.cursortype=3
call start() '//开始函数
sub start()
set rs=Server.CreateObject("ADODB.recordset")set rs.activeconnection=connrs.cursortype=3
i=1do while i<3 '//一次运行三个，可设定
'**** if 运行时间已经快到脚本运行时间限制，then'***** response.redirect(http://......88.asp) 跳转到另一个页面'***** 结束本次运行。'**** end if'//上面的是实现自动化，在页面运行快超时时，结束本次运行，重新第二次执行,本文件的名称是88.asp。vb应该需要这个。
set rs=Server.CreateObject("ADODB.recordset")set rs.activeconnection=connrs.cursortype=3
sql="select top 1 link,netid from tnet where closed<>4 order by netid" '//查出第一条closed<>4的记录，4代表访问过rs.open sql
url=rs("link")id=rs("netid")
Response.write "<br><br>第"&i&"个网址"&url&"的链接数是 "
Html = getHTTPPage(Url)Response.write htmltitle=gettitle(html)body1=getbody(html)nlink=getlink(Html,url)call setclosed(title,body1,nlink) '//把访问过的网址的colsed的值改为4，并添加标题和文本内容。set rs=nothingi=i+1loop
end sub
sub delete() ''//删除不可用的网址，包括网址格式错误，或网页无法访问，但这个函数没有执行，只是链接格式错误时，会报错，然后停止运行；不知为什么。set rs=Server.CreateObject("ADODB.recordset")set rs.activeconnection=connrs.cursortype=3 sql="delete from tnet where tnet=(select top 1 link,netid from tnet where closed<>4 order by netid)" rs.open sql set rs=nothing call start() '//重新开始运行end sub
'1、输入url目标网页地址，返回值getHTTPPage是目标网页的html代码function getHTTPPage(url) dim Http set Http=server.createobject("MSXML2.XMLHTTP") Http.open "GET",url,false Http.send() if Err.number<>0 then '//如果出现网址错误，或网页无法访问就调用delete()函数删除数据库中不可用的网址。但是当网址格式正确，但页面无法访问时，正常执行其他程序，没有执行delete()；当格式不正常时，不能执行delete()删除程序，然后报错，说代码有问题，但只要把网址改好就不会说代码错误。这个地方我改不好，帮我改一下。 call delete() '//删除不可用的网址，包括网址格式错误，或网页无法访问，但delete() 函数没有执行，只是链接格式错误时，会报错，然后停止运行；但页面无法访问时，正常执行其他程序。不知为什么。 end if if Http.readystate<>4 then exit function end if getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312") set http=nothingend 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 = nothingEnd Function
function setclosed(title,body,nlink) '//把访问过的网址的colsed的值改为4，并添加标题和文本内容。当页面无法访问时，也会修改closed值，但网址格式错误时本应被调用，但实际没有调用。set rs=Server.CreateObject("ADODB.recordset")set rs.activeconnection=connrs.cursortype=3title=titlebody=bodynlink=nlinksql="update tnet set closed=4 ,title='"&title&"',body='"&body&"',nlink='"&nlink&"' where netid=(select top 1 netid from tnet where closed=1 order by netid)"rs.open sqlset rs=nothingend function
function gettitle(html) ''//获得网页标题函数 dim tpos1,tpos2,len html=lcase(html) tpos1=instr(html,"<title>")+7 tpos2=instr(html,"</title>") len=tpos2-tpos1 gettitle=mid(html,tpos1,len) response.write gettitle '//测试用end function
function httptou(url) '//处理本地链接，提取本地链接前所需的字符串:http://... dim a a=len(url)-instr(strreverse(url),"/")+1 httptou=left(url,a) end function
function getbody(body) '//获得页面的显示文本，还没写好，测试用 ****，帮我写一下，我写的错误很多 getbody=left(body,20) response.write getbodyend function
function getlink(html,url) '//提取链接插入数据库，返回页面链接数 dim pos1,pos2,pos3,pos4,ab,getlinka j=1 Do while instr(html,"href=")>0
pos1=instr(html,"href=")+6 '网址的第一个字的位置
html=mid(html,pos1)
pos2=instr(html,"""")-1 '网址的最后一个字符
link=left(html,pos2)
if left(link,7)<>"http://" then link=httptou(url)&link '调用函数httptou(url) end if
sqllink="insert into tnet(link,closed) select '"&link&"',1" '//closed字段判断网址是否访问过，1表示没有访问过，4表示访问过 conn.execute(sqllink) j=j+1loop
response.write j getlink=j '//返回包含链接数end function
%>
<%response.write("插入成功,")
conn.closeif conn.state=0 thenresponse.write("任务完成，已经断开数据库")end ifset conn=nothing%>
