利用asp查询某域名是否备案,并返回备案号

利用asp查询某域名是否备案,并返回备案号
返回格式是:
DataSet_ICP(1)
DataSet_ICP(2)
DataSet_ICP(..)
DataSet_ICP(n)


其中数组DataSet_ICP的每一行代表信产部查询结果表格中的一行,每一行中的各列使用'分号隔.
比如要查询域名web9898.cn是否备案是,可以使用如下方式调用:

<%
'----------------------段一
'必须将[段二]放在段一的前面,这儿为了排版,所以提到了前边,否则无法使用

if LoadICP("DO","web9898.cn") then
ICPNo=GetNo()
if ICPNo="ERROR"
Response.write "查询失败"
elseif ICPNO="NONE"
Response.write "未备案"
else
Response.write "web9898.cn的备案编号:" & ICPNo
end if
else
Response.write "抱歉,查询失败"
end if
%>

<%
'-------------------------段二
Dim DataSet_ICP()

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,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
strReturn = ""

For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 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 i=1 to len(someMes)
Schar=mid(someMes,i,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

Function GetICP(ByType,textValue)
on error resume next
ByType=Lcase(ByType)
if ByType="no" then
Gtype=8
elseif ByType="do" then
Gtype=2
else
Gtype=6
end if
Referer="http://www.miibeian.gov.cn/Search/WW_ICP_WhetherRecord_Select.jsp"
url="http://211.94.161.10/Search/WW_ICP_WhetherRecord_Search.jsp?selectid=" & Gtype & "&textfield=" & textValue
' url="http://www.miibeian.gov.cn/Search/WW_ICP_WhetherRecord_Search.jsp?selectid=" & Gtype & "&textfield=" & textValue
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
%>