asp蜘蛛程序

<%
'//这个程序运行成功了，但一些函数没写好，包括去除脚本的函数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.open
set rs=Server.CreateObject("ADODB.recordset")
set rs.activeconnection=conn
rs.cursortype=3

call start()  '//开始函数

sub start()

set rs=Server.CreateObject("ADODB.recordset")
set rs.activeconnection=conn
rs.cursortype=3

i=1
do while i<3      '//一次运行三个，可设定

'****  if 运行时间已经快到脚本运行时间限制，then
'*****  response.redirect(http://......88.asp)   跳转到另一个页面
'*****  结束本次运行。
'****  end if
'//上面的是实现自动化，在页面运行快超时时，结束本次运行，重新第二次执行,本文件的名称是88.asp。vb应该需要这个。

set rs=Server.CreateObject("ADODB.recordset")
set rs.activeconnection=conn
rs.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 html
title=gettitle(html)
body1=getbody(html)
nlink=getlink(Html,url)
call setclosed(title,body1,nlink)  '//把访问过的网址的colsed的值改为4，并添加标题和文本内容。
set rs=nothing
i=i+1
loop

end sub

 

sub delete() ''//删除不可用的网址，包括网址格式错误，或网页无法访问，但这个函数没有执行，只是链接格式错误时，会报错，然后停止运行；不知为什么。
set rs=Server.CreateObject("ADODB.recordset")
set rs.activeconnection=conn
rs.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=nothing
end 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 = nothing
End Function

 

 

 

function setclosed(title,body,nlink)     '//把访问过的网址的colsed的值改为4，并添加标题和文本内容。当页面无法访问时，也会修改closed值，但网址格式错误时本应被调用，但实际没有调用。
set rs=Server.CreateObject("ADODB.recordset")
set rs.activeconnection=conn
rs.cursortype=3
title=title
body=body
nlink=nlink
sql="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 sql
set rs=nothing
end 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 getbody
end 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+1
loop

  
    response.write j
    getlink=j    '//返回包含链接数
end function

 

 

 

%>

<%
response.write("插入成功,")

conn.close
if conn.state=0 then
response.write("任务完成，已经断开数据库")
end if
set conn=nothing
%>