Public feed #721552

Anonymous

public text v1 · immutable
Raw Edit
·published 2007-10-01 10:17 UTC
rendered paste body
' Deklaration av varibler
Dim metaKeywordsData
Dim metaKeywordsArray
Dim metaKeywords
Dim max
Dim n

' Hämta datan som ska användas för att extrahera keywords (T.ex. titlar, sidinnehåll m.m.)
metaKeywordsData = pageTitle & " " & pageContents
metaKeywords = ""

' Tar bort alla HTML-taggar
Set RegularExpressionObject = New RegExp
With RegularExpressionObject
.Pattern = "<(.|\n)+?>"
.IgnoreCase = True
.Global = True
End With
metaKeywordsData = RegularExpressionObject.Replace(metaKeywordsData, "")
Set RegularExpressionObject = nothing


' Ersätter alla mellanslag som är 2 eller fler i följd med ett ''(Det är förmodligen bättre att använda trim() för detta.)
Set RegularExpressionObject = New RegExp
With RegularExpressionObject
.Pattern = "\s{2,}"
.IgnoreCase = True
.Global = True
End With
metaKeywordsData = RegularExpressionObject.Replace(metaKeywordsData, " ")
Set RegularExpressionObject = nothing

' Ta bort radbrytningar
metaKeywordsData = Replace(metaKeywordsData, vbcrlf, "")

' Ta bort   (HTML entity för mellanslag) 
metaKeywordsData = Replace(metaKeywordsData, "&nbsp;", " ")

' Ersätt kommatecken med ett mellanslag (underlättar för split() senare)
metaKeywordsData = Replace(metaKeywordsData, ", ", " ")
metaKeywordsData = Replace(metaKeywordsData, ",", " ")

' Ta bort punkter
metaKeywordsData = Replace(metaKeywordsData, ".", "")

' Sätt in 15 av orden i en array, eller samtliga ifall det finns mindre än 15
metaKeywordsArray = Split(metaKeywordsData, " ")

max = ubound(metaKeywordsArray) - lbound(metaKeywordsArray)
if(max) > 15 then
    max = 15
end if

for n = lbound(metaKeywordsArray) to max
    if(Len(metaKeywordsArray(n)) > 3) then
        metaKeywords = metaKeywords & metaKeywordsArray(n) & ","
    end if
next

' Konvertera nyckelordstexten till gemener
metaKeywords = LCase(metaKeywords)

' Ta bort det sista kommatecknet
metaKeywords = Left(metaKeywords, Len(metaKeywords)-1)