Consultar servidor whois

xanburzum · Fevereiro 14, 2009

Componente COM para consultar um servidor WHOIS e recuperar informações em texto simples ou formato HTML. Estamos usando o componente free components2go. Você pode baixar esse componente aqui. Instale o componente e insira o seguinte.

<%
'declaração variável 
Dim objWhois
'criar uma instância do objeto whois
Set objWhois = Server.CreateObject("c2g.whois")
'configurar o servidor
objWhois.Server = "whois.networksolutions.com"
'whois porta 43
objWhois.Port = 43
'set timeout por 20 segundos tempo padrão é de 5
objWhois.Timeout = 20
'guarde o whois query do yahoo em strResult
strResult= objWhois.whois("yahoo.com")
'se houver um erro exibi-lo
if err.number<>0 then
Response.Write"Error: " & err.Description
'ou mostrar os resultados da consulta
else
Response.Write strResult
end if
'destruir o objeto
Set objWhois = Nothing
%>

saloeric · Novembro 9, 2009

Alguem tem a dll para partilhar, o site do componente tá off.

jrcardozo · Novembro 9, 2009

fiz este. Uma pequena adaptação e dá pra buscar todos os dominios. Como vou usar só os .com e os .net para internacionais ficou mais simples, mas é só mudar pra pegar todas as extensões da internic e do registro.br

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Response.Charset = "UTF-8"

Dim dominio
Dim endereco
Dim xmlhttp
Dim resposta

dominio		= Request.QueryString("dominio")
endereco	= Request.QueryString("endereco")

'Set xmlhttp = Server.CreateObject("MSXML2.XMLHTTP.3.0")
Set xmlhttp = Server.CreateObject("Microsoft.XMLHTTP")

'Response.Write endereco & dominio : Response.End()

If dominio = ".com" Or dominio = ".net" Then
	xmlhttp.Open "GET", "http://reports.internic.net/cgi/whois?whois_nic=" & endereco & dominio & "&type=domain", False
	xmlhttp.send
Else
	xmlhttp.Open "POST", "https://registro.br/cgi-bin/whois/#lresp", False
	xmlhttp.send("qr=" & endereco & dominio)
End If

Response.ContentType = "text/html"

resposta = BinaryToString(xmlhttp.responseBody)

If dominio = ".com" Or dominio = ".net" Then
	
	If InStr(1, resposta, "No match for domain", vbTextCompare) > 0 Or InStr(1, resposta, "No match for registrar", vbTextCompare) > 0 Then
		Response.Write "1"
	ElseIf InStr(1, resposta, "Name Server:", vbTextCompare) > 0 And InStr(1, resposta, "Whois Server:", vbTextCompare) > 0 Then
		Response.Write "0"
	End If	

Else
	If InStr(1, resposta, "Domínio inexistente", vbTextCompare) > 0 Then
		Response.Write "1"
	ElseIf InStr(1, resposta, "Sintaxe inválida", vbTextCompare) > 0 Or InStr(1, resposta, "ASN inexistente", vbTextCompare) > 0 Then
		Response.Write "2"
	ElseIf InStr(1, resposta, "Consulta inválida", vbTextCompare) > 0 Then
		Response.Write "3"
	ElseIf InStr(1, resposta, "ID entidade:", vbTextCompare) > 0 And InStr(1, resposta, "servidor DNS:", vbTextCompare) > 0 Then
		Response.Write "0"
	End If	
End if

Set xmlhttp = Nothing

Public Function BinaryToString(xBinary)
	Dim Binary
	Dim RS, LBinary
	If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
	Const adLongVarChar = 201
	Set RS = CreateObject("ADODB.Recordset")
	LBinary = LenB(Binary)
	If LBinary>0 Then
		RS.Fields.Append "mBinary", adLongVarChar, LBinary
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk Binary 
		RS.Update
		BinaryToString = RS("mBinary")
	Else
		BinaryToString = ""
	End If
	Set RS = Nothing
End Function

