Keyword Links - Last Update 6/9/08 - Snitz™ Forums 2000

The Forum has been Updated

The code has been upgraded to the latest .NET core version. Please check instructions in the Community Announcements about migrating your account.

Keyword Links - Last Update 6/9/08 - Posted 28 May 2008 16:55 (10457 Views)

cripto9t

Average Member

Posts: 881

881

I'm sure you've been to some web sites where certain keywords are links. Thats what this mod does.

The keywords and urls are stored in an xml file that you will have to create and edit.
Here's a sample

Code:

<?xml version="1.0" encoding="ISO-8859-1"?>

<keywords>

    <!-- Start Keywords -->
    <key>
        <phrase>xml</phrase>
        <url>http://some/site.xml</url>
    </key>
    <key>
        <phrase>html</phrase>
        <url>http://some/site.html</url>
    </key>
    <b><font color="red"><key>
        <phrase>css</phrase>
        <url>http://some/site.css</url>
    </key></font id="red"></b>
</keywords>

Just copy and paste that into your word editor and save it with a .xml extension. The part in red is what you need to worry about when you add a keyword. Just add another <key> tag within the <keywords> tag.
The tag structure is very important and must be maintained.
Make sure the tags are in that order and they all have the closing tags.
Now the easy part. Open "inc_function_common.asp"
<ul>
<li>Find the FormatStr function. find these lines

Code:

function FormatStr(fString)
 on Error resume next

ADD this line right under that

Code:

        fString = ChkKeys(fString)

</li><li>
Add this code before this line "%>" near the bottom of the file.

Code:

