Ever want to transform your string into title case? This script will get it done!

This chuck of code is part of a class that I call the FormatString Class that can be downloaded here. But, here is the code by itself:

'+--------------------------------------------------------------------------------------------------
'	TITLE CASE
'	Turns a string to title case
'	. titleCase: capitalizes the first letter of every word.
'		. Usage: formatStringObject.titleCase("your title cased text");
'		. Requires: str: string to title case;
'		. Returns: "Your Title Cased Text"
'+--------------------------------------------------------------------------------------------------
	Function titleCase(str)

		If str <> "" Then 'Ensure that there is a string to avoid unhandled errors.

			Dim arr
			arr = Split(str, " ")

			For titleCaseCount = 0 To UBound(arr)
				firstLetter = UCase(Left(arr(titleCaseCount), 1))
				word = cropStart(arr(titleCaseCount))
				arr(titleCaseCount) = firstLetter & word
			Next

			titleCase = Join(arr, " ")

		End If

	End Function

When VBScript was invented, the programmers already implemented a way to format a date, but if you’ve noticed, it was really centred along the lines of American needs, and it left out many other common ways to format a date. Also, technologies like XML also demanded a new method to format a date.

The following two scripts allow you to format a date. The first method will convert a date into an XML safe format called RFC822. The other script will simply format a date as you specify (like d-m-y, m-d-y, y-m-d).

This chuck of code is part of a class that I call the FormatString Class that can be downloaded here. But, here is the code by itself:

'+--------------------------------------------------------------------------------------------------
'	CONVERT DATE TO RFC822
' 	Returns your date in RFC822 format. Required for RSS
' 	feeds.
'	. RFC822_Date: converts a date into the RFC822 international date format. This is useful for
'				   RSS feeds because the RSS feed validators require this date format;
'		. Usage: formatStringObject.RFC822_Date("12/19/2009", "EST")
'		. Requires:
'			- date: your date in mm/dd/yyyy format;
'			- date code: the international date code for your are like "GMT")
'		. Returns: "Sat, 19 Dec 2009 00:00:00 EST"
'+--------------------------------------------------------------------------------------------------
	Public Function RFC822_Date(myDate, offset)
	   Dim myDay, myDays, myMonth, myYear
	   Dim myHours, myMinutes, myMonths, mySeconds

	   myDate = CDate(myDate)
	   myDay = WeekdayName(Weekday(myDate),true)
	   myDays = Day(myDate)
	   myMonth = MonthName(Month(myDate), true)
	   myYear = Year(myDate)
	   myHours = zeroPad(Hour(myDate), 2)
	   myMinutes = zeroPad(Minute(myDate), 2)
	   mySeconds = zeroPad(Second(myDate), 2)

	   RFC822_Date = myDay&", "& _
									  myDays&" "& _
									  myMonth&" "& _
									  myYear&" "& _
									  myHours&":"& _
									  myMinutes&":"& _
									  mySeconds&" "& _
									  UCase(offset)
	End Function 

	'This supports the RFC822_Date Function
	Private Function zeroPad(m, t)
	   zeroPad = String(t-Len(m),"0")&m
	End Function

'+--------------------------------------------------------------------------------------------------
'	FORMAT DATE
'
' 	Requires:
'		sDate (string): 	Your Date
'		sFormat (string): 	Your desired format as in "d-m-y, m-d-y, y-m-d"
'+--------------------------------------------------------------------------------------------------
	Public Function formatDate(sDate, sFormat)
		searchString ="/"	

		indexNum 	= inStr(sDate, searchString)
		sDay 		= Left(sDate, indexNum - 1)
		sMonthYear	= Mid(sDate, indexNum + 1)
		indexNum	= inStr(sMonthYear, searchString)
		sMonth 		= Left(sMonthYear, indexNum - 1)
		sYear		= Mid(sMonthYear, indexNum + 1)	

		Select Case sFormat
			Case "d-m-y"
				formatDate = sDay & "-" & sMonth & "-" & sYear
			Case "m-d-y"
				formatDate = sMonth & "-" & sDay & "-" & sYear
			Case "y-m-d"
				formatDate = sYear & "-" & sMonth & "-" & sDay
			Case Else
				formatDate = Replace(sFormat, "/", "-")
		End Select
	End Function

