Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Fernando_DMK

Colocar no site um verificador de domínios.

Por , em ASP Clássico

Recommended Posts

saloeric    1

saloeric
Postado

pode usar esta classe que desenvolvi

 


<% 
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 
		Elseif dominio = ".com.br" then
			xmlhttp.Open "GET", "https://registro.br/cgi-bin/whois/lresp?qr="&endereco&dominio, 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
		Elseif dominio = ".com.br" then
			If InStr(1, resposta, "domínio:", vbTextCompare) > 0 And InStr(1, resposta, "entidade:", vbTextCompare) > 0 Then resultado = true else resultado = false
		else
			resultado = true
		End if 

	Set xmlhttp = Nothing

end Function

end class 
%>

depois chama assim

set who = new whois
	who.endereco = teste
	who.dominio = .com
	saida = who.resultado
set who = nothing

o resultado é true(existente) ou false(livre)

só funciona para domínios .com,.net,.pt,.com.pt,.eu,.com.br

Compartilhar este post

Link para o post
Compartilhar em outros sites

Fernando_DMK    0

Fernando_DMK
Postado

Quando tento veririfar um domínio .com.br da erro na linha 52 (xmlhttp.send)

 

50 - Elseif dominio = ".com.br" then
51 - xmlhttp.Open "GET", "https://registro.br/cgi-bin/whois/lresp?qr="&endereco&dominio, False
52 - xmlhttp.send

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

olha este exemplo, este script e para verificar se o dominio esta ou não registrado, ele pesquisa no registro.br e na internic e ele tambem mostra informações sobre o dominio registrado.

<%
dim objXML, Resultado, msgErro, srtmethod
on error resume next
Response.Buffer = false
'Set the script timeout to 60 seconds
Server.ScriptTimeout = 99999999
end_pag = "http://www."&request("dominio")&""&request("pont")&""
'end_pag =request.Form("dominio")&""&request.Form("pont")&""
url_dom = request("dominio")&""&request("pont")&""
dominio=request("dominio")
Ext=request("pont")
If request("dominio")<>"" then
tipo = split(Request("pont"),".")
tipo_arquivo_2 = "." & tipo(ubound(tipo))
       ext_perm = ".com.br,.adm.br,.br,.org.br,.gov.br,.tv.br"
       exte = split(ext_perm,",")
       a = 0
       for i=0 to ubound(exte)
       if trim(Lcase(tipo_arquivo_2)) = trim(exte(i)) then
       a = 1
       end if
       next
'aqui verifica os dominios internacional
Set ObjXML = Server.CreateObject("Msxml2.serverXMLHTTP")
if a <> 1 then
objXML.Open "GET", "http://reports.internic.net/cgi/whois?whois_nic="&url_dom& "&type=domain", False
objXML.Send
else
   ObjXML.Open "GET", "http://registro.br/cgi-bin/nicbr/whois?qr="&url_dom, False
   ObjXML.Send

