Pacote completo de rotinas para parse de arquivos HTML

<% ' Project: HTML Parsing Functions Include ' Creator: James Lindën ' Date: 3/20/01 3:59am '******************************************************************************************* ' ParseComment Removes HTML comments ParseComment(String) ' ParseHTML Removes HTML tags ParseHTML(String) ' ParseTitle Returns HTML title ParseTitle(String) ' ParseKeyword Returns HTML keyword meta tag ParseKeyword(String) ' ParseDescription Returns HTML description meta tag ParseDescription(String) ' ParseAuthor Returns HTML author meta tag ParseAuthor(String) ' ParseRobot Returns HTML robot meta tag ParseRobot(String) ' CleanHTML Removes HTML characters CleanHTML(String) ' CleanString Used by other functions '******************************************************************************************* Public Const bPar = "<title>" Public Const ePar = "</title>" Public Const bKey = "name=keywords" Public Const bRob = "name=robots" Public Const bAut = "name=author" Public Const bDes = "name=description" Public Const bCon = "content=" '******************************************************************************************* 'The ParseHTML() function removes html tags from a string and returns a string variable Public Function ParseHTML(myString) ParseHTML = CleanString(Chr(60), Chr(62), myString, True) End Function '******************************************************************************************* 'The ParseComment() function removes html comments from a string and returns a string variable Public Function ParseComment(myString) ParseComment = CleanString(Chr(60) & Chr(33) & String(2, Chr(45)), String(2, Chr(45)) & Chr(62), myString, True) End Function '******************************************************************************************* 'The ParseTitle() function will get the title of an html document and return it as a string variable Public Function ParseTitle(myString) myBeg = InStr(LCase(myString), bPar) + Len(bPar) myEnd = InStr(myBeg, LCase(myString), ePar) If myBeg > 0 And myEnd > myBeg Then ParseTitle = Trim(Mid(myString, myBeg, myEnd - myBeg)) Else ParseTitle = "FAIL: title not present" End If End Function '******************************************************************************************* 'The ParseKeyword() function will get the keywords metatag of a html document and return it as a string variable 'if the metatag is not present the function will return a fail message Public Function ParseKeyword(myString) myString = Replace(Replace(myString, Chr(34), ""), Chr(39), "") If InStr(LCase(myString), bKey) Then myBeg = InStr(InStr(LCase(myString), bKey), LCase(myString), bKey) + Len(bKey) myEnd = InStr(myBeg, myString, Chr(62)) ParseKeyword = Trim(Replace(Mid(myString, myBeg, myEnd - myBeg), bCon, "")) Else ParseKeyword = "FAIL: keywords not present" End If End Function '******************************************************************************************* 'The ParseDescription() function will get the description metatag of a html document and ' return it as a string variable 'if the metatag is not present the function will return a fail message Public Function ParseDescription(myString) myString = Replace(Replace(myString, Chr(34), ""), Chr(39), "") If InStr(LCase(myString), bDes) Then myBeg = InStr(InStr(LCase(myString), bDes), LCase(myString), bDes) + Len(bDes) myEnd = InStr(myBeg, myString, Chr(62)) ParseDescription = Trim(Replace(Mid(myString, myBeg, myEnd - myBeg), bCon, "")) Else ParseDescription = "FAIL: description not present" End If End Function '******************************************************************************************* 'The ParseAuthor() function will get the author metatag of a html document and ' return it as a string variable 'if the metatag is not present the function will return a fail message Public Function ParseAuthor(myString) myString = Replace(Replace(myString, Chr(34), ""), Chr(39), "") If InStr(LCase(myString), bAut) Then myBeg = InStr(InStr(LCase(myString), bAut), LCase(myString), bAut) + Len(bAut) myEnd = InStr(myBeg, myString, Chr(62)) ParseAuthor = Trim(Replace(Mid(myString, myBeg, myEnd - myBeg), bCon, "")) Else ParseAuthor = "FAIL: author not present" End If End Function '******************************************************************************************* 'The ParseRobot() function will get the robots metatag of an html document ' and return it as a string variable 'if the metatag is not present the function will return a fail message Public Function ParseRobot(myString) myString = Replace(Replace(myString, Chr(34), ""), Chr(39), "") If InStr(LCase(myString), bKey) Then myBeg = InStr(InStr(LCase(myString), bRob), LCase(myString), bRob) + Len(bRob) myEnd = InStr(myBeg, myString, Chr(62)) ParseRobot = Trim(Replace(Mid(myString, myBeg, myEnd - myBeg), bCon, "")) Else ParseRobot = "FAIL: robots not present" End If End Function '******************************************************************************************* 'The CleanHTML() function will remove common html character codes and returns a string variable Public Function CleanHTML(myString) nString = Replace(Replace(myString, "&nbsp;", Chr(32)), "&copy;", "(c)") nString = Replace(Replace(nString, "&trade;", "(tm)"), "&#153;", "(tm)") nString = Replace(Replace(nString, "&quot", Chr(34)), "&amp;", Chr(38)) nString = Replace(Replace(nString, "lt;", Chr(60)), "&gt;", Chr(62)) nString = Replace(Replace(nString, Chr(174), "(r)"), String(2, Chr(32)), Chr(32)) CleanHTML = nString End Function '******************************************************************************************* Public Function CleanString(xString0, xString1, xString2, xString3) Dim mySlices, myX Set Reg = Server.CreateObject("VBScript.RegExp") Set Reg1 = Server.CreateObject("VBScript.RegExp") Reg.IgnoreCase = True Reg.Pattern = xString0 Reg.MultiLine = True Reg.Global = True Reg1.IgnoreCase = True Reg1.Pattern = xString1 Reg1.MultiLine = True Reg1.Global = True If Reg.Test(xString2) And Reg1.Test(xString2) Then Set myList = Reg.Execute(xString2) For Each Match In myList mySpot = InStr(mySpot + 1, xString2, Match) myTags1 = myTags1 & mySpot & "," Next myTags1 = Split(Left(myTags1, Len(myTags1) - 1), ",") mySpot = 0 Set myList2 = Reg1.Execute(xString2) For Each Match In myList2 mySpot = InStr(mySpot + 1, xString2, Match) myTags2 = myTags2 & mySpot & "," Next myTags2 = Split(Left(myTags2, Len(myTags2) - 1), ",") If UBound(myTags1) = UBound(myTags2) Then For Idx = LBound(myTags2) To UBound(myTags2) myTags = myTags & Mid(xString2, myTags1(Idx), myTags2(Idx) - myTags1(Idx) + Len(Reg1.Pattern)) & "," Next myTags = Split(Left(myTags, Len(myTags) - 1), ",") If xString3 Then myX = xString2 For Each Item In myTags myX = Replace(myX, Item, "") Next endStr = myX Else endStr = Join(myTags, Chr(46) & Chr(32)) End If Else endStr = xString2 End If Else endStr = xString2 End If Set Reg = Nothing Set Reg1 = Nothing CleanString = endStr End Function %>

Quebra-Linha

Colaborador..: Adenilton Rodrigues
Categoria(s).: ASP;
Data.........: 11/04/2002 15:37:55
Visualizado..: 378 vezes
Fonte........: http://www.asp-help.com/