<strong id="qkrzj"><pre id="qkrzj"><xmp id="qkrzj"></xmp></pre></strong>
        1. <ruby id="qkrzj"><legend id="qkrzj"></legend></ruby>
        2. <tbody id="qkrzj"></tbody>

            1.   虛擬主機域名注冊-常見問題虛擬主機問題 → 虛擬主機問題


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


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

              【 雙擊滾屏 】 【 推薦朋友 】 【 收藏 】 【 打印 】 【 關閉 】 【 字體: 】 
              上一篇:用PHP在線發送郵件的例子!
              下一篇:異地匯款手續費費率
                >> 相關文章
               
              国产xxxx农村野外性xxxx_女人色在线视频免费观看_中文毛片无遮挡高清免费_公息肉欲28篇小说目录