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
<?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 linesfunction FormatStr(fString)
on Error resume next
ADD this line right under thatfString = ChkKeys(fString)
</li><li>
Add this code before this line "%>" near the bottom of the file.
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 keywordsDim ShowKeyWords : ShowKeyWords = True
Somewhere after <font color="red"><%</font id="red">. In "topic.asp" I added it after these lines%>
<!--#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".spnSearchHighlight {background-color:" & strSearchHiLiteColor & "}" & vbNewLine & _
Add this line right after that"#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>