Public Function MultiByteToBinary(MultiByte)
	Dim RS, LMultiByte, Binary
	Const adLongVarBinary = 205
	Set RS = CreateObject("ADODB.Recordset")
	LMultiByte = LenB(MultiByte)
	If LMultiByte>0 Then
		RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk MultiByte & ChrB(0)
		RS.Update
		Binary = RS("mBinary").GetChunk(LMultiByte)
	End If
	Set RS = Nothing
	MultiByteToBinary = Binary
End Function

%>

saloeric · Novembro 10, 2009

Obrigado jonathandj, acho que vou optar mesmo por XMLHTTP, eu tava a usar um outro componente (DIWhoIs.DiWhoIs), eu preciso saber essencialmente 3 ou 4 dominios (.pt,.com,.net), mas tá dificil arranjar servidores de whois que funcionem, para .pt consigo para .net e .com ainda não descobri 1, o melhor mesmo será adaptar como tem o seu, Obrigado.

jrcardozo · Novembro 11, 2009

pra quem possa interessar, uma pequena melhoria(para o que preciso hoje)

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Server.ScriptTimeout = 99999999
Response.Charset = "UTF-8"
	Function limparHtml(strHtml)
		Dim objER
		strHtml						= replaceBr(strHtml)
		Set objER					= New RegExp
		objER.IgnoreCase	= True
		objER.Global			= True
		objER.Pattern			= "<[^>]*>"
		strHtml						= objER.Replace(strHtml, "")
		Set objER					= Nothing
		limparHtml				= strHtml
	End Function
%>
<style>
#easyTooltip{
	margin:0 10px 1em 0;
	width:250px;
	padding:8px;
	background:#fcfcfc;
	border:1px solid #e1e1e1;
	line-height:130%;				
	}
#easyTooltip h3{
	margin:0 0 .5em 0;
	font:13px Arial, Helvetica, sans-serif;
	text-transform:uppercase;
	}	
#easyTooltip p{
	margin:0 0 .5em 0;
	}		
#easyTooltip img{
		background:#fff;
		padding:1px;
		border:1px solid #e1e1e1;
		float:left;
		margin-right:10px;
		}
</style>
<%
Dim dominio
Dim endereco
Dim xmlhttp
Dim resposta
Dim arrayDominios
Dim verificarDominios
Dim contador
Dim detalhe
Dim dominiosInternic
Dim dominiosRegistroBr

endereco	= Request.QueryString("endereco")

dominiosRegistroBr = "|.com.br|.net.br|.adv.br|"

'dominiosInternic = "|.aero|.arpa|.asia|.biz|.cat|.com|.coop|.edu|.info|.int|.jobs|.mobi|.museum|.name|.net|.org|.pro|.travel|"
dominiosInternic = "|.com|.net|"

verificarDominios = Replace(dominiosInternic & dominiosRegistroBr, "||", "|")

arrayDominios = Split(verificarDominios, "|")

Response.ContentType = "text/html"

