虚拟主机域名注册-常见问题虚拟主机问题 → 虚拟主机问题


用asp检查一个域名的备案状态的例子!
作者:
<%
'程序功能,自动到信产部网站核对一个域名的备案情况,如果备案成功,返回备案编号。

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

  elseif Schar="/" and PreChar="<" then
  blN=true
  else
   if not blDrop then
    if blInTD then infos=infos & Schar
   else
    lastCmd=lastCmd & Schar
   end if
  end if
  PreChar=Schar
 next

end Sub
'程序设计:西部数码(http://www.west263.com )专业提供虚拟主机、域名注册

Function GetICP(ByType,textvalue)
 on error resume next

 if ByType="No" then
  Gtype=8
 else
  Gtype=2
 end if
'---type=6根据url查询(URL);type=2,根据域名查询(DO),type=8,根据icp编号来查(No)

 if ByType="URL" then
  Gtype=6
 end if

 Referer="http://www.miibeian.gov.cn/Search/WW_ICP_WhetherRecord_Select.jsp";
 if ICPCheckURL="1" then
  url="http://211.94.161.10/Search/WW_ICP_WhetherRecord_Search.jsp?selectid="; & Gtype & "&textfield=" & textvalue
 elseif ICPCheckURL="2" then
  url="http://www.miibeian.gov.cn/Search/WW_ICP_WhetherRecord_Search.jsp?selectid="; & Gtype & "&textfield=" & textvalue
 end if


Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Post", url, false
   .setRequestHeader "Referer",Referer
.Send
   GetICP =.ResponseBody
   End With
Set Retrieval = Nothing
 GetICP=bstr(GetICP)
End Function


'如果要检查,必须先LoadICP
Function LoadICP(BYWHICH,GIVE)
 RetCode=GetICP(BYWHICH,GIVE)
 if isNull(RetCode) then
  LoadICP=false
 else
  Call tinyFitler(RetCode)
  LoadICP=true
 end if
end Function

Function GetNo()
 RRsets=Ubound(DataSet_ICP)
 if RRsets=0 then
  GetNo="ERROR"
 end if
 if RRsets=1 then
  GetNo="NONE"
 end if
 if RRsets>1 then
  GetNo=split(DataSet_ICP(2),"`")(3)
 end if 
end Function


ckbind="要检查的域名.com"
 If LoadICP("DO",ckbind) Then
   IcpNO=GetNo()
   If IcpNo="NONE" Or IcpNo="ERROR" Then
    if LoadICP("URL",ckbind) then
     IcpNO=GetNo() 
    end if
   End If 'GetsRoot


   If IcpNo="NONE" Or IcpNo="ERROR" Then
    if LoadICP("DO",GetsRoot(ckbind)) then
     IcpNO=GetNo() 
    end if
   End If

   If IcpNo="NONE" Or IcpNo="ERROR" Then
    if LoadICP("URL",GetsRoot(ckbind)) then
     IcpNO=GetNo() 
    end if
   End If
  
   if IcpNo="NONE" or IcpNo="ERROR" then
   respnose.write  "该域名还未备案成功!"
   else
   respnose.write  "该域名已经备案成功!备案编号是:"&IcpNO
   end if

 End If


%>

<% '程序功能,自动到信产部网站核对一个域名的备案情况,如果备案成功,返回备案编号。 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 elseif Schar="/" and PreChar="<" then blN=true else if not blDrop then if blInTD then infos=infos & Schar else lastCmd=lastCmd & Schar end if end if PreChar=Schar next end Sub '程序设计:西部数码(http://www.west263.com )专业提供虚拟主机、域名注册 Function GetICP(ByType,textValue) on error resume next if ByType="No" then Gtype=8 else Gtype=2 end if '---type=6根据url查询(URL);type=2,根据域名查询(DO),type=8,根据icp编号来查(No) if ByType="URL" then Gtype=6 end if Referer="http://www.miibeian.gov.cn/Search/WW_ICP_WhetherRecord_Select.jsp" if ICPCheckURL="1" then url="http://211.94.161.10/Search/WW_ICP_WhetherRecord_Search.jsp?selectid=" & Gtype & "&textfield=" & textValue elseif ICPCheckURL="2" then url="http://www.miibeian.gov.cn/Search/WW_ICP_WhetherRecord_Search.jsp?selectid=" & Gtype & "&textfield=" & textValue end if Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Post", url, false .setRequestHeader "Referer",Referer .Send GetICP =.ResponseBody End With Set Retrieval = Nothing GetICP=bstr(GetICP) End Function '如果要检查,必须先LoadICP Function LoadICP(BYWHICH,GIVE) RetCode=GetICP(BYWHICH,GIVE) if isNull(RetCode) then LoadICP=false else Call tinyFitler(RetCode) LoadICP=true end if end Function Function GetNo() RRsets=Ubound(DataSet_ICP) if RRsets=0 then GetNo="ERROR" end if if RRsets=1 then GetNo="NONE" end if if RRsets>1 then GetNo=split(DataSet_ICP(2),"`")(3) end if end Function ckbind="要检查的域名.com" If LoadICP("DO",ckbind) Then IcpNO=GetNo() If IcpNo="NONE" Or IcpNo="ERROR" Then if LoadICP("URL",ckbind) then IcpNO=GetNo() end if End If 'GetsRoot If IcpNo="NONE" Or IcpNo="ERROR" Then if LoadICP("DO",GetsRoot(ckbind)) then IcpNO=GetNo() end if End If If IcpNo="NONE" Or IcpNo="ERROR" Then if LoadICP("URL",GetsRoot(ckbind)) then IcpNO=GetNo() end if End If if IcpNo="NONE" or IcpNo="ERROR" then respnose.write "该域名还未备案成功!" else respnose.write "该域名已经备案成功!备案编号是:"&IcpNO end if End If %>


来源:
阅读:4692
日期:2006/12/12

【 双击滚屏 】 【 推荐朋友 】 【 收藏 】 【 打印 】 【 关闭 】 【 字体: 】 
上一篇:用PHP在线发送邮件的例子!
下一篇:异地汇款手续费费率
  >> 相关文章