Function ChkKeys(fString)
    dim strKeys,strReplace,keywords,keyreplace,objRegex

    'file check
    if ShowKeyWords = False then
        ChkKeys = fString
        Exit Function
    end if

    if trim(Application(strCookieURL & "STRKEYWORDS")) = "" or trim(Application(strCookieURL & "STRKEYREPLACE")) = "" then
 LoadKeywordApps
    end if

    strKeys = Application(strCookieURL & "STRKEYWORDS")
    strReplace = Application(strCookieURL & "STRKEYREPLACE")
    if fString = "" or IsNull(fString) then fString = " "
        keywords = split(strKeys, ",")
        keyreplace = split(strReplace, ",")

    set objRegex = new RegExp
    objRegex.ignorecase = true
    objRegex.global = true

    for i = 0 to ubound(keywords)

        strPattern = "^(" & keywords(i) & ")(\s)"
        strReplace = keyreplace(i) & "$2"
        objRegex.pattern= strPattern
        fString = objRegex.replace(fString,strReplace)

        strPattern = "(" & keywords(i) & ")$"
        strReplace = keyreplace(i)
        objRegex.pattern= strPattern
        fString = objRegex.replace(fString,strReplace)


        fString = Replace(fString, " " & keywords(i) & " ", " " & keyreplace(i) & " ", 1, -1, 1) 
        fString = Replace(fString, " " & keywords(i) & ",", " " & keyreplace(i) & ",", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & ".", " " & keyreplace(i) & ".", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & ":", " " & keyreplace(i) & ":", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & ";", " " & keyreplace(i) & ";", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & "!", " " & keyreplace(i) & "!", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & "?", " " & keyreplace(i) & "?", 1, -1, 1)

        fString = Replace(fString, "-" & keywords(i) & "-", "-" & keyreplace(i) & "-", 1, -1, 1)
        fString = Replace(fString, "-" & keywords(i) & " ", "-" & keyreplace(i) & " ", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & "-", " " & keyreplace(i) & "-", 1, -1, 1)

        fString = Replace(fString, "_" & keywords(i) & "_", "_" & keyreplace(i) & "_", 1, -1, 1)
        fString = Replace(fString, "_" & keywords(i) & " ", "_" & keyreplace(i) & " ", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & "_", " " & keyreplace(i) & "_", 1, -1, 1)

        fString = Replace(fString, "'" & keywords(i) & "'", "'" & keyreplace(i) & "'", 1, -1, 1)
        fString = Replace(fString, "'" & keywords(i) & " ", "'" & keyreplace(i) & " ", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & "'", " " & keyreplace(i) & "'", 1, -1, 1)

        fString = Replace(fString, """" & keywords(i) & """", """" & keyreplace(i) & """", 1, -1, 1)
        fString = Replace(fString, """" & keywords(i) & " ", """" & keyreplace(i) & " ", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & """", " " & keyreplace(i) & """", 1, -1, 1)

        fString = Replace(fString, "(" & keywords(i) & ")", "(" & keyreplace(i) & ")", 1, -1, 1)
        fString = Replace(fString, "(" & keywords(i) & " ", "(" & keyreplace(i) & " ", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & ")", " " & keyreplace(i) & ")", 1, -1, 1)

        fString = Replace(fString, "[" & keywords(i) & "]", "[" & keyreplace(i) & "]", 1, -1, 1)
        fString = Replace(fString, "[" & keywords(i) & " ", "[" & keyreplace(i) & " ", 1, -1, 1)
        fString = Replace(fString, " " & keywords(i) & "]", " " & keyreplace(i) & "]", 1, -1, 1)

        'This line needs repeated parsing misses every other word when a word is repeated
        fString = Replace(fString, " " & keywords(i) & " ", " " & keyreplace(i) & " ", 1, -1, 1)

        'scenario - first word in line
        fString = Replace(fString, chr(13) & chr(10) & keywords(i) & " ", chr(13) & chr(10) & keyreplace(i) & " ", 1, -1, 1)

        'scenario - last word in line
        fString = Replace(fString, " " & keywords(i) & chr(13) & chr(10), " " & keyreplace(i) & chr(13) & chr(10), 1, -1, 1) 

        'scenarion - first and only word in line  
        fString = Replace(fString, chr(13) & chr(10) & keywords(i) & chr(13) & chr(10), chr(13) & chr(10) & keyreplace(i) & chr(13) & chr(10), 1, -1, 1) 
    
        'scenario - first word in line followed by a character 
        fString = Replace(fString, chr(10) & keywords(i) & ".", chr(10) & keyreplace(i) & ".", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & ",", chr(10) & keyreplace(i) & ",", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & "?", chr(10) & keyreplace(i) & "?", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & "!", chr(10) & keyreplace(i) & "!", 1, -1, 1)     
        fString = Replace(fString, chr(10) & keywords(i) & ":", chr(10) & keyreplace(i) & ":", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & ";", chr(10) & keyreplace(i) & ";", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & """", chr(10) & keyreplace(i) & """", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & "'", chr(10) & keyreplace(i) & "'", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & ")", chr(10) & keyreplace(i) & ")", 1, -1, 1)
        fString = Replace(fString, chr(10) & keywords(i) & "]", chr(10) & keyreplace(i) & "]", 1, -1, 1)
          
    next
    set objRegex = nothing

    ChkKeys = fString
End Function

Sub LoadKeywordApps()
    dim strPath,xmlDoc,strErr,NumOfKeys,strKeys,strReplace,iKey
    
    strPath = "<b><font color="green">Absolute address of your Xml file</font id="green"></b>"
    set xmlDoc=CreateObject("Microsoft.XMLDOM")
    xmlDoc.async="false"
    xmlDOc.setProperty "ServerHTTPRequest", true
    xmlDoc.load(strPath)

    if xmlDoc.parseError.errorCode <> 0 Then
        strErr = "<div><b>" & vbNewLine & _
                 "<ul>" & vbNewLine & _
                 "<li>ERROR!</li>" & vbNewLine & _
                 "<li>XML File " & strFileName & " - Failed to validate.</li>" & vbNewLine & _
                 "<li>" & xmlDoc.parseError.reason & "</li>" & vbNewLine & _
                 "<li>Error code: " & xmlDoc.parseError.errorCode & "</li>" & vbNewLine & _
                 "<li>Line: " & xmlDoc.parseError.line & "</li>" & vbNewLine & _
                 "<li>Character: " & xmlDoc.parseError.linepos & "</li>" & vbNewLine & _
                 "<li>Source: " & Chr(34) & xmlDoc.parseError.srcText & Chr(34) & "</li>" & vbNewLine & _
                 "<li>" & Now & "</li>" & vbNewLine & _
                 "</ul>" & vbNewLine & _
                 "</b></div>" & vbNewLine 

        Response.Write strErr
        Response.End
    end if

    set xmlKeyList = xmlDoc.getElementsByTagName("key")

    NumOfKeys = ((xmlKeyList.length) - 1)   '0 based

    strKeys = ""
    strReplace = ""

    for iKey = 0 to cLng(NumOfKeys)
        if strKeys = "" then
            strKeys = xmlKeyList.item(iKey).childNodes(0).text
            strReplace = "<a <b><font color="red">id=""keywords""</font id="red"></b> href=""" & xmlKeyList.item(iKey).childNodes(1).text & """ target=""blank"">"
            strReplace = strReplace & xmlKeyList.item(iKey).childNodes(0).text & "</a>"
        else
            strKeys = strKeys & "," & xmlKeyList.item(iKey).childNodes(0).text
            strReplace = strReplace & ", <a <b><font color="red">id=""keywords""</font id="red"></b> href=""" & xmlKeyList.item(iKey).childNodes(1).text & """ target=""blank"">"
            strReplace = strReplace & xmlKeyList.item(iKey).childNodes(0).text & "</a>"
        end if
    next

    set xmlDoc = nothing

    Application.Lock
    Application(strCookieURL & "STRKEYWORDS") = strKeys
    Application(strCookieURL & "STRKEYREPLACE") = strReplace
    Application.UnLock
End Sub

The part in green has to be replaced with the absolute path to your xml file. The whole address. The part in red adds some style to the links so they will stand out from other links. If your not interested in that just omit the parts in red.</li>
<li>Add this line to the files you want to keywords

Code:

Dim ShowKeyWords : ShowKeyWords = True

Somewhere after <%. In "topic.asp" I added it after these lines

Code:

%>
<!--#INCLUDE FILE="config.asp"-->
<%
<font color="red">Dim ShowKeyWords : ShowKeyWords = True</font id="red">

</li>
<li>
You only need this part if want to add style to your links. Open "inc_header.asp" and find this line

Code:

".spnSearchHighlight {background-color:" & strSearchHiLiteColor & "}" & vbNewLine & _

Add this line right after that

Code:

"#keywords{color:yellow;font-weight:bold;background-color:yellow;)" & vbNewLine & _

</li></ul>Thats it.
Three problems I encountered. 1. An ampersand in the url caused a xml parsing error, so you need to replace it with "& amp;" (without the space). 2. <s>The css class won't trump the existing class, i.e. color and text-decoration.</s> Updated with Bobbys id fix. 3. If the keyword is in a hyperlink it will mess up the link. <ul>
<li>
Updated: 5/29 - Links now open in new windows
css bug fixed
xml bug fixed
<s>add a file exclude list to the function</s> Reworked excludes update 6/9
</li>
<li>
Update 5/30 - "word within word" <s>and "link within link"</s> bug fixed (theres still problems with links)
</li>
<li>
Update 6/9 - Reworked excludes so hopefully it works for everyone. Moved chkKeys() call to the top of formatStr() to check for carrage returns, line feeds before they are replaced. Added more checks to catch more words. </li>
</ul>

_-/Cripto9t\-_

Last edited by cripto9t on 09 June 2008, 15:29

Posted 23 Oct 2011 04:24

Webbo

Average Member

Posts: 982

982

Why move code around and into the config.asp file when it worked well as is? Just curious

Posted 23 Oct 2011 10:33

Carefree

Advanced Member

Posts: 4224

4224

Just to keep dimensioned variables together, easier to eliminate repeats.

Posted 23 Oct 2011 12:25

Webbo

Average Member

Posts: 982

982

Good point