For contador = Lbound(arrayDominios) To Ubound(arrayDominios)
	
	dominio = arrayDominios(contador)
	detalhe = ""
	
	If dominio <> "" Then
		Set xmlhttp = Server.CreateObject("Microsoft.XMLHTTP")
		
		If InStr(dominiosInternic, "|" & dominio & "|") > 0 Then
			xmlhttp.Open "GET", "http://reports.internic.net/cgi/whois?whois_nic=" & endereco & dominio & "&type=domain", False
			xmlhttp.send
		Else
			xmlhttp.Open "POST", "https://registro.br/cgi-bin/whois/#lresp", False
			xmlhttp.send("qr=" & endereco & dominio)
		End If
				
		resposta = BinaryToString(xmlhttp.responseBody)
		
		If InStr(dominiosInternic, "|" & dominio & "|") > 0 Then
			
			If InStr(1, resposta, "NOT AUTHORITATIVE", vbTextCompare) > 0 Then
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""> </td><td><span style=""color:red;"">" & endereco & dominio & "</span></td><td colspan=""3"">Não autorizado</td></tr>"
			ElseIf InStr(1, resposta, "No match for domain", vbTextCompare) > 0 Or InStr(1, resposta, "No match for registrar", vbTextCompare) > 0 Then
				'Response.Write "1"
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""><input type=""checkbox"" value=""" & endereco & dominio & """ /></td><td><strong>" & endereco & dominio & "</strong></td><td width=""20""><input type=""checkbox"" /></td><td>Hospedagem</td><td><input type=""text"" style=""width:70px;"" /></td></tr>"
			ElseIf InStr(1, resposta, "Name Server:", vbTextCompare) > 0 And InStr(1, resposta, "Whois Server:", vbTextCompare) > 0 Then
				posInicioDetalhe = InStr(1, resposta, "Domain Name:", vbTextCompare)
				If posInicioDetalhe > 0 Then
					posFimDetalhe = InStr(1, Mid(resposta, posInicioDetalhe), "Expiration Date", vbTextCompare) + 29
				End If
				If posFimDetalhe > 0 And posInicioDetalhe > 0 Then
					detalhe = Mid(resposta, posInicioDetalhe, posFimDetalhe)
					detalhe = Replace(detalhe, "Registrar:", "<br />Registrar:")
					detalhe = Replace(detalhe, "Whois Server:", "<br />Whois Server:")
					detalhe = Replace(detalhe, "URL:", "<br />URL:")
					detalhe = Replace(detalhe, "Name Server:", "<br />Name Server:")
					detalhe = Replace(detalhe, "Status:", "<br />Status:")
					detalhe = Replace(detalhe, "Updated Date:", "<br />Updated Date:")
					detalhe = Replace(detalhe, "Creation Date:", "<br />Creation Date:")
					detalhe = Replace(detalhe, "Expiration Date:", "<br />Expiration Date:")
				End If
				
				response.write "<div style=""display:none;"" id=""detalhe_" & Replace(endereco & dominio, ".", "") & """>" & detalhe & "</div>"
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""> </td><td><span style=""color:red;"">" & endereco & dominio & "</span></td><td colspan=""3""><a href=""javascript:void(0);"" id=""link_detalhe_" & Replace(endereco & dominio, ".", "") & """>Indisponível</a></td></tr>"
			End If	
		
		Else
			If InStr(1, resposta, "Domínio inexistente", vbTextCompare) > 0 Then
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""><input type=""checkbox"" value=""" & endereco & dominio & """ /></td><td><strong>" & endereco & dominio & "</strong></td><td width=""20""><input type=""checkbox"" /></td><td>Hospedagem</td><td><input type=""text"" style=""width:70px;"" /></td></tr>"
			ElseIf InStr(1, resposta, "Sintaxe inválida", vbTextCompare) > 0 Or InStr(1, resposta, "ASN inexistente", vbTextCompare) > 0 Then
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""> </td><td><span style=""color:red;"">" & endereco & dominio & "</span></td><td colspan=""3"">URL inválida</td></tr>"
			ElseIf InStr(1, resposta, "Consulta inválida", vbTextCompare) > 0 Then
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""> </td><td><span style=""color:red;"">" & endereco & dominio & "</span></td><td colspan=""3"">Consulta inválida</td></tr>"
			ElseIf InStr(1, resposta, "ID entidade:", vbTextCompare) > 0 And InStr(1, resposta, "servidor DNS:", vbTextCompare) > 0 Then
			
				posInicioDetalhe = InStr(1, resposta, "domínio:", vbTextCompare)
				If posInicioDetalhe > 0 Then
					posFimDetalhe = InStrRev(Mid(resposta, posInicioDetalhe), "alterado") + 25
				End If
				If posFimDetalhe > 0 And posInicioDetalhe > 0 Then
					detalhe = Mid(resposta, posInicioDetalhe, posFimDetalhe)
					detalhe = limparHtml(detalhe)
					detalhe = Replace(detalhe, "entidade:", "<br />entidade:", 1, -1, 1)
					detalhe = Replace(detalhe, "documento:", "<br />documento:", 1, -1, 1)
					detalhe = Replace(detalhe, "responsável:", "<br />responsável:", 1, -1, 1)
					detalhe = Replace(detalhe, "país:", "<br />país:", 1, -1, 1)
					detalhe = Replace(detalhe, "ID entidade:", "<br />ID entidade:", 1, -1, 1)
					detalhe = Replace(detalhe, "ID admin:", "<br />ID admin:", 1, -1, 1)
					detalhe = Replace(detalhe, "ID técnico:", "<br />ID técnico:", 1, -1, 1)
					detalhe = Replace(detalhe, "ID cobrança:", "<br />ID cobrança:", 1, -1, 1)
					detalhe = Replace(detalhe, "servidor DNS:", "<br />servidor DNS:", 1, -1, 1)
					detalhe = Replace(detalhe, "status DNS:", "<br />status DNS:", 1, -1, 1)
					detalhe = Replace(detalhe, "último AA:", "<br />último AA:", 1, -1, 1)
					detalhe = Replace(detalhe, "criado:", "<br />criado:", 1, -1, 1)
					detalhe = Replace(detalhe, "expiração:", "<br />expiração:", 1, -1, 1)
					detalhe = Replace(detalhe, "alterado:", "<br />alterado:", 1, -1, 1)
					detalhe = Replace(detalhe, "status:", "<br />status:", 1, -1, 1)
					detalhe = Replace(detalhe, "ID:", "<br />ID:", 1, -1, 1)
					detalhe = Replace(detalhe, "e-mail:", "<br />e-mail:", 1, -1, 1)
					detalhe = Replace(detalhe, "criado:", "<br />criado:", 1, -1, 1)
					detalhe = Replace(detalhe, "alterado:", "<br />alterado:", 1, -1, 1)
				End If
				
				response.write "<div style=""display:none;"" id=""detalhe_" & Replace(endereco & dominio, ".", "") & """>" & detalhe & "</div>"
				If saida <> "" Then saida = saida & "<br />"
				saida = saida & "<tr><td width=""20""> </td><td><span style=""color:red;"">" & endereco & dominio & "</span></td><td colspan=""3""><a href=""javascript:void(0);"" id=""link_detalhe_" & Replace(endereco & dominio, ".", "") & """>Indisponível</a></td></tr>"
			End If	
		End if
		
		Set xmlhttp = Nothing
	End If
	
	If detalhe <> "" Then
		jScript = jScript & ""&_
			"$('#link_detalhe_" & Replace(endereco & dominio, ".", "") & "').easyTooltip({useElement: 'detalhe_" & Replace(endereco & dominio, ".", "") & "'});"
	End if
	