end if
Resultado = objXML.ResponseText' = ResponseText
if a <> 1 then
'posInicioDetalhe = InStr(1, Resultado, "Domain Name:", vbTextCompare)
if Ext=".org" or Ext=".info" or Ext=".name" then
'Aqui verifica extenções .org
   If instr(dominio, ".") > 0 Or instr(dominio, ",") > 0 or instr(dominio, ";") > 0 or instr(dominio, ":") > 0 or instr(dominio, "=") > 0 then
   msgErro1 = "<br><br><strong><font color='blue'>Impossível, o dominio <font color='#FF0000'>www."&url_dom&" </font> não está disponível para registro</font><br><br></strong>"
   else
   If not InStr(1, Resultado, "Domain Name", vbTextCompare) > 0 Or InStr(1, Resultado, "No match for registrar", vbTextCompare) > 0 Then
   msgErro2 = "<br><br><strong><font color='blue'>Parabéns, o dominio <font color='#009900'>www."&url_dom&" </font> disponivel para registro</font><br><br></strong>"
   'ElseIf instr(1,Resultado,"encontrada nenhuma") Then
   Else
   msgErro = "<br><br><strong><font color='blue'>Impossível, o dominio <font color='#FF0000'>www."&url_dom&" </font>já registrado</font><br><br></strong>"
   If InStr(1, Resultado, "NOT AUTHORITATIVE", vbTextCompare) > 0 and InStr(1, Resultado, "No match for domain", vbTextCompare) > 0 and InStr(1, Resultado, "No match for registrar", vbTextCompare) > 0 Then
   ElseIf InStr(1, Resultado, "Domain Name:", vbTextCompare) > 0 or InStr(1, Resultado, "Name Server:", vbTextCompare) > 0 Then
   posInicioDetalhe = InStr(1, Resultado, "Domain Name:", vbTextCompare)
   If posInicioDetalhe > 0 Then
   posFimDetalhe = InStr(1, Mid(Resultado, posInicioDetalhe), "Expiration Date", vbTextCompare) + 29
   End If
   If posFimDetalhe > 0 or posInicioDetalhe > 0 Then
   detalhe = Mid(Resultado, posInicioDetalhe, posFimDetalhe)
   detalhe = Replace(detalhe, "Registrar:", "<br />Registrar:")
   detalhe = Replace(detalhe, "e-mail:", "<br />Name e-mail:")
   detalhe = Replace(detalhe, "Last Updated On:", "<br />Last Updated On:")
   detalhe = Replace(detalhe, "Created On:", "<br />Created On:")
   detalhe = Replace(detalhe, "Whois Server:", "<br />Whois Server:")
   detalhe = Replace(detalhe, "Expiration Date:", "<br />Expiration Date:")
   detalhe = Replace(detalhe, "Sponsoring Registrant:", "<br />Sponsoring Registrar:")
   detalhe = Replace(detalhe, "Domain ID:", "<br />Domain ID:")
   End If
   end if
   end if
   end if
