<form id="nzrjf"></form>

          <address id="nzrjf"><form id="nzrjf"><nobr id="nzrjf"></nobr></form></address>
          <em id="nzrjf"></em>
          <form id="nzrjf"></form>

            <form id="nzrjf"></form>

            <sub id="nzrjf"><address id="nzrjf"><nobr id="nzrjf"></nobr></address></sub>
              虛擬主機域名注冊-常見問題虛擬主機問題 → 虛擬主機問題


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


            來源:
            閱讀:3913
            日期:2006-12-12

            【 雙擊滾屏 】 【 推薦朋友 】 【 收藏 】 【 打印 】 【 關閉 】 【 字體: 】 
            上一篇:用PHP在線發送郵件的例子!
            下一篇:異地匯款手續費費率
              >> 相關文章
             
            国产91页