Next

Public Function BinaryToString(xBinary)
	Dim Binary
	Dim RS, LBinary
	If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
	Const adLongVarChar = 201
	Set RS = CreateObject("ADODB.Recordset")
	LBinary = LenB(Binary)
	If LBinary>0 Then
		RS.Fields.Append "mBinary", adLongVarChar, LBinary
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk Binary 
		RS.Update
		BinaryToString = RS("mBinary")
	Else
		BinaryToString = ""
	End If
	Set RS = Nothing
End Function

Public Function MultiByteToBinary(MultiByte)
	Dim RS, LMultiByte, Binary
	Const adLongVarBinary = 205
	Set RS = CreateObject("ADODB.Recordset")
	LMultiByte = LenB(MultiByte)
	If LMultiByte>0 Then
		RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk MultiByte & ChrB(0)
		RS.Update
		Binary = RS("mBinary").GetChunk(LMultiByte)
	End If
	Set RS = Nothing
	MultiByteToBinary = Binary
End Function

If saida <> "" Then
	%>
	<table align="center" cellspacing="3" cellpadding="0" border="0" class="tbProduto" style="margin:15px auto; width:90%;">
			<%=saida%>
	</table>
	<script>
	<%
	Response.Write jScript
	%>
	</script>
	<%
End If

%>

necessário referenciar os arquivos do jquery e o plugin easytooltip pois esse script é requisitado via ajax e devolvida a resposta

link easy tooltip - http://cssglobe.com/post/4380/easy-tooltip--jquery-plugin

quem não quiser usar jquery só passar o parametro e retirar a função do tooltip

abs

saloeric · Novembro 13, 2009

