Asp Breadcrumb Class

Background

My current employer Etelesolv (www.etelesolv.com) had a client that, as part of their new website, required that required breadcrumb nav. The project was to use ASP .

I had used the BreadCrumbs PHP Class, by Richard Baskitt, for a couple of projects and I wanted to have a class similar to it that would easily implement this type of navigation. The closest thing I could find on the web was Adrian Roselli's "Breadcrumbs for Those Using ASP" evolt.org article.

So I proceded to use the Breadcrumb PHP Class model and implement some of Adrien's string manipulation methods with a touch of ASP 101 for the PCase method,

to create a reusable piece of code that our developers could use on any of their projects. I now share it with you.... (dramatic reverberation)

Here is the code:

<%
'BreadCrumb Class v1.0
'Created by Jason Irving Copyright 2005 - pittster@hotmail.com
'Last Update January 24, 2005
'This class was heavily influenced by Breadcrumbs PHP Class @ http://www.baskettcase.com/classes/breadcrumb/
'the build method was inspired by breadcrumb.asp  Version 1.0 by  Adrian Roselli  adrian@roselli.org  @ http://www.evolt.org/article/Breadcrumbs_for_Those_Using_ASP/17/4438/
'********Properties
'cssClass : string - css stylesheet class for the <a> tag
'to separate the style for the delimiter, use the following css syntax example
' mystyle { color: blue; }
' mystyle a {color: red; }
' the delimiter will be in the first style, the link in the second
'Homepage : string - name of the homepage
'Uscore2Space : boolean string (1, yes, true) - replace underscores with " " space
'wordCase : string (mixed, upper, lower) - 
'Delimiter : string - the text delimiter between elements
'showFiles : boolean string (1, yes, true) - append the name of the viewed file to menu
'showFilesNoExt: boolean string (1, yes, true) - append the name of the viewed file to menu without extension, overrides showFiles
'
'*********Methods
'build() - print the menu
'changeName : string tag, string, str - Hashtable of elements and replacement words
class clsBreadCrumb
	Private strDelimiter
	Private dictReplaceWords
	Private strPath
	Private strCSSClass
	Private strHomePage 
	Private bolUscore2Space
	Private bolShowFiles
	Private bolShowFilesNoExt
	Private strCaseFormat
	
	Private Sub Class_Initialize()
	strCSSClass = "" 
	strHomePage = "home" 
	strPath = Request.ServerVariables("PATH_INFO")
	bolUscore2Space = "1" 
	strCaseFormat = "mixed"
	bolShowFiles = "1"
	bolShowFilesNoExt = "0"
	strDelimiter = ">"
	set dictReplaceWords = Server.CreateObject("Scripting.Dictionary")
	End Sub
	
	Private Sub Class_Terminate()
	dictReplaceWords = nothing
	End Sub
	'*********Properties*************
	
	'*****SET
	Public Property Let cssClass(str)
		strCSSClass = " class='" & str & "'"
	End Property
	
	Public Property Let Homepage(str)
		strHomePage = str
	End Property
	
	Public Property Let showFiles(str)
		if lcase(trim(str)) = "1" or lcase(trim(str)) = "yes" or lcase(trim(str)) = "true" then
			bolShowFiles = 1
		else
			bolShowFiles = 0
		end if
	End Property
	
	Public Property Let showFilesNoExt(str)
		if lcase(trim(str)) = "1" or lcase(trim(str)) = "yes" or lcase(trim(str)) = "true" then
			bolShowFilesNoExt = 1
		else
			bolShowFilesNoExt = 0
		end if
	End Property
	
	Public Property Let Uscore2Space(str)
		if lcase(trim(str)) = "1" or lcase(trim(str)) = "yes" or lcase(trim(str)) = "true" then
			bolUscore2Space = 1
		else
			bolUscore2Space = 0
		end if
	End Property
	
	Public Property Let wordCase(str)
		if lcase(trim(str)) = "mixed" or lcase(trim(str)) = "upper" or lcase(trim(str)) = "lower" then
			strCaseFormat = lcase(trim(str))
		else
			strCaseFormat = "mixed"
		end if
	End Property
	
	Public Property Let Delimiter(str)
		strDelimiter = Server.HTMLEncode(trim(str))
	End Property
	
'*********Methods*************
	Public Function changeName(tag,str)
		dictReplaceWords.add lcase(tag), lcase(str)
	End Function
	
