ICPCheckURL=1
Dim DataSet_ICP()

function GetsRoot(ByVal whichDomain)
 whichDomain=Lcase(whichDomain)
 Exts=".bj.cn,.sh.cn,.tj.cn,.cq.cn,.he.cn,.sx.cn,.nm.cn,.ln.cn,.jl.cn,.hl.cn,.js.cn,.zj.cn,.ah.cn,.fj.cn,.jx.cn,.sd.cn,.ha.cn,.hb.cn,.hn.cn,.gd.cn,.gx.cn,.hi.cn,."
Exts=Exts&"sc.cn,.gz.cn,.yn.cn,.xz.cn,.sn.cn,.gs.cn,.qh.cn,.nx.cn,.xj.cn,.tw.cn,.hk.cn,.mo.cn,"
 Exts= Exts & ".ac.cn,.com.cn,.net.cn,.org.cn,.gov.cn,.edu.cn,.com,.net,.org,.biz,.cn,.info,.tv,.cc,.tw,.name,.ws,.in,.hk,.tw,.us,.au,.ac,.ca"
 AllTop=split(Exts,",")
 if len(whichDomain)>3 then
  for z=0 to Ubound(AllTop)
   extLen=len(AllTop(z))
   if right(whichDomain,extLen)=AllTop(z) then
    prefix=left(whichDomain,len(whichDomain)-extLen)
    dotPos=inStrRev(prefix,".")
    if dotPos>0 then
     whichDomain=mid(prefix,dotPos+1) & AllTop(z)
    end if
    exit for
   end if
  next
 end if
 GetsRoot=whichDomain
end function

function getCmd(strM)
 strM=lcase(strM)
 if inStr(strM," ")>0 then
  getCmd=left(strM,inStr(strM," ")-1)
 else
  getCmd=strM
 end if
end function

Function bstr(vIn)

 Dim strReturn,iii,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
 strReturn = ""
 
 For iii = 1 To LenB(vIn)
  ThisCharCode = AscB(MidB(vIn,iii,1))
  If ThisCharCode < &H80 Then
   strReturn = strReturn & Chr(ThisCharCode)
  Else
   NextCharCode = AscB(MidB(vIn,iii+1,1))
   strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
   iii = iii + 1
  End If
 Next
 bstr = strReturn  
End Function

Sub tinyFitler(someMes)
 ReDim Preserve DataSet_ICP(0)
 blDrop=true
 blN=false
 PreChar=""
 PreCmd=""
 blInTd=false
 intTB=0
 intTR=0
 intTD=0
 blInTd=false
 infos=""

 for iii=1 to len(someMes)
  Schar=mid(someMes,iii,1)
  if Schar="<" then
  blDrop=true
  lastCmd=""
  blN=false
  elseif Schar=">" then
  blDrop=false '某个命令完成
  lastCmd=getCmd(lastCmd)
  if blN then
    if lastCmd="a" then
     if blInTd then infos=infos & ","
    end if
    if lastCmd="td" then
     blInTD=false
     DataSet_ICP(intTR)=DataSet_ICP(intTR) & infos & "`"
     infos=""
    end if
  else
    if lastCmd="table" then
     intTB=intTB+1
      if intTB>1 then
       Exit Sub '不用处理余下的表格
      end if
    end if
    if lastCmd="tr" then
     intTR=intTR+1
     intTD=0
     blInTD=false
     ReDim Preserve DataSet_ICP(intTR)
    end if
 
    if lastCmd="td" then
     blInTD=true
     intTD=intTD+1
    end if
    
  end if