fiz uma pequena classe para verificar .net,.com,.pt,.eu, baseado no 1º script que o jonathandj colocou aqui, retorna true caso exista ou false caso não exista



<% 
class whois

	public endereco,dominio

	Private Function BinaryToString(xBinary) 
        Dim Binary 
        Dim RS, LBinary 
        If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary 
        Const adLongVarChar = 201 
        Set RS = CreateObject("ADODB.Recordset") 
        LBinary = LenB(Binary) 
        If LBinary>0 Then 
                RS.Fields.Append "mBinary", adLongVarChar, LBinary 
                RS.Open 
                RS.AddNew 
                RS("mBinary").AppendChunk Binary  
                RS.Update 
                BinaryToString = RS("mBinary") 
        Else 
                BinaryToString = "" 
        End If 
        Set RS = Nothing 
	End Function 
 
	Private Function MultiByteToBinary(MultiByte) 
        Dim RS, LMultiByte, Binary 
        Const adLongVarBinary = 205 
        Set RS = CreateObject("ADODB.Recordset") 
        LMultiByte = LenB(MultiByte) 
        If LMultiByte>0 Then 
                RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte 
                RS.Open 
                RS.AddNew 
                RS("mBinary").AppendChunk MultiByte & ChrB(0) 
                RS.Update 
                Binary = RS("mBinary").GetChunk(LMultiByte) 
        End If 
        Set RS = Nothing 
        MultiByteToBinary = Binary 
	End Function

	Public Function resultado
		Dim xmlhttp,resposta 

		Set xmlhttp = Server.CreateObject("MSXML2.XMLHTTP") 
			If dominio = ".com" Or dominio = ".net" Then 
        		xmlhttp.Open "GET", "http://reports.internic.net/cgi/whois?whois_nic="&endereco&dominio&"&type=domain", False 
        		xmlhttp.send 
			Else 
        		xmlhttp.Open "GET", "http://www.dominios.pt/register/whois.aspx?domain="&endereco&dominio, False 
        		xmlhttp.send 
			End If 
 
			resposta = BinaryToString(xmlhttp.responseBody) 
			Response.Charset="utf-8"
			Response.ContentType = "text/html" 
 
			If dominio = ".com" Or dominio = ".net" Then 
         		If InStr(1, resposta, "No match for domain", vbTextCompare) > 0 Or InStr(1, resposta, "No match for registrar", vbTextCompare) > 0 Then 
                	resultado = false 
        		ElseIf InStr(1, resposta, "Name Server:", vbTextCompare) > 0 And InStr(1, resposta, "Whois Server:", vbTextCompare) > 0 Then 
                	resultado = true
        		End If   
			Elseif dominio = ".pt" or dominio = ".com.pt" or dominio = ".eu" then
				Select case dominio
					case ".pt"
					If InStr(1, resposta, "Nameserver Information", vbTextCompare) > 0 Then resultado = true else resultado = false
					case ".com.pt"
					If InStr(1, resposta, "Nameserver Information", vbTextCompare) > 0 Then resultado = true else resultado = false
					case ".eu"
					If InStr(1, resposta, "Nameservers", vbTextCompare) > 0 Then resultado = true else resultado = false
				end Select
			else
				resultado = true
			End if 
 
		Set xmlhttp = Nothing

	end Function

end class 

	set who = new whois
		who.endereco = "google"
		who.dominio = ".com"
		response.write who.resultado
	set who = nothing

%>

jrcardozo · Novembro 13, 2009

legal. bom ver que ainda tem pessoas que trabalham encima das ideias colocadas no forum

quem tiver mais coisas disponibiliza ai

Patrique · Novembro 13, 2009

Muito boa, valew!

Arquivado

Consultar servidor whois

Recommended Posts

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

saloeric 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

jrcardozo 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

saloeric 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

jrcardozo 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

saloeric 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

jrcardozo 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

Patrique 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

PHP+Codeigniter - Dúvida em Relação a Teclas

Conexão mysql com outro domínio

[Resolvido] JavaScript - Exibir logo dentro da Tabela html

Fóruns

Tempo Real

Informação importante