Public Function Build()
dim tmpPath
dim strTmpPath
dim DirPath
dim FullPath
dim strContent
FullPath = strPath
response.write ("")
Do Until instr(1,FullPath,"/") = 0
	'Split the string on the "/"
	strTmpPath = Trim(mid(FullPath,1,instr(1,FullPath,"/")-1))
	DirPath = DirPath & strTmpPath & "/"
	'Replace the underscore with a space if the option is set
	
	if bolUscore2Space = 1 then
	strTmpPath = Replace(Trim(strTmpPath),"_"," ")
	end if
	
	
	if dictReplaceWords.exists(lcase(strTmpPath)) then
	strTmpPath = dictReplaceWords.item(strTmpPath)
	end if
	
	'Apply the appropriate case to the entry
	
	'get the next directory	
	FullPath = mid(FullPath,instr(1,FullPath,"/")+1,Len(FullPath)-Len(tmpPath))
	
	'create the filename entry if applicable
	dim tmpFileName
	dim tmpFileNameLabel
	
	tmpFileName = FullPath
	
	if instr(1,tmpFileName,"/") = 0 then
		if bolShowFilesNoExt = "1" then
			dim intPos
			intPos = InStrRev(tmpFileName , ".", -1, 1)
	    	if intPos > 0 Then
		        tmpFileNameLabel = Left(tmpFileName , intPos - 1)
			end if
		else
			tmpFileNameLabel = tmpFileName
		end if
	else
		tmpFileName = ""
	end if
	
	select case lcase(strCaseFormat)
	case "mixed"
	strTmpPath = PCase(strTmpPath)
	strHomePage = PCase(strHomePage)
	case "upper"
	strTmpPath = UCase(strTmpPath)
	strHomePage = UCase(strHomePage)
	case "lower"
	strTmpPath = LCase(strTmpPath)
	strHomePage = LCase(strHomePage)
	case else
	strTmpPath = PCase(strTmpPath)
	strHomePage = PCase(strHomePage)
	end select
	
	'add home page link
	if strTmpPath = "" then
	response.write "" & strHomePage & ""
	else
		response.write " " & strDelimiter & " " & strTmpPath & ""
	end if
	
	if tmpFileName <> "" then
		if bolShowFiles = "1" or bolShowFilesNoExt = "1" then
		response.write " " & strDelimiter & " " & tmpFileNameLabel & ""
		end if
	end if
	
Loop
response.write ("")
End Function
'************************************************************
' This function takes a string and converts to Proper Case.
' Prototyped by: Brian Shamblen on 3/18/99
' This version by: Us... naturally! - ASP 101
'************************************************************
private Function PCase(strInput)
	Dim iPosition  ' Our current position in the string (First character = 1)
	Dim iSpace     ' The position of the next space after our iPosition
	Dim strOutput  ' Our temporary string used to build the function's output
	' Set our position variable to the start of the string.
	iPosition = 1
	
	' We loop through the string checking for spaces.
	' If there are unhandled spaces left, we handle them...
	Do While InStr(iPosition, strInput, " ", 1) <> 0
		' To begin with, we find the position of the offending space.
		iSpace = InStr(iPosition, strInput, " ", 1)
		
		' We uppercase (and append to our output) the first character after
		' the space which was handled by the previous run through the loop.
		strOutput = strOutput & UCase(Mid(strInput, iPosition, 1))
		
		' We lowercase (and append to our output) the rest of the string
		' up to and including the current space.
		strOutput = strOutput & LCase(Mid(strInput, iPosition + 1, iSpace - iPosition))
		' Note:
		' The above line is something you may wish to change to not convert
		' everything to lowercase.  Currently things like "McCarthy" end up
		' as "Mccarthy", but if you do change it, it won't fix things like
		' ALL CAPS.  I don't see an easy compromise so I simply did it the
		' way I'd expect it to work and the way the VB command
		' StrConv(string, vbProperCase) works.  Any other functionality is
		' left "as an exercise for the reader!"
		
		' Set our location to start looking for spaces to the
		' position immediately after the last space.
		iPosition = iSpace + 1
	Loop
	' Because we loop until there are no more spaces, it leaves us
	' with the last word uncapitalized so we handle that here.
	' This also takes care of capitalizing single word strings.
	' It's the same as the two lines inside the loop except the
	' second line LCase's to the end and not to the next space.
	strOutput = strOutput & UCase(Mid(strInput, iPosition, 1))
	strOutput = strOutput & LCase(Mid(strInput, iPosition + 1))
	' That's it - Set our return value and exit
	PCase = strOutput
End Function
end class %>

To implement it on a page, simply do the following

<%
dim objBreadCrumb
set objBreadCrumb = new clsBreadCrumb
'Set a property
objBreadCrumb.wordCase = "upper" 
' Changes the instance of a directory called "about" to "about this site"
objBreadCrumb.changeName("about", "about this site") 
objBreadCrumb.Build()
%>

Use the guides at the top of the class source code and VOILA! a breadcrumb nav.

Enjoy,
Jason Irving