Ir para conteúdo

POWERED BY:

Arquivado

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

xanburzum

[Resolvido] analisar os META-NAME

Por , em ASP Clássico

Recommended Posts

xanburzum    169

xanburzum
Postado

Você pode analisar os nomes de meta de seu site ou uma URL externa,este Script pode exibir o título, descrição e palavras-chave da página selecionada

 

<html>
<head>
<title>META-NAME PARSER</title>
</head>
<br/>
<body><br/><h1>META-NAME PARSER</h1><br/>
<form method="POST" action="META-NAME PARSER.asp">
<br/> 
 <p><input type="text" name="url" size="45">
 <input type="submit" value="PARSE" name="func">
 </p>
 </form>
 <%if request.form("func") = "PARSE" then  
 Set objCon = Server.CreateObject ("Microsoft.XMLHTTP")
   objCon.Open "GET", request.form("url"), False, "", "" 
    objCon.Send  
	strPage = objCon.ResponseText
	Set objRegExp = New RegExp 
	 objRegExp.IgnoreCase = True 
	    objRegExp.Pattern = "<TITLE>([^<]*)</TITLE>"  
		Set objMatch = objRegExp.Execute(strPage)
		  if objMatch.Count = 0 Then 
		    response.write "Título não encontrado .. "
			else  
			 strTitle = objMatch.item(0).Value  
			  strTitle = Replace(strTitle, "<TITLE>", "", 1, -1, vbTextCompare)
			    strTitle = Replace(strTitle, "</TITLE>", "", 1, -1, vbTextCompare) 
				  response.write strTitle & "<br><br>"
				  end if  
objRegExp.Pattern = "<META[^>]+(name=""description""|content=""([^""]*)"")[^>]+(name=""description""|content=""([^""]*)"")[^>]*>" 

Set objMatch = objRegExp.Execute(strPage)
  if objMatch.Count = 0 Then 
    response.write "Descrição não encontrada .." & "<br><br>"  
	 else
	 strDesc = objMatch.item(0).Value 
	   strDesc = Mid(strDesc, InStr(1, strDesc, "content=""", vbTextCompare) + 9)
	      strDesc = Mid(strDesc, 1, InStr(1, strDesc, """", vbTextCompare) -1)   
		     response.write strDesc & "<br><br>" 
			  end if
			objRegExp.Pattern = "<META[^>]+(name=""keywords""|content=""([^""]*)"")[^>]+(name=""keywords""|content=""([^""]*)"")[^>]*>" 
			Set objMatch = objRegExp.Execute(strPage) 
			 if objMatch.Count = 0 Then 
			   response.write "Keywords não encontrada .. "  
			    else
		strKeywords = objMatch.item(0).Value 
strKeywords = Mid(strKeywords, InStr(1, strKeywords, "content=""", vbTextCompare) + 9)
strKeywords = Mid(strKeywords, 1, InStr(1, strKeywords, """", vbTextCompare) -1)
response.write strKeywords & "<br><br>" 
		   end if
		   end if
		   %> 
           </body>
           </html>

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