|
WebSiteSearch Object v2.0 [VBScript]purpose:The WebSiteSearch Object is an alternative to, but should not be used as a
substitute for, Microsoft Index Server. If you have no access to Index Server
but still need a way to offer a text search your website, this class is for you.
The current release of WebSiteSearch is 2.0. The other public release was 1.0
which was released in August 2000. I have been using an intermediate version of
the WebSiteSearch, version 1.1, on the ASP Emporium since September. This version
was not released to the public (dispite intense demand for it) because it was a
hack at best - a first attempt at some much needed functionality. Version 1.1
was slow but had some cool features. I also discovered several hacks that could
be implemented in the properties to allow any directory in the web site to be
searched. Version 2.0 adds tons of functionality and also provides a more stable
search that's easier to control programmatically.
v2.0 Features:
The WebSiteSearch Object is, simply put, the best free VBScript search available
on the Web. This fully featured VBScript class allows a programmer to set
properties and call methods to perform complete phrase or multi-word searching
of any text-based file on a web site. The newest version of the software features:
* a simplified programmer's interface with fewer properties to set before using the
class
* regular-expression based searching of files
* smart-search: the class will determine on it's own whether the terms being
searched on will be searched with a WORD or PHRASE query method.
* results display updated: paged results with user sorting options. All found
documents are referenced by their HTML titles and by an optional directory
proper-name.
* multi-level searching: the new version of WebSiteSearch class no longer relies
on a "base directory" as an entry point to searching a website. This allows any
directory in the site to be searched and also allows the class to search outside
of the virtual web directory (ie - all of the server's hard drives - assuming
your permissions allow).
* "Word bug repaired": older versions of the software didn't return results if
only one word is searched on a Query_Method of "Word".
* "AND" and "OR" keyword search options were removed. All searches now take a
search_type of AND to ensure more accurate results.
* Version 2.0 is faster: parsing and searching 200 files, categorizing them,
and displaying results in around 12 seconds. Older versions may have taken up to
30 seconds to do the same work. This speed problem is due to the fact that the
FSO needs a little time to gather and read 200 files. It works much faster on
smaller sites with fewer pages and slower on sites with more pages of content
to search.
* Overall class structure is more mature and stable than previous versions.
What else can I say, it's a sweet package. In 5 minutes, you can configure the
search and then reap the benefits of offering a search to your visitors. Now no
website has an excuse to not have a search engine.
Be sure to view the source code for instructions on how to use the WebSiteSearch
Object programmatically in an ASP file as well as to learn the properties and
methods of the object. I am successfully using the WebSiteSearch v2.0 to power
the ASP Emporium Search.
v2.0 Requirements:
This software requires ADO 2.1 or higher, the Scripting.FileSystemObject and
VBScript 5.5 with the RegExp object installed.
syntax:set object = new WebSiteSearch
example usage:Dim oWSS
Set oWSS = New WebSiteSearch
With oWSS
.MaxResultsPerPage = 15
.Active_Directories = Array( _
Server.MapPath("/") _
)
'.Active_Directories = Array( _
' Server.MapPath("/"), _
' Server.MapPath("/dir/"), _
' Server.MapPath("/dir/dir/") _
' )
.Search_Extensions = Array("htm", "html", "asp")
.Search_Terms = Trim(Request("terms"))
.Perform_Search
End With
Set oWSS = Nothing
source code:<%
Class WebSiteSearch
'#########################
'# WebSiteSearch Class #
'# Version 2.0 #
'# ########################################
'# #
'# #
'# Summary: #
'# This class uses the scripting.filesystemobject #
'# to search an array of directories for files #
'# that contain the entered phrase or words based #
'# on various criteria. #
'# #
'# #
'# Notes/Warnings: #
'# - This class requires several server-side COM objects to #
'# work properly. The following objects are used: #
'# Scripting.FileSystemObject #
'# ADODB.Recordset #
'# #
'# - This system is usually pretty quick however that depends #
'# entirely on how many files the system is to search. #
'# Currently, at the ASP Emporium, this system parses about #
'# 205 documents and returns complete results in about 12 #
'# seconds. This is a dramatic improvement over the older #
'# versions although still too slow in my opinion. #
'# The speed issues come from the FileSystemObject as it #
'# just can't gather content any faster from files. I'm #
'# considering writing a COM object to gather the files #
'# but I'm convinced that further speeding up of the system #
'# will require some sort of caching system that only has #
'# to scan files whenever something is added or changed. #
'# #
'# - Only the latest version of this class is supported. It #
'# is recommended that you upgrade to the newest version #
'# immediately to ensure trouble-free code operation. #
'# #
'# #
'# Version History: #
'# Version 2.0 [January 2001] #
'# - These has been a change in properties and methods. #
'# MAKE SURE YOU LOOK AT THE PROPERTIES AND METHOD SHEET #
'# BELOW BEFORE USING THIS CLASS WITH RUN-TIME CODE FROM #
'# AN OLDER VERSION. #
'# - a simplified programmer's interface with fewer #
'# properties to set before using the class. #
'# - regular-expression based searching of files. #
'# - smart-search: the class will determine on it's own #
'# whether the terms being searched on will be searched #
'# with a WORD or PHRASE query method. #
'# - results display updated: paged results with user #
'# sorting options. All found documents are referenced by #
'# their HTML titles and by an optional directory #
'# proper-name. #
'# - multi-level searching: the new version of WebSiteSearch #
'# class no longer relies on a "base directory" as an #
'# entry point to searching a website. This allows any #
'# directory in the site to be searched and also allows #
'# the class to search outside of the virtual web #
'# directory (ie - all of the server's hard drives - #
'# assuming your permissions allow). #
'# - "Word bug repaired": older versions of the software #
'# didn't return results if only one word is searched on #
'# a Query_Method of "Word". #
'# - "AND" and "OR" keyword search options were removed. All #
'# searches now take a search_type of AND to ensure more #
'# accurate results. #
'# - Version 2.0 is faster: parsing and searching 200 files, #
'# categorizing them, and displaying results in around 12 #
'# seconds. Older versions may have taken up to 30 seconds #
'# to do the same work. This speed problem is due to the #
'# fact that the FSO needs a little time to gather and #
'# read 200 files. It works much faster on smaller sites #
'# with fewer pages and slower on sites with more pages #
'# of content to search. #
'# - Overall class structure is more mature and stable than #
'# previous versions. #
'# #
'# Version 1.1 (not publicly released) [September 2000] #
'# - Search results referenced by html title (if any) #
'# and a description consisting of the first 15 or #
'# so words of the html body (if any). #
'# - Better results display. #
'# - Sub folder search expanded to allow multi-level #
'# directories like "examples\jscript" inside the base #
'# directory. #
'# #
'# Version 1.0 [August 2000] #
'# Initial Release. #
'# #
'# #
'# Properties: #
'# +-------------------+-----------+--------------------------+ #
'# | Property | Data Type | Information | #
'# +-------------------+-----------+--------------------------+ #
'# | Search_Extensions | Variant | Read/Write. Expects an | #
'# | | (Array) | array of file extensions | #
'# | | | to search. These should | #
'# | | | be specified without the | #
'# | | | "." character. | #
'# +-------------------+-----------+--------------------------+ #
'# | Active_Directories| Variant | Read/Write. Expects an | #
'# | | (Array) | array of absolute | #
'# | | | directories (starting | #
'# | | | with a drive letter) to | #
'# | | | search. | #
'# +-------------------+-----------+--------------------------+ #
'# | Search_Terms | String | Read/Write. Sets/Returns | #
'# | | | the text that the class | #
'# | | | will search. | #
'# +-------------------+-----------+--------------------------+ #
'# | ShowParseTime | Boolean | Read/Write. Boolean to | #
'# | | | indicate whether or not | #
'# | | | to time the search. | #
'# | | | If set to true, the time | #
'# | | | in seconds will be | #
'# | | | displayed after any | #
'# | | | search records. | #
'# | | | Default value: False | #
'# +-------------------+-----------+--------------------------+ #
'# | MaxResultsPerPage | Long | Read/Write. Sets/Returns | #
'# | | | the number of search | #
'# | | | results to show on each | #
'# | | | page. | #
'# | | | Default value: 25 | #
'# +-------------------+-----------+--------------------------+ #
'# | Version | String | Read Only. | #
'# | | | Returns "major.minor" | #
'# | | | version information. | #
'# +-------------------+-----------+--------------------------+ #
'# #
'# #
'# Methods: #
'# +----------------+-------------+---------------------------+ #
'# | Method | Data Type | Information | #
'# +----------------+-------------+---------------------------+ #
'# | Perform_Search | Void | Performs the website | #
'# |(Default method)| | search and writes search | #
'# | | | results to the client | #
'# | | | browser. | #
'# +----------------+-------------+---------------------------+ #
'# #
'################################################################
Private oRs, objFSO
Private sBaseQS, sSortQS, hTimer1, hTimer2, bNoSearchArray
Private iPageSize, iPageCurrent, iPageCount, bUseAsc
Private Query_Method
'-----------------
'Public Properties
'-----------------
Public Search_Extensions
Public Active_Directories
Public Search_Terms
Public ShowParseTime
Public MaxResultsPerPage
Public Property Get Version()
'public read-only version property
Version = "2.0"
End Property
'-----------------
'Public Methods
'-----------------
Public Default Sub Perform_Search
Dim i, objSearchFile, objCurrentSearchFolder
iPageSize = MaxResultsPerPage
OpenTmpDatabase
Pre_Processing
bNoSearchArray = False
If Not IsArray(Search_Terms) Then bNoSearchArray = True
' get active_directory property input
' and put it into an array.
' look in each specified directory for files to search
For i = 0 to ubound(Active_Directories)
' create instance of the FSO object
Set ObjFSO = _
Server.CreateObject("Scripting.FileSystemObject")
' take base directory and each directory in the array
' to make up the folder to open
Set objCurrentSearchFolder = _
ObjFSO.GetFolder(Active_Directories(i))
' get each file in the folder to search
For Each objSearchFile In objCurrentSearchFolder.Files
GatherFileAndParse objSearchFile, i
Next
' release the folder and the FSO,
' freeing memory for the next pass
Set objCurrentSearchFolder = Nothing
Set ObjFSO = Nothing
Next
WriteResultantDisplay
End Sub
'-----------------
'Class Events
'-----------------
Private Sub Class_Initialize()
'default property settings
Search_Extensions = Array(".asp")
Query_Method = "WORD" 'phrase
Active_Directories = Array("")
Search_Terms = ""
ShowParseTime = False
MaxResultsPerPage = 25
bUseAsc = False
CreateTmpTable
sBaseQS = "./results.asp?" & _
"terms=" & server.urlencode(request("terms"))
hTimer1 = Timer
If Request("page") = "" Then iPageCurrent = 1 _
Else iPageCurrent = CInt(Request("page"))
If InStr(Right(UCase( _
Request("Sort")), 4), "DESC") = 0 Then bUseAsc = True
End Sub
Private Sub Class_Terminate()
hTimer2 = Timer - hTimer1
If ShowParseTime Then _
Response.Write("Search Took: " & hTimer2 & " seconds")
oRs.Close
Set oRs = Nothing
With Response
.Write("<P><H3><CENTER>")
.Write("<A HREF=""./index.asp"">")
.Write("<FONT COLOR=#0000FF>")
.Write("S E A R C H")
.Write(" ")
.Write("A G A I N")
.Write("</FONT>")
.Write("</A>")
.Write("</CENTER></H3></P>")
End With
End Sub
'-----------------
'Internal Procedures
'-----------------
Private Sub Pre_Processing()
'This routine fixes any Search_Terms
'and determines the Query_Method
'that will be used about the search.
'Query_Method was removed as a property
'and all the processing of the Search_Terms
'property was moved to the class.
'This routine's logic had to be designed
'by each user in previous versions.
'This also changed the data type of the
'Search_Terms property from a variant
'accepting either arrays or strings
'to a string type (if you want to be
'picky about it, the Search_Terms
'property accepts variants of sub-type
'String and Not variants of sub-type
'Array. Clear?)
If InStr(Search_Terms, ",") <> 0 Then
Search_Terms = Split(Search_Terms, ",")
Query_Method = "WORD"
Else
Search_Terms = Trim(Search_Terms)
Query_Method = "PHRASE"
End If
End Sub
Private Sub OpenTmpDatabase()
With oRs
.PageSize = iPageSize
.CacheSize = iPageSize
.Open
End With
End Sub
Private Sub CreateTmpTable()
Set oRs = Server.CreateObject("ADODB.Recordset")
With oRs
.Fields.Append "Page_Path", 200, 255
.Fields.Append "Page_Title", 200, 255
.Fields.Append "Page_Type", 200, 255
End With
End Sub
Private Sub GatherFileAndParse(byRef objSearchFile, byVal i)
Dim m, strTempFile, bDisplayLink, theTitle
' open each file if the extension is to be searched:
For m = 0 to UBOUND(Search_Extensions)
If LCase(Search_Extensions(m)) = _
LCase(Right(objSearchFile.Name, _
Len(objSearchFile.Name) - _
InStrRev(objSearchFile.Name, "."))) Then
strTempFile = MkTmpFile( _
Active_Directories(i) & _
"\" & objSearchFile.Name)
' don't display a link by default
bDisplayLink = False
' check the query_method input
if UCASE(Query_Method) = "PHRASE" And _
bNoSearchArray then
bDisplayLink = PhraseFound( _
strTempFile, Search_Terms)
else
bDisplayLink = WordsFound( _
strTempFile, Search_Terms)
end if
theTitle = Title(strTempFile)
If RedirectFile(theTitle) Then _
bDisplayLink = False
if bDisplayLink then
AddSearchResultRecord _
EscapeApostrophe(CreateHTTPPath( _
objSearchFile.Path)), _
EscapeApostrophe(theTitle), _
EscapeApostrophe(DefineLink( _
objSearchFile.Path))
end if
Exit For
End If
Next
End Sub
Private Sub WriteResultantDisplay()
' write display to the browser
iPageCount = oRs.PageCount
If iPageCurrent > iPageCount Then iPageCurrent = iPageCount
If iPageCurrent < 1 Then iPageCurrent = 1
If iPageCount = 0 or oRs.BOF Then
'in the event of no matches:
ShowNoResults
else
ShowDocsFound
ResolveSortPattern
ShowSortOptions
ShowResults
end if
End Sub
Private Function RedirectFile(sTitle)
If InStr(PCase(sTitle), "Where Am I") <> 0 then
RedirectFile = True
Else
RedirectFile = False
End If
End Function
Private Function WordsFound(byVal toSrch, byVal toFindArray)
Dim iPosLinkCt, j, re
' for a word search we need to check
' each word in the array
' start count of matched words @ -1
iPosLinkCt = -1
' check each word in the array
' against the file text
Set re = New RegExp
With re
.ignorecase = true
.global = false
For j = 0 to UBOUND(toFindArray)
.pattern = "[\b]*" & _
EscapeRegExp(toFindArray(j)) & "\b"
If .test(toSrch) Then _
iPosLinkCt = iPosLinkCt + 1
Next
End With
Set re = Nothing
If CLng(iPosLinkCt) >= CLng(UBound(toFindArray)) Then
WordsFound = True
Else
WordsFound = False
End If
End Function
Private Function EscapeRegExp(byVal sWord)
Dim sTmp
sTmp = Replace(sWord, "\", "\\")
sTmp = Replace(sTmp, "^", "\^")
sTmp = Replace(sTmp, ".", "\.")
sTmp = Replace(sTmp, "*", "\*")
sTmp = Replace(sTmp, "+", "\+")
sTmp = Replace(sTmp, "]", "\]")
sTmp = Replace(sTmp, "[", "\[")
sTmp = Replace(sTmp, "}", "\}")
sTmp = Replace(sTmp, "{", "\{")
sTmp = Replace(sTmp, "(", "\(")
sTmp = Replace(sTmp, ")", "\)")
sTmp = Replace(sTmp, "$", "\$")
sTmp = Replace(sTmp, "?", "\?")
sTmp = Replace(sTmp, "|", "\|")
EscapeRegExp = sTmp
End Function
Private Function PhraseFound(byVal toSrch, byVal toFind)
' check for an instance of the phrase
If InStr(1, toSrch, Trim(toFind), 1) <> 0 then
' if found, display the link
PhraseFound = True
Exit Function
End If
PhraseFound = False
End Function
Private Function MkTmpFile(ByVal sPath)
Dim objTempFile
Set objTempFile = objFSO.OpenTextFile(sPath, 1, False)
With objTempFile
' read the whole file and return it
MkTmpFile = .ReadAll
' close the file
.Close
End With
' release variable
Set objTempFile = Nothing
End Function
Private Sub AddSearchResultRecord(byVal sPath, byVal sTitle, byVal sType)
oRs.AddNew
oRs.fields("Page_Path").value = sPath
oRs.fields("Page_Title").value = sTitle
oRs.fields("Page_Type").value = sType
oRs.Update
End Sub
Private Sub ShowNoResults()
With Response
.Write("<P><CENTER><BIG><B><FONT COLOR=""#60786B"">" & _
"No Matches Found!</FONT></B></BIG></CENTER></P>")
.Flush
End With
End Sub
Private Sub ShowResults()
Dim iRecordsShown
oRs.MoveFirst
oRs.AbsolutePage = iPageCurrent
iRecordsShown = 0
ShowPageNav
do while not oRs.EOF and iRecordsShown < iPageSize
With Response
.Write("<A HREF=""" & UnEscapeApostrophe( _
oRs.Fields("Page_Path").value) & _
"""><BIG><B><FONT COLOR=""#60786B"">" & _
Server.HTMLEncode(UnEscapeApostrophe( _
oRs.Fields("Page_Title").value)) & _
"</FONT></B></BIG></A><BR>[" & _
UnEscapeApostrophe(oRs.Fields("Page_Type").value) & _
"]<BR><A HREF=""" & _
UnEscapeApostrophe(oRs.Fields("Page_Path").value) & _
""" " & _
"STYLE=""color:" & "#60786B;font-size:11pt;"">" & _
"<FONT COLOR=""#CC3300"">" & UnEscapeApostrophe(oRs.Fields( _
"Page_Path").value) & "</FONT></A><BR><BR>")
.Flush
End With
iRecordsShown = iRecordsShown + 1
oRs.MoveNext
Loop
ShowPageNav
End Sub
Private Sub ShowPageNav()
Dim i
If bUseAsc Then sSortQS = sSortQS & "+ASC" Else sSortQS = sSortQS & "+DESC"
Response.Write("<HR SIZE=0><TABLE WIDTH=""100%"" STYLE=""font-size:9pt;" & _
"font-family:tahoma, times, arial;""><TR><TD ALIGN=LEFT>")
Response.Write("Page: <B>" & iPageCurrent & "</B> of <B>" & iPageCount & "</B>")
Response.Write("</TD><TD ALIGN=RIGHT>")
Response.Write("<TABLE STYLE=""font-size:9pt;" & _
"font-family:tahoma, times, arial;""><TR><TD ALIGN=RIGHT>")
If iPageCurrent <> 1 Then
Response.Write("<A HREF=""" & sBaseQS & sSortQS & "&page=" & _
iPageCurrent - 1 & """>< Previous</A> ")
Else
Response.Write(" ")
End If
Response.Write("</TD><TD ALIGN=CENTER>")
For i = 1 to iPageCount
If i <> iPageCurrent Then
Response.Write("<A HREF=""" & sBaseQS & sSortQS & _
"&page=" & i & """>" & i & "</A>")
Else
Response.Write("<B>" & i & "</B>")
End If
If i <> iPageCount Then Response.Write("|")
Next
Response.Write("</TD><TD ALIGN=LEFT>")
If iPageCurrent < iPageCount Then
Response.Write(" <A HREF=""" & sBaseQS & sSortQS & _
"&page=" & iPageCurrent + 1 & """>Next ></A>")
Else
Response.Write(" ")
End If
Response.Write("</TD></TR></TABLE>")
Response.Write("</TD></TR></TABLE><HR SIZE=0>")
End Sub
Private Sub ShowDocsFound()
Response.Write("<B>" & oRs.RecordCount & _
"</B> documents found<BR>")
End Sub
Private Sub ShowSortOptions
Dim noShowPath, noShowTitle, noShowType
Dim noShowASC, noShowDESC
noShowPath = false
noShowTitle = false
noShowType = false
noShowASC = false
noShowDESC = false
Response.Write("Sort: ")
select case Trim(LCase(Left(oRs.Sort, _
InStrRev(oRs.Sort, " "))))
case "page_path": noShowPath = true
case "page_title": noShowTitle = true
case "page_type": noShowType = true
end select
select case Trim(LCase(Right(oRs.Sort, _
Len(oRs.Sort) - InStrRev(oRs.Sort, " "))))
case "asc": noShowASC = True
case "desc": noShowDESC = True
case else: noShowASC = True
end select
if noShowTitle then
Response.Write("<B>By Page Title</B>")
ShowSubSortOptions noShowDESC, noShowASC
else
Response.Write("<A HREF=""" & sBaseQS & _
"&sort=" & server.urlencode("Page_Title") & _
"+ASC"">By Page Title</A>")
end if
Response.Write(" •• ")
if noShowPath then
Response.Write("<B>By Page Path</B>")
ShowSubSortOptions noShowDESC, noShowASC
else
Response.Write("<A HREF=""" & _
sBaseQS & "&sort=" & _
server.urlencode("Page_Path") & _
"+ASC"">By Page Path</A>")
end if
Response.Write(" •• ")
if noShowType then
Response.Write("<B>By Page Type</B>")
ShowSubSortOptions noShowDESC, noShowASC
else
Response.Write("<A HREF=""" & _
sBaseQS & "&sort=" & _
server.urlencode("Page_Type") & _
"+ASC"">By Page Type</A>")
end if
Response.Write("<BR>")
End Sub
Private Sub ShowSubSortOptions(ByVal noShowDESC, ByVal noShowASC)
Response.Write(" [")
If InStr(sSortQS, "+") <> 0 Then
sSortQS = Trim(Left(sSortQS, InStrRev(sSortQS, "+") - 1))
Else
sSortQS = Trim(Left(sSortQS, InStrRev(sSortQS, " ") - 1))
End If
If noShowDESC then
Response.Write("<A HREF=""" & _
sBaseQS & sSortQS & "+ASC"">ASC</A>")
Response.Write(" | ")
Response.Write("<I>DESC</I>")
End if
If noShowASC Then
Response.Write("<I>ASC</I>")
Response.Write(" | ")
Response.Write("<A HREF=""" & sBaseQS & _
sSortQS & "+DESC"">DESC</A>")
End If
Response.Write("]")
End Sub
Private Sub ResolveSortPattern
select case Trim(Request("sort"))
case ""
oRs.Sort = "Page_Title ASC"
case else
On Error Resume Next
oRs.Sort = Request("sort")
If Err Then
Err.Clear
oRs.Sort = "Page_Title ASC"
End If
end select
sSortQS = "&sort=" & server.urlencode(oRs.Sort)
End Sub
Private Function EscapeApostrophe(byVal sIn)
EscapeApostrophe = Replace(sIn, "'", "''")
End Function
Private Function UnEscapeApostrophe(byVal sIn)
UnEscapeApostrophe = Replace(sIn, "''", "'")
End Function
Private Function Title(byVal textToSearch)
Dim re, Matches, tmp, bNoMatch, match
bNoMatch = false
Set re = New RegExp
With re
.ignorecase = true
.global = false
.Pattern = "<title>(.*)</title>"
on error resume next
Set Matches = .execute(trim(textToSearch))
End With
if err then
tmp = ""
bNoMatch = true
else
for each match in matches
tmp = lcase(match.value)
tmp = replace(tmp, "<title>", "")
tmp = replace(tmp, "</title>", "")
tmp = replace(tmp, "the asp emporium -", "")
tmp = replace(tmp, "the asp emporium :", "")
tmp = replace(tmp, "the asp emporium:", "")
tmp = replace(tmp, "the asp emporium > " & _
"useful asp routines >", "")
tmp = replace(tmp, "the asp emporium > " & _
"code library >", "")
tmp = replace(tmp, "the asp emporium >", "")
tmp = replace(tmp, "(.*)", "")
tmp = trim(tmp)
exit for
next
end if
if not bNoMatch then Set Matches = Nothing
Set re = Nothing
if trim(tmp) = "" then tmp = "No Title Available..."
Title = PCase(tmp)
End Function
Private Function PCase(byVal raw)
dim tmp, i, first, others
tmp = split(raw, " ")
for i = 0 to ubound(tmp)
first = ""
others = ""
first = UCase(left(tmp(i), 1))
others = LCase(mid(tmp(i), 2))
tmp(i) = CStr(first & others)
next
PCase = Join(tmp, " ")
End Function
Private Function CreateHTTPpath(strInput)
' this function takes a mappath path and
' makes it usable as a link to an actual file
Dim strRoot, strRoot2
strRoot = server.mappath("/")
strRoot2 = replace(lcase(strInput), lcase(strRoot), "")
CreateHTTPpath = replace(strRoot2, "\", "/")
End Function
Private Function DefineLink(strPath)
' try to figure out what type of file this is
' based on the path
Dim sPath
sPath = CreateHTTPPath(strPath)
sPath = Mid(sPath, 1, InStrRev(sPath, "/"))
DefineLink = TranslatePath(sPath)
End Function
Private Function TranslatePath(strInput)
' translate the example folder
' to a more descriptive phrase
Select Case LCASE(strInput)
Case "/aspemporium/help/"
TranslatePath = "ASP Tips and Hints (Help)"
Case "/aspemporium/tutorials/", _
"/aspemporium/tutorials/ssi/"
TranslatePath = "ASP or VBSCRIPT Tutorial"
Case "/aspemporium/codelib/"
TranslatePath = "VBScript Code Library"
Case "/aspemporium/examples/jscript/"
TranslatePath = "JScript ASP Example"
Case "/aspemporium/examples/", _
"/aspemporium/search/", _
"/aspemporium/examples/easyads/", _
"/aspemporium/examples/numberarraytool/", _
"/aspemporium/examples/quiz/", _
"/aspemporium/examples/xmlcatalog/"
TranslatePath = "VBScript ASP Example"
case "/aspemporium/help/err/db/", _
"/aspemporium/help/err/vbs/", _
"/aspemporium/help/err/asp/", _
"/aspemporium/help/err/"
TranslatePath = "HELP - Listing of " & _
"Fixes by Error Message"
Case "/aspemporium/index/"
TranslatePath = "ASP Emporium Site Index"
Case Else
TranslatePath = strInput
End Select
End Function
End Class
%>
|
