域名查询类

来源：互联网发布：三阶矩阵模计算公式编辑：程序博客网时间：2024/04/28 11:18

class DominClass
'''''''''''''''''''''''''''''''''''''''''''''''''
'-----------------------------------------------'
' class DominClass '
' 域名查询类 '
' 作者:KingApex '
' 最后修改时间：2004年9月2日 '
'-----------------------------------------------'
' 公有方法: '
' 1.setstrDomain '
' 设置要查询域名的类别字符串用","隔开，如:"com,net" '
' '
' 2.setDomainName '
' 设置域名,如 sina.com '
' '
' 3.getresult() '
' 取得结果，对应strDomain的一个数组true or false '
'
'-----------------------------------------------'
' 用法举例: '
'set objD = new DominClass '
'objD.setstrDomain("com,net") '
'objD.setDomainName("sina") '
'dim r '
'r = objD.getresult() '
'set objD = nothing '
' '
'dim dd:dd = ubound(r) '
'if dd >0 then '
'for i = 0 to ubound(r) '
'response.write r(i) '
'next '
'else '
'response.write "错误" '
'end if '
' '
'''''''''''''''''''''''''''''''''''''''''''''''''

private Retrieval,strDomain,result,DomainName

'初始化
Private Sub Class_Initialize()
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
end sub

'设置域名列表,号隔开如;"com,net,cn"
public function setstrDomain(str)
strDomain=str
end function

'设置域名如:sina
public function setDomainName(aName)
DomainName = aName
end function

'取得结果，对应strDomain的一个数组
public function getresult()

dim tempar:tempar = split(strDomain,",")
dim i,tempDomain

redim result(ubound(tempar))

for i =0 to ubound(tempar)
tempDomain = DomainName&"."&tempar(i)
result(i) = CheckDomainExits( GetURL("http://reports.internic.net/cgi-bin/whois?whois_nic="&tempDomain&"&type=domain") )
next
Set Retrieval = Nothing
getresult = result
end function

'检测域名是否存在
private function CheckDomainExits(byref htmlContent)
dim r
if instr(htmlContent,"No match")> 0 then
r = false
else
r = true
end if
htmlContent=null
CheckDomainExits =r
end function

''''''''''''''''''
' 转码 '
''''''''''''''''''
private 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

''''''''''''''''''''''''
' xmlhttp post data '
''''''''''''''''''''''''
private Function GetURL(url)

With Retrieval
.Open "GET", url, false
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send
GetURL = .ResponseBody
End With

GetURL= bstr(GetURL)
End Function

end class