Custom collection

[guitardave78]

A while back I created the following thread thread333-1030175 to ask about custom collections.
The other day i needed to use them again, but decided to rework Tarwns superb idea to allow a bit more flexibility (for my needs any how)

The idea is that i can name my objects, like you would a session, so

myclass("monkey").value = "chimp" can be called with
monkey = myclass("monkey").value

Hope you find it of some use

<%option explicit
Class classTest
	private arrItems()
	Dim formValidationItems,my_namepos,my_name
    Sub Class_Initialize
		redim arrItems(0)
    End Sub
	
	sub Class_Terminate
		close
	end sub
	
	Public Default Property Get Items(key)
		if len(key) = 0 then
		else
			if findKey(key) = -1 then
				Set arrItems(ubound(arrItems))=Server.CreateObject("Scripting.Dictionary")
				my_namepos = ubound(arrItems)
				Name = key 
				redim preserve arrItems(ubound(arrItems)+1)
			end if
			my_name = key
			my_namepos = findKey(key)
			Set Items = me
		end if
	End Property

	Public Property Get Count
		Count = ubound(arrItems)
	End Property
	
	Public Property Let Value(val)
		call addKeyVal("Value",val)
	End Property
	
	Public Property Get Value
		Value = arrItems(my_namepos)("Value")
	End Property
	
	Private Property Let Name(val)
		call addKeyVal("name",val)
	End Property
	
	Public Property Get Name
		Name = arrItems(my_namepos)("name")
	End Property

	public sub close
		killDictionary
		redim arrItems(0)
	end sub
	
	'helper functions
	
	public sub addKeyVal(key,val)
		if arrItems(my_namepos).exists(key) then
			arrItems(my_namepos)(key) = val
		else
			arrItems(my_namepos).add key,val
		end if
	end sub

	private sub killDictionary()
		dim n
		for n = 0 to ubound(arrItems)-1
			arrItems(n).RemoveAll
			set arrItems(n) = nothing
		next
	end sub
	
	private function findKey(str)
		findKey = -1
		if isArray(arrItems) then
			dim n
			for n = 0 to ubound(arrItems) - 1
				if arrItems(n)("name") = str then
					findKey = n
					exit for
				else
					findKey = -1
				end if
			next
		else
			findKey = -1
		end if
	end function
end class
%>
<%
dim clsTest:set clsTest = new classTest
clsTest("Monkey").Value = "Chimp"
clsTest("Dog").Value = "Boxer"
clsTest("Fruit").Value = "Apple"

response.write(clsTest("Monkey").Value &"<br />")
response.write(clsTest("Dog").Value &"<br />")
response.write(clsTest("Fruit").Value &"<br />")
response.write(clsTest.Count &"<br />")

clsTest.close
%>

}...the bane of my life!

http://www.yetanotherreviewsite.co.uk

http://www.fuzzyd.co.uk