Keyword Links - Last Update 6/9/08 - Posted (10456 Views)
cripto9t
Average Member
cripto9t
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 <b><font color="red">red</font id="red"></b> 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 <b><font color="green">green</font id="green"></b> has to be replaced with the <b><u>absolute path</u></b> to your xml file. <b><u>The whole address</u></b>. The part in <b><font color="red">red</font id="red"></b> 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 <b><font color="red">red</font id="red"></b>.</li>
<li>Add this line to the files you want to keywords
Code:
Dim ShowKeyWords : ShowKeyWords = True
Somewhere after <font color="red"><%</font id="red">. 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>
<u>Updated: 5/29</u> - 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>
<u>Update 5/30</u> - "word within word" <s>and "link within link"</s> bug fixed (theres still problems with links)
</li>
<li>
<u>Update 6/9</u> - 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
 Sort direction, for dates DESC means newest first  
 Page size 
Posted
leatherlips
Senior Member
leatherlips
Posts: 1838
1838
This looks like a really cool mod. I tried to add it but now my forum looks like this:


Not sure what I did wrong.<
Mangione Magic Forum - The Music of Chuck Mangione
My Mods: Googiespell MOD | Link To Reply MOD | Petition MOD | Contact Page MOD | Share This Topic MOD | MP3 MOD | PageEar MOD | Google Viewer MOD
Last edited by leatherlips on 28 May 2008, 19:11
Posted
leatherlips
Senior Member
leatherlips
Posts: 1838
1838
I tried it again but this time I added a <% above the code and the %> below the code. It got rid of the formatting issue but then every post had the error message you have in the inc_func_common.asp code including the bios in the profiles.<
Mangione Magic Forum - The Music of Chuck Mangione
My Mods: Googiespell MOD | Link To Reply MOD | Petition MOD | Contact Page MOD | Share This Topic MOD | MP3 MOD | PageEar MOD | Google Viewer MOD
Last edited by leatherlips on 28 May 2008, 19:33
Posted
cripto9t
Average Member
cripto9t
Posts: 881
881
What is the error? The xml errors I've got so far have been pretty straight forward, so it's been pretty easy figuring out what's wrong.
I need to handle the error msg better, so it doesn't shut down the thread.

I tried it again but this time I added a <% above the code and the %> below the code.
What code did you add that too?<
    _-/Cripto9t\-_
Posted
leatherlips
Senior Member
leatherlips
Posts: 1838
1838
This is the error I am getting:

ERROR!
XML File - Failed to validate.
No data is available for the requested resource.
Error code: -2146697209
Line: 0
Character: 0
Source: ""
5/28/2008 5:28:04 PM

I added the <% and %> before and after the code added near the bottom of inc_func_common.asp

Here is a link so you can see what it is doing:

http://www.mangionemagic.com/forumfortesting/topic.asp?TOPIC_ID=765<
Mangione Magic Forum - The Music of Chuck Mangione
My Mods: Googiespell MOD | Link To Reply MOD | Petition MOD | Contact Page MOD | Share This Topic MOD | MP3 MOD | PageEar MOD | Google Viewer MOD
Posted
AnonJr
Forum Moderator
AnonJr
Posts: 5768
5768
Post a link to the xml file, I bet your problem is in there...<
Posted
leatherlips
Senior Member
leatherlips
Posts: 1838
1838
Here is my xml file:

http://www.mangionemagic.com/forumfortesting/autolinkterms.xml

I only added a few keywords while testing.<
Mangione Magic Forum - The Music of Chuck Mangione
My Mods: Googiespell MOD | Link To Reply MOD | Petition MOD | Contact Page MOD | Share This Topic MOD | MP3 MOD | PageEar MOD | Google Viewer MOD
Posted
bobby131313
Senior Member
bobby131313
Posts: 1163
1163
It's working for me but now my forum variables are stuck on the contents of the first xml file I uploaded. I can't get it to change (ran setup.asp, no go) as I add phrases. Nothing seems to change it and new phrases don't work.
Oh, and thank you very much for putting this together!<
Switch the order of your title tags
Posted
AnonJr
Forum Moderator
AnonJr
Posts: 5768
5768
Originally posted by leatherlips
Here is my xml file:

http://www.mangionemagic.com/forumfortesting/autolinkterms.xml

I only added a few keywords while testing.
Nothing jumps out as being wrong... but something is causing the XML parser some heartburn. I wonder if its a problem with the version of the XML parser you're using.<
Posted
phy1729
Average Member
phy1729
Posts: 589
589
Other than the fact that there's no DTD or Schema I don't see anything wrong.<
Posted
cripto9t
Average Member
cripto9t
Posts: 881
881
leatherlips, this is the solution ms support gives for that error.
After this line in LoadKeywordApps()
Code:
xmlDoc.async="false"
Add this line
Code:
xmlDoc.setProperty "ServerHTTPRequest", true
Hope that helps

Bobby, for testing, comment out the "if" and "end if" lines.
Code:
    'if trim(Application(strCookieURL & "STRKEYWORDS")) = "" or trim(Application(strCookieURL & "STRKEYREPLACE")) = "" then
	LoadKeywordApps
    'end if
That way the apps will reload every refresh or page view. Be sure to uncomment when your through smile.

phy, DTD schema, maybe later wink.<
    _-/Cripto9t\-_
You Must enter a message