Recuperar tag title e meta de um site

[webfuture 0]

Olá pessoal, estou montando um projeto que preciso recuperar algumas tags de um documento html, sei que o asphttp me retorna a pagina por completo, porem precisaria pegar somente algumas tags deste documento, por exemplo a tag title e algumas das metas.

 

Alguém ja fez isto ou sabe como fazer?

 

Imaginei fazer algo como:

 

strTitle = HTTPObj.GetHeader("title")

response.write strTitle

 

Mas travou por aqui, não sei se da certo ou se tem como fazer isto com este componente, ou tem um outro que possa fazer isto...

 

Se precisarem de mais detalhes posso passar....

 

Xavier

[Ted k' 126]

exemplo do Ted

 

Set objXMLHTTP = CreateObject("Msxml2.XMLHTTP")
	Url = "http://globoesporte.globo.com/Esportes/Futebol/Classificacao/0,,ESP0-9827,00.html"
	objXMLHTTP.Open "GET", URL, FALSE
	objXMLHTTP.send()
	conteudo = objXMLHTTP.responseText
	set objXMLHTTP = nothing
	
	
	
	posicao = instr(conteudo,"tabela-classificacao-futebol-new")
	total = len(conteudo)
	conteudo = mid(conteudo,posicao,total)  
	Response.Write("<table><tr>")  
	Response.Write("<td>"&conteudo&"</td>")
	Response.Write("</tr></table>")

[xanburzum 169]

Olha este código, tem uma classe onde você invoca ela na pagina demo.asp, nele tem um form, onde você coloca, a url e ele retorna o Title, , Keywords, Description, tudo separado e muito mais, segue o código.

 

demo.asp

<!--#INCLUDE FILE="clsHTMLParser.asp"-->
<%
Dim StrURL
Dim StrHTML
Dim ObjParser

StrURL = Request.QueryString("URL")
%>
<H1></H1>
<P>

Este script irá solicitar a página do servidor especificado no URL e analisar o título, descrição e palavras-chave para você
</P>
<FORM>
	<INPUT size="50" name="URL" value="<%=StrURL%>"><BR>
	<INPUT type="Submit" value="Parse">
</FORM>
<BR><BR>
<%
If Not StrURL = "" Then
	Set ObjParser = New clsHTMLParser
	With ObjParser
		StrHTML = .GetURL(StrURL)
		%>
		<TABLE border="1">
			<TR>
				<TD>Title</TD>
				<TD><%=.Title%></TD>
			</TR>
			<TR>
				<TD>Keywords</TD>
				<TD><%=.Keywords%></TD>
			</TR>
			<TR>
				<TD>Description</TD>
				<TD><%=.Description%></TD>
			</TR>
		</TABLE>
		<HR>
		<%
		Response.Write Replace(Server.HTMLEncode(StrHTML), vbCrLf, "<BR>")
	End With
	Set ObjParser = Nothing
End If
%>

classe clsHTMLParser.asp

 

<%
' ------------------------------------------------------------------------------
Class clsHTMLParser
' ------------------------------------------------------------------------------
	Private mStrHTML
	Private mObjRegExp
	Private mObjMatches
	Private mObjMatch
	Public Title
	Public Keywords
	Public Description
' ------------------------------------------------------------------------------
	Public Property Let HTML(ByRef pStrHTML)
		mStrHTML = pStrHTML

		Set mObjRegExp = New RegExp
		mObjRegExp.IgnoreCase = True

		Call ParseTitle()
		Call ParseDescription()
		Call ParseKeywords()

		Set mObjMatch = Nothing
		Set mObjMatches = Nothing
		Set mObjRegExp = Nothing

	End Property
' ------------------------------------------------------------------------------
	Public Property Get HTML()
		HTML = mStrHTML
	End Property
' ------------------------------------------------------------------------------
	Private Sub ParseTitle()
		Title = ""
		mObjRegExp.Pattern = "<TITLE>([^<]*)</TITLE>"
		Set mObjMatches = mObjRegExp.Execute(mStrHTML)
		If mObjMatches.Count = 0 Then Exit Sub
		Title = mObjMatches.item(0).Value
		Title = Replace(Title, "<TITLE>", "", 1, -1, vbTextCompare)
		Title = Replace(Title, "</TITLE>", "", 1, -1, vbTextCompare)
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseDescription()
		Description = ""
		mObjRegExp.Pattern = "<META[^>]+(name=""description""|content=""([^""]*)"")[^>]+(name=""description""|content=""([^""]*)"")[^>]*>"
		Set mObjMatches = mObjRegExp.Execute(mStrHTML)
		If mObjMatches.Count = 0 Then Exit Sub
		Description = mObjMatches.item(0).Value
		Description = Mid(Description, InStr(1, Description, "content=""", vbTextCompare) + 9)
		Description = Mid(Description, 1, InStr(1, Description, """", vbTextCompare) -1)
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseKeywords()
		Keywords = ""
		mObjRegExp.Pattern = "<META[^>]+(name=""keywords""|content=""([^""]*)"")[^>]+(name=""keywords""|content=""([^""]*)"")[^>]*>"
		Set mObjMatches = mObjRegExp.Execute(mStrHTML)
		If mObjMatches.Count = 0 Then Exit Sub
		Keywords = mObjMatches.item(0).Value
		Keywords = Mid(Keywords, InStr(1, Keywords, "content=""", vbTextCompare) + 9)
		Keywords = Mid(Keywords, 1, InStr(1, Keywords, """", vbTextCompare) -1)
	End Sub
' ------------------------------------------------------------------------------
	Public Function GetURL(ByRef pStrURL)

		Dim lObjSpider
		Dim strText

		If pStrURL = "" Then Exit Function

		On Error Resume Next

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

		' Could not create Internet Control
		If Err Then
			GetURL = "Error: " & Err.Description
			Exit Function
		End If
		
		On Error Goto 0

		With lObjSpider
			.Open "GET", pStrURL, False, "", ""
			.Send
			GetURL = .ResponseText
		End With
		Set LobjSpider = Nothing

		HTML = GetURL
		
	End Function
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>