else
'Aqui verifica as extenções .com,.net
           If instr(dominio, ".") > 0 Or instr(dominio, ",") > 0 or instr(dominio, ";") > 0 or instr(dominio, ":") > 0 or instr(dominio, "=") > 0 then
           msgErro1 = "<br><br><strong><font color='blue'>Impossível, o dominio <font color='#FF0000'>www."&url_dom&" </font> não está disponível para registro</font><br><br></strong>"
           else
           If InStr(1, Resultado, "No match for domain", vbTextCompare) > 0 Or InStr(1, Resultado, "No match for registrar", vbTextCompare) > 0 or not InStr(1, Resultado, "Domain Name", vbTextCompare) > 0 Or InStr(1, Resultado, "No match for registrar", vbTextCompare) > 0 Then
           msgErro2 = "<br><br><strong><font color='blue'>Parabéns, o dominio <font color='#009900'>www."&url_dom&" </font> disponivel para registro</font><br><br></strong>"
           'ElseIf instr(1,Resultado,"encontrada nenhuma") Then
           Else
           msgErro = "<br><br><strong><font color='blue'>Impossível, o dominio <font color='#FF0000'>www."&url_dom&" </font>já registrado</font><br><br></strong>"
           If InStr(1, Resultado, "NOT AUTHORITATIVE", vbTextCompare) > 0 and InStr(1, Resultado, "No match for domain", vbTextCompare) > 0 and InStr(1, Resultado, "No match for registrar", vbTextCompare) > 0 Then
           ElseIf InStr(1, Resultado, "Domain Name:", vbTextCompare) > 0 or InStr(1, Resultado, "Name Server:", vbTextCompare) > 0 Then
           posInicioDetalhe = InStr(1, Resultado, "Domain Name:", vbTextCompare)
           If posInicioDetalhe > 0 Then
           posFimDetalhe = InStr(1, Mid(Resultado, posInicioDetalhe), "Expiration Date", vbTextCompare) + 29
           End If
           If posFimDetalhe > 0 or posInicioDetalhe > 0 Then
           detalhe = Mid(Resultado, 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
           end if
           end if
           end if
end if
'Aqui verifica extenções .com.br,.adm.br,.br,.org.br,.gov.br,.tv.br

                  else
                   If Len(dominio) < 2 THEN
                   msgErro = "Erro ! O domínio deve possuir pelo menos dois caracteres"
                   ElseIf Len(dominio) > 32 THEN
                   msgErro = "Erro ! O domínio deve possuir no máximo 26 caracteres"
                   Else
                   If instr(dominio, ".") > 0 Or instr(dominio, ",") > 0 or instr(dominio, ";") > 0 or instr(dominio, ":") > 0 or instr(dominio, "=") > 0 then
                   msgErro1 = "<br><br><strong><font color='blue'>Impossível, o dominio <font color='#FF0000'>www."&url_dom&" </font> não está disponível para registro</font><br><br></strong>"
                   else
                   If instr(1,Resultado,"inexistente") Then
                   msgErro2 = "<br><br><strong><font color='blue'>Parabéns, o dominio <font color='#009900'>www."&url_dom&" </font> disponivel para registro</font><br><br></strong>"'        ElseIf instr(1,Resultado,"encontrada nenhuma") Then
                   ElseIf instr(1,Resultado,"encontrada nenhuma") Then
                   msgErro = "Erro ! Sintaxe Inválida "
                   ElseIf instr(1,Resultado,"Como fazer uma consulta") Then
                   msgErro = "Erro ! Sintaxe Inválida "
                   ElseIf instr(1,Resultado,"Primeiro") Then
                   msgErro = "Domínio de Primeiro Nível Inválido"
                   Else
                   msgErro = "<br><br><strong><font color='blue'>Impossível, o dominio <font color='#FF0000'>www."&url_dom&" </font>já registrado</font><br><br></strong>"
                   posInicioDetalhe = InStr(1, Resultado, "domínio:", vbTextCompare)
                   If posInicioDetalhe > 0 Then
                   posFimDetalhe = InStrRev(Mid(Resultado, posInicioDetalhe), "alterado") + 25
                   End If
                   If posFimDetalhe > 0 And posInicioDetalhe > 0 Then
                   detalhe = Mid(Resultado, 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
                   End If
                   End If
                   end if
                   end if
       Set objXML = Nothing        
   end if        
%>
<html>
<head>
<title>Registro de dominios</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<link href="css/show_ads.css" rel="stylesheet" type="text/css" />
<link href="css/generalhs.css" rel="stylesheet" type="text/css" />
<script type="text/javascript" src="prototype.js"></script>
<script type="text/javascript">
function Verifica(event){
var keyCode = event.keyCode ? event.keyCode : event.which ? event.which : event.charCode;
var caract = new RegExp(/[a-z0-9-áéíóúç\b\.-]+$/i);
var caract = caract.test(String.fromCharCode(keyCode));
if(!caract){
// alert("Não digite a extensão do domínio neste campo.\nSelecione a extensão na caixa ao lado.\n\nEm caso de subdomínios, digite apenas a parte principal.\n\nExemplo 1 - Domínio desejado - www.adok.com.br\nDigite apenas 'adok' no campo.\n\nExemplo 2 - Domínio desejado (com subdomínio) - www.suporte.adok.com.br\nDigite apenas 'adok' no campo.");
   keyCode=0;
   return false;
   }
}
function bloqueia(msg){
if(event.button != 1)alert('Acesso negado');
}
   function GetDominio(){    
       if (document.formDom.dominio.value.length ==""){
       alert("Por favor, digite um nome para seu domínio !");
       document.formDom.dominio.focus();
       return false;
       }
           Element.update("content","<span class='txt2'><br /><br />Aguarde, verificando disponibilidade...</span><br /><br /><img src='images/iga_com_br.gif' onmousedown='bloqueia();' width='146' height='12'>");
           var myAjax = new Ajax.Updater({success: 'content'}, 'Checker_dominiospl.asp?dom=<%=request("dominio")%>', { method: 'get', parameters: 'dom='+document.formDom.dominio.value + document.formDom.pont.value});
         }
                   <!--
               var imgmais = new Image();
               var imgmenos = new Image();
               imgmais.src = "../images/mais.gif"
               imgmenos.src = "../images/menos.gif"
               function mostrar_mais(quem,mm){
                   var mmimg = eval(mm+"_mais_menos")
                   if (quem.style.display == "none"){
                       quem.style.display = ""
                       mmimg.src = imgmenos.src
                   }else{
                       quem.style.display = "none"
                       mmimg.src = imgmais.src
                   }
               }
           //-->
</script>
</head>
<body class="tabela01">
<form id="formDom" name="formDom" method="post" onSubmit="return GetDominio(this);">
<table  bordercolor="#336699" align="center" border="0">
<tr><td><img src="images/igad_br.gif" alt="Registro de Domínios" width="495" height="21" /></td></tr>
<tr><td width="495">
Para o seu negócio ter sucesso, é fundamental marcar presença na Web. Possuir um site personalizado e um endereço de e-mail próprio (seunome@seunome.com.br) é o primeiro passo.
<table  border="0" align="center" width="500">
<tr><td align="right" class="txt" width="100%">
<fieldset style="width: 495;" class="fildweb" >
<legend><strong>Verifique se o domínio que você quer registrar está disponível </strong></legend>
<table  border="0" align="center" >
<tr><td align="right" class="txt">Domínio:<strong> www.</strong> </td>
<td><label>
<input name="dominio" type="text" class="camp" id="dominio" size="20" maxlength="59" value="<%=request("dominio")%>" onkeypress="return Verifica(event);">
</label>
<font color="#990000"><strong><font color="#000000">.</font></strong>
<label>
<select id="pont" name="pont" class="text">
<%
lista=".com.br,.com,.net,.org,.info,.name,.adm.br,.br,.net.br,.org.br,.gov.br,.tv.b
r"
MTT="com.br,com,net,org,info,name,adm.br,br,net.br,org.br,gov.br,tv.br"
arrsetor3=split(Request("pont"),", ")
arrsetores3=split(lista,",")
mostra_form=split(MTT,",")
for y = LBOUND(mostra_form) to ubound(mostra_form)
response.write"<option"
for x= LBOUND(arrsetor3) to ubound(arrsetor3)
if arrsetor3(x) = arrsetores3(y) then response.write " selected"
next
response.Write" value="""&arrsetores3(y)
response.write""">"&mostra_form(y)&"</option>"&vbcr
next
%>
</select>
</label>
</font></td>
<td><input name="Button" type="submit" class="bot" value="Procurar" />
</td></tr></table>
</fieldset>
</td></tr>
</table>
<div  id="d1_mais_menos" align="center">
<table  border="0" align="center" width="500">
<tr><td align="left" class="txt" width="100%">        
<div  id="content" align="center">
<div align="center">
<%
if msgErro<>"" then
response.Write(msgErro)
elseif msgErro1<>"" then
response.Write(msgErro1)
elseif msgErro2<>"" then
response.Write(msgErro2)
end if
%>
<div align="left">
<%
if not msgErro ="" then
If InStr(1, Resultado, "No match for domain", vbTextCompare) > 0 Or InStr(1, Resultado, "No match for registrar", vbTextCompare) > 0 or instr(1,Resultado,"inexistente") Then
%>
<a href="contratar_dominio.asp?dom=<%=url_dom%>">Registrar este domínio</a>
<%
else
if msgErro<>"" then
'response.Write("<div id=""d1_mais_menos"">")
response.write "Acesse: <a class=""rteimage"" href="&end_pag&" target=""_blank"">"&url_dom&"</a>  <a class=""rteimage"" onClick=""mostrar_mais(periodo_1,'d1')""><img src=""../images/mais.gif"" name=""d1_mais_menos"" align=""absmiddle"" border=""0"" width=""12"" height=""12""> Mais detalhes</a><br>"
response.write "<div id=""periodo_1"" style=""display:none"">"
response.Write(detalhe)
response.write "</div>"
end if
end if
end if
%>
</div>
</div>
</div>
<br>
</strong>Extensões disponíveis: <font color="#0000FF">.com.br, .adm.br, .br, .net.br, .org, .org.br, .gov.br, .tv.br,</font><br />
</strong>Extensões disponíveis: <font color="#0000FF">.com, .net,  .info, .name</font><br />
</td></tr>
</table>
</div>
</td></tr></table>
</form>
</body>
</html>

Compartilhar este post

Link para o post
Compartilhar em outros sites

saloeric    1

saloeric
Postado

Quando tento veririfar um domínio .com.br da erro na linha 52 (xmlhttp.send)

 

50 - Elseif dominio = ".com.br" then
51 - xmlhttp.Open "GET", "https://registro.br/cgi-bin/whois/lresp?qr="&endereco&dominio, False
52 - xmlhttp.send

 

penso que na classe bastava você alterar


Set xmlhttp = Server.CreateObject("MSXML2.XMLHTTP") 

por 

Set xmlhttp = Server.CreateObject("Msxml2.serverXMLHTTP")

 

 

 

Compartilhar este post

Link para o post
Compartilhar em outros sites

wesleyroverson    0

wesleyroverson
Postado

Cara estou tomando um couro não sei como aplicar pode me auxiliar passo passo tipo.

 

São dois arquivos em pastas diferentes que um chama o outro?

É somente copiar e colocar em uma pagina que ja criei?

 

Att

 

Wesley

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

só colocar o code do post

#5

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito