1. <ol id="ft5v9"></ol>

    2. <button id="ft5v9"><object id="ft5v9"></object></button>
        虛擬主機域名注冊-常見問題虛擬主機問題 → 虛擬主機問題


      用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 %>


      來源:
      閱讀:4689
      日期:2006/12/12

      【 雙擊滾屏 】 【 推薦朋友 】 【 收藏 】 【 打印 】 【 關閉 】 【 字體: 】 
      上一篇:用PHP在線發送郵件的例子!
      下一篇:異地匯款手續費費率
        >> 相關文章
       
      午夜亚洲乱码伦小说区