VBScript is such a low level programming language, that sometimes I found myself creating small functions just to make shortcuts. For example, getting just the name of a page was sometimes a real pain. The following are some small scripts that you may find useful. Now, I know a lot of you will say that server variables already take care of these things, but the truth is that they don’t deliver the content that you need cleanly (they always seem to leave junk in the strings that you need like the http://, or whatever).

The scripts are:

• Get Page Name
• Get Refering Page
• Get Refering Host
• Get Absolute URI

This chuck of code is part of a class that I call the FormatString Class that can be downloaded here. But, here is the code by itself:

'+--------------------------------------------------------------------------------------------------
'	QUERYSTRING AND SERVER VARIABLE FUNCTIONS
'+--------------------------------------------------------------------------------------------------
	'--------------------------------------------------------
	' Gets the name of the current web page.
	'	. getPageName: gets the name of the current webpage. It goes a bit further than simply getting
	'				   the server variable "Script Name";
	'		. Usage: formatStringObject.getPageName()
	'		. Requires nothing;
	'		. Returns: your current page, i.e.: "yourPage.html"
	'--------------------------------------------------------
	Function getPageName()
		Dim scriptName
		Dim pageName
		scriptName = Request.ServerVariables("SCRIPT_NAME")
		pageName = Mid(scriptName, inStrRev(scriptName, "/") +1)
		getPageName = pageName
	End Function

	'--------------------------------------------------------
	' Get the refering page
	'	. getReferingPage: gets the name of the refering page. As with the getPageName method, it
	'					   strips the characters that you don't need from the string and only gives you
	'					   the name of the refering page.
	'		. Usage: formatStringObject.getReferingPage()
	'		. Requires nothing;
	'		. Returns: the refering page, i.e.: "yourPreviousPage.html"
	'--------------------------------------------------------
	Function getReferingPage()
		Dim scriptName
		Dim pageName
		scriptName = Request.ServerVariables("HTTP_REFERER")
		pageName = Mid(scriptName, inStrRev(scriptName, "/") +1)
		pageName = cropWordRev(pageName, "?") 'Gets rid of any querystring vars and just passes the raw refering page name.
		getReferingPage = pageName
	End Function	

	'--------------------------------------------------------
	' Provide you with the refering host
	'	. getReferingHost: get the refering host without the extra string data. Clearner than using the
	'					   server variable "HTTP Referer"
	'		. Usage: formatStringObject.getReferingHost()
	'		. Requires nothing;
	'		. Returns: your host, i.e.: "http://www.yourwebsite.com"
	'--------------------------------------------------------
	Function getReferingHost()
		Dim scriptName
		Dim serverName
		scriptName = Request.ServerVariables("HTTP_REFERER")
		serverName = Replace(scriptName, "http://", "")
		serverName = Replace(serverName, "https://", "")
		getReferingHost = cropWordRev(serverName, "/")
	End Function

	'--------------------------------------------------------
	' Returns the absolute path of the current web page
	'	. getAbsoluteURI: returns the absolute path of the current web page;
	'		. Usage: formatStringObject.getAbsoluteURI()
	'		. Requires nothing;
	'		. Returns: the current absolute path of your page, i.e.: "http://www.yourWebSite.com/aFolder/yourPage.html"
	'--------------------------------------------------------
	Function getAbsoluteURI()
		getAbsoluteURI = "http://" & Request.ServerVariables("HTTP_HOST") & Replace(Request.ServerVariables("PATH_INFO"), getPageName(), "")
	End Function

When storing a phone number in a database, I like to make sure that I’m only storing the actual numbers. It’s never a good idea to let your user decided how they are going to format the number, because everyone does it differently. For example, some people like to use brackets (as in: (888) 555-1234), some don’t (as in: 888-555-1234). So, I always strip my numbers of any non-numeric characters. The following piece of code is how I strip and reconstruct the numbers. Note that this code may not work 100% with some European country numbers.

This chuck of code is part of a class that I call the FormatString Class that can be downloaded here. But, here is the code by itself:

'+--------------------------------------------------------------------------------------------------
'	PHONE NUMBER FORMATING
'+--------------------------------------------------------------------------------------------------
	'--------------------------------------------------------
	' Strips all of the formating of a number into a string
	' of digits.
	'	. cleanPhoneNumber: strips all of the formating of a string and returns just the digits.
	'		. Usage: formatStringObject.clearPhoneNumber("(123) 456-7890")
	'		. Requires: a phone number
	'		. Returns: just the digits, i.e.: "1234567890"
	'--------------------------------------------------------
	Function cleanPhoneNumber(ByVal num)
		Dim stringLen, newNum
		stringLen = Len(num)

		'Run thru each character and extract only the
		'number.
		If Not IsNull(num) Then 'Ensure that a number was passed and that it's not null!
			For i = 1 to stringLen
				character = Mid(num, i, 1)
				If IsNumeric(character) Then
					newNum = newNum & character 'If a number, add here.
				End If
			Next
		Else
			newNum = null
		End If
		cleanPhoneNumber = newNum
	End Function

	'--------------------------------------------------------
	' Formats a series of numbers into a recognized phone
	' number format
	'	. formatPhoneNumber: formats a string of digits into a valid phone number format. Requires that the
	'						 correct number of digits be present in the string.
	'		. Usage: formatStringObject.formatPhoneNumber("123456789")
	'		. Requires:  a string of digits
	'		. Returns: a formated phone number, i.e.: "(123) 456-7890". Note: if you do not supply the
	'			       right amount of digits or if it has anything other characters other than digits,
	'				   it will simply return the string unchanged.
	'--------------------------------------------------------
	Function formatPhoneNumber(ByVal num)
		Dim stringLen
		Dim firstNum
		Dim newNum

		If IsNull(num) Then num = ""
		num = CStr(num)

		stringLen = Len(num)
		firstNum = Left(num, 1)

		If IsNumeric(num) Then
			If stringLen = 10 Then 'If regular North American number
				newNum = "(" & Left(num, 3) & ") " & Mid(num, 4, 3) & "-" & Mid(num, 7, 4)
			ElseIf stringLen = 11 AND firstNum = "1" Then 'If a regular North American long distance number.
				newNum = Left(num, 1) & " (" & Mid(num, 2, 3) & ") " & Mid(num, 5, 3) & "-" & Mid(num, 8, 4)
			ElseIf stringLen = 11 AND firstNum = "0" Then' If an European type number
				newNum = Left(num, 5) & " " & Mid(num, 6, 6)
			ElseIf stringLen = 12 Then 'If an over seas number.
				newNum = "+" & Left(num, 2) & " " & Mid(num, 3, 4) & " " & Mid(num, 7, 6)
			Else
				newNum = num 'Everything else is not formated.
			End If
		End If

		formatPhoneNumber = newNum
	End Function

Ever have character encoding problems? I have! …and it can be a real pain in the ass when your old database is plagued by data that is not compatible with the UTF-8 character encoding of your new web page. Here is some code that has helped me over the years. I am not the author of the code (and if you find out who they are, let me know and I’ll give them credit here), but I thought I’d post them here as they have helped me out over the years.

This chuck of code is part of a class that I call the FormatString Class that can be downloaded here. But, here is the code by itself:

'+--------------------------------------------------------------------------------------------------
'	ENCODE UTF8
' 	Note: this is not the same as encoding a string that
' 	is already in ANSI format. See ANSIToUnicode for
' 	that functionality
'	. Encode_UTF8: encodes a new string into UTF8 format. Note that this is not the same as encoding
'				   a string that is already in ANSI format. See ANSIToUnicode for that functionality.
'		. Usage: formatStringObject.encode_UTF8(your string)
'		. Requires:  a string of characters to format
'		. Returns: the same string in UTF8 format
'+--------------------------------------------------------------------------------------------------
	Public Function Encode_UTF8(astr)
		Dim c
		Dim utftext
		utftext = ""
		If isNull(astr) = false or astr <> "" Then
			astr = Replace(astr, "’", "'") 'replacing the apostrophe
			astr = Replace(astr, "–", "-") 'replacing the emdash with minus sign
			For n = 1 To Len(astr)
				c = Asc(Mid(astr, n, 1))
				If c < 128 Then
					utftext = utftext + Mid(astr, n, 1)
				ElseIf ((c > 127) And (c < 2048)) Then
					utftext = utftext + Chr(((c \ 64) Or 192))
					utftext = utftext + Chr(((c And 63) Or 128))
				Else
					utftext = utftext + Chr(((c \ 144) Or 234))
					utftext = utftext + Chr((((c \ 64) And 63) Or 128))
					utftext = utftext + Chr(((c And 63) Or 128))
				End If
			Next
		End If
		Encode_UTF8 = utftext
	End Function

'+--------------------------------------------------------------------------------------------------
' Converts an ANSI string to Unicode
'	. ANSIToUnicode: encodes an ANSI string to UTF8 format.
'		. Usage: formatStringObject.ansiToUnicode(your string)
'		. Requires:  an ANSI string to format
'		. Returns:  the same string in UTF8 format
'+--------------------------------------------------------------------------------------------------
	Public Function ANSIToUnicode(ByRef pbinBinaryData)
		Dim lbinData	' Binary Data (ANSI)
		Dim llngLength	' Length of binary data (byte count)
		Dim lobjRs		' Recordset
		Dim lstrData	' Unicode Data
		' VarType Reference
		'8 = Integer (this is expected var type)
		'17 = Byte Subtype
		' 8192 = Array
		' 8209 = Byte Subtype + Array

		Set lobjRs = Server.CreateObject("ADODB.Recordset")
		If VarType(pbinBinaryData) = 8 Then
			' Convert integers(4 bytes) to Byte Subtype Array (1 byte)
			llngLength = LenB(pbinBinaryData)
			If llngLength = 0 Then
				lbinData = ChrB(0)
			Else
				Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
				Call lobjRs.Open()
				Call lobjRs.AddNew()
				Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0)) ' + Null terminator
				Call lobjRs.Update()
				lbinData = lobjRs.Fields("BinaryData").GetChunk(llngLength)
				Call lobjRs.Close()
			End If
		Else
			lbinData = pbinBinaryData
		End If
		' Do REAL conversion now!
		llngLength = LenB(lbinData)
		If llngLength = 0 Then
			lstrData = ""
		Else
			Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength)
			Call lobjRs.Open()
			Call lobjRs.AddNew()
			Call lobjRs.Fields("BinaryData").AppendChunk(lbinData)
			Call lobjRs.Update()
			lstrData = lobjRs.Fields("BinaryData").Value
			Call lobjRs.Close()
		End If

		Set lobjRs = Nothing
		ANSIToUnicode = lstrData

	End Function

Ensuring that text is safe for XML is always a good rule of thumb when your data is being generated by a group or by people who are not technical. The following code does exactly that. I will ensure that text is stripped and replaced with any offending characters.

This chuck of code is part of a class that I call the FormatString Class that can be downloaded here. But, here is the code by itself:

'+--------------------------------------------------------------------------------------------------
'	XMLSafe
'	Transformed a string to XML safe format.
'+--------------------------------------------------------------------------------------------------
	Function XMLSafe(str)
		Dim xmlList
		xmlList = getXMLList()
		If InStr(str, "é") > 0 Then str = Replace(str, "é", "é")
		xmlSafe = ChangeCharacters(str, xmlList, 3)
	End Function

	'Support for the XMLSafe function. Creates a list of characters to use to make the xml equivalent switch.
	Function getXMLList()
		Dim s 	

		s = s & "Á,193,C1,Á|"
		s = s & "á,225,E1,á|"
		s = s & "Â,194,C2,Â|"
		s = s & "â,226,E2,â|"
		s = s & "´,180,B4,´|"
		s = s & "Æ,198,C6,Æ|"
		s = s & "æ,230,E6,æ|"
		s = s & "À,192,C0,À|"
		s = s & "à,224,E0,à|"
		s = s & "Å,197,C5,Å|"
		s = s & "å,229,E5,å|"
		s = s & "Ã,195,C3,Ã|"
		s = s & "ã,227,E3,ã|"
		s = s & "Ä,196,C4,Ä|"
		s = s & "ä,228,E4,ä|"
		s = s & "„,132,84,„|"
		s = s & "¦,166,A6,¦|"
		s = s & "•,149,95,•|"
		s = s & "Ç,199,C7,Ç|"
		s = s & "ç,231,E7,ç|"
		s = s & "¸,184,B8,¸|"
		s = s & "¢,162,A2,¢|"
		s = s & "ˆ,136,88,ˆ|"
		s = s & "©,169,A9,©|"
		s = s & "¤,164,A4,¤|"
		s = s & "†,134,86,†|"
		s = s & "‡,135,87,‡|"
		s = s & "°,176,B0,°|"
		s = s & "÷,247,F7,÷|"
		s = s & "É,201,C9,É|"
		s = s & "é,233,E9,é|"
		s = s & "Ê,202,CA,Ê|"
		s = s & "ê,234,EA,ê|"
		s = s & "È,200,C8,È|"
		s = s & "è,232,E8,è|"
		s = s & "Ð,208,D0,Ð|"
		s = s & "ð,240,F0,ð|"
		s = s & "Ë,203,CB,Ë|"
		s = s & "ë,235,EB,ë|"
		s = s & "€,128,80,€|"
		s = s & "ƒ,131,83,ƒ|"
		s = s & "½,189,BD,½|"
		s = s & "¼,188,BC,¼|"
		s = s & "¾,190,BE,¾|"
		s = s & "…,133,85,…|"
		s = s & "Í,205,CD,Í|"
		s = s & "í,237,ED,í|"
		s = s & "Î,206,CE,Î|"
		s = s & "î,238,EE,î|"
		s = s & "¡,161,A1,¡|"
		s = s & "Ì,204,CC,Ì|"
		s = s & "ì,236,EC,ì|"
		s = s & "¿,191,BF,¿|"
		s = s & "Ï,207,CF,Ï|"
		s = s & "ï,239,EF,ï|"
		s = s & "«,171,AB,«|"
		s = s & "“,147,93,“|"
		s = s & "‹,139,8B,‹|"
		s = s & "‘,145,91,‘|"
		s = s & "¯,175,AF,¯|"
		s = s & "—,45,97,—|"
		s = s & "µ,181,B5,µ|"
		s = s & "·,183,B7,•|"
		s = s & " ,160,A0, |"
		s = s & "–,45,96,–|"
		s = s & "¬,172,AC,¬|"
		s = s & "Ñ,209,D1,Ñ|"
		s = s & "ñ,241,F1,ñ|"
		s = s & "Ó,211,D3,Ó|"
		s = s & "ó,243,F3,ó|"
		s = s & "Ô,212,D4,Ô|"
		s = s & "ô,244,F4,ô|"
		s = s & "Œ,140,8C,Œ|"
		s = s & "œ,156,9C,œ|"
		s = s & "Ò,210,D2,Ò|"
		s = s & "ò,242,F2,ò|"
		s = s & "ª,170,AA,ª|"
		s = s & "º,186,BA,º|"
		s = s & "Ø,216,D8,Ø|"
		s = s & "ø,248,F8,ø|"
		s = s & "Õ,213,D5,Õ|"
		s = s & "õ,245,F5,õ|"
		s = s & "Ö,214,D6,Ö|"
		s = s & "ö,246,F6,ö|"
		s = s & "¶,182,B6,¶|"
		s = s & "‰,137,89,‰|"
		s = s & "±,177,B1,±|"
		s = s & "£,163,A3,£|"
		s = s & "»,187,BB,»|"
		s = s & "”,148,94,”|"
		s = s & "®,174,AE,®|"
		s = s & "›,155,9B,›|"
		s = s & "’,146,',’|"
		s = s & "‚,130,82,‚|"
		s = s & "Š,138,8A,Š|"
		s = s & "š,154,9A,š|"
		s = s & "§,167,A7,§|"
		s = s & "­,173,AD,¬|"
		s = s & "¹,185,B9,¹|"
		s = s & "²,178,B2,²|"
		s = s & "³,179,B3,³|"
		s = s & "ß,223,DF,ß|"
		s = s & "Þ,222,DE,Þ|"
		s = s & "þ,254,FE,þ|"
		s = s & "˜,152,98,˜|"
		s = s & "×,215,D7,×|"
		s = s & "™,153,99,™|"
		s = s & "Ú,218,DA,Ú|"
		s = s & "ú,250,FA,ú|"
		s = s & "Û,219,DB,Û|"
		s = s & "û,251,FB,û|"
		s = s & "Ù,217,D9,Ù|"
		s = s & "ù,249,F9,ù|"
		s = s & "¨,168,A8,¨|"
		s = s & "Ü,220,DC,Ü|"
		s = s & "ü,252,FC,ü|"
		s = s & "Ý,221,DD,Ý|"
		s = s & "ý,253,FD,ý|"
		s = s & "¥,165,A5,¥|"
		s = s & "ÿ,159,9F,Ÿ|"
		s = s & "ÿ,255,FF,ÿ"
		s = s & "',',','"
		s = s & "<ul>,,,"
		s = s & "<li>, - , - , - "
		s = s & "</li>,,,"
		s = s & "</ul>,,,"

		getXMLList = s
	End Function

	'Supports the XMLSafe function. This simply switches the characters from one to another.
	Function ChangeCharacters(str, dict, intColumn)
		Dim arr(), arrTemp, a
		Dim n, i

		arrTemp = Split(dict, "|")

		Redim arr(2, UBound(arrTemp))

		For n = 0 To UBound(arrTemp) -1
			a = Split(arrTemp(n), ",")
			If str <> "" Then
				If InStr(str, a(0)) > 0 Then
					str = Replace(str, a(0), Chr(a(1)))
				End If
			End If
		Next

		ChangeCharacters = str
	End Function