<script language="VBScript" runat="server">
Class cDynListbox
	'
	' this is version 3 of the cDynListbox object
	' which accompanies the atgconsulting web article
	' http://www.atgconsulting.com/oodynlistbox3.asp
	'
	' free to use or abuse as you see fit, with
	' absolutely no warranties or guarantees of any kind
	'
	' if you like it, or even if you don't, feel free
	' to contact kevin@atgconsulting.com
	'
	' april 30, 2002...
	'
	Private mBoxes		' private storage for the dictionary of cells
	Public Connection	' object ref to the database connection object
	Public Is2000		' boolean: is this sql server 2000 or higher?
	Public EnablePreload ' boolean: do we try to preset the values based on hidden fields?
	Public Formname		' string... the name of the form that this sequence is part of
	Private Sub Class_Initialize()
		' --------------------------------------------
		' this is called when our object is created...
		' --------------------------------------------
		' create a dictionary to hold individual cells
		Set mBoxes = Server.CreateObject("Scripting.Dictionary")
		' insert generic client-side scripts into the output stream
		InsertClientScripts
		EnablePreload = False
	End Sub

	Private Sub Class_Terminate()
		' --------------------------------------------
		' this is called when our object ends...
		' --------------------------------------------
		' clear out our dictionary
		' --------------------------------------------
		If IsObject(mBoxes) Then
			mBoxes.RemoveAll
			Set mBoxes = Nothing
		End If
		' --------------------------------------------
		' free our connection object
		' --------------------------------------------
		If IsObject(Connection) Then
			Set Connection = Nothing
		End If
	End Sub

	Public Function NewCell()
		' --------------------------------------------
		' this function creates a new cell object,
		' initializes its required properties,
		' adds it to our collection of cells,
		' then returns a reference to the cell
		' --------------------------------------------
		Set NewCell = New cIndividualCell
		NewCell.Index = cLng(mBoxes.Count + 1)
		Set NewCell.Parent = Me	' who's your daddy?
		mBoxes.Add "k" & NewCell.Index, NewCell
	End Function

	Public Function GetCell(nIndex)
		' --------------------------------------------
		' this function retrieves an object reference
		' to an individual cell given its index...
		' if there is no cell with that index,
		' the function returns Nothing
		'
		' the index is 1-based (is that confusing?)
		' --------------------------------------------
		If mBoxes.Exists("k" & nIndex) Then
			Set GetCell = mBoxes.Item("k" & nIndex)
		Else
			Set GetCell = Nothing
		End If
	End Function

	Public Sub Render(nIndex)
		' method call: causes the indexed cell to be
		' inserted into the output stream.
		' finds the cell by index, then calls that
		' cell's "Render" method.
		'
		' the index is 1-based (is that confusing?)
		' --------------------------------------------
		If mBoxes.Exists("k" & nIndex) Then
			mBoxes.Item("k" & nIndex).Render
		Else
			Response.Write "item " & nIndex & " not found<br>"
		End If
	End Sub

	Private Sub InsertClientScripts()
		' --------------------------------------------
		' when a new dynamic object is created,
		' add these generic javascripts to the output
		' stream... it's okay if they are added more than
		' once, but there's no reason to go nuts.
		' --------------------------------------------
		Response.Write "<scr" & "ipt language=""javascript""><" & "!--" & vbCrlf

		Response.Write "if (!varComplete) var varComplete = false;" & vbCrlf

		Response.Write "function comboItemSelected(oList1,oHidden,oList2){" & vbCrlf
		Response.Write "if (varComplete){" & vbCrlf
		Response.Write "if (oList1.selectedIndex <= 0){" & vbCrlf
		Response.Write "oHidden.value='';" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "oHidden.value=oList1.options[oList1.selectedIndex].value;" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "if (oList2!=null){" & vbCrlf
		Response.Write "clearComboOrList(oList2);" & vbCrlf
		Response.Write "if (oList1.selectedIndex <= 0){" & vbCrlf
		Response.Write "oList2.options[oList2.options.length] = new Option('Please make a selection from the list', '');" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "fillCombobox(oList2, oList1.name + '=' + oList1.options[oList1.selectedIndex].value);" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function listboxItemSelected(oList1,oHidden,oList2){" & vbCrlf
		Response.Write "if (varComplete){" & vbCrlf
		Response.Write "if (oList1.selectedIndex == -1){" & vbCrlf
		Response.Write "oHidden.value='';" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "oHidden.value=oList1.options[oList1.selectedIndex].value;" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "if (oList2!=null){" & vbCrlf
		Response.Write "clearComboOrList(oList2);" & vbCrlf
		Response.Write "if (oList1.selectedIndex == -1){" & vbCrlf
		Response.Write "oList2.options[oList2.options.length] = new Option('Please make a selection from the list', '');" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "fillListbox(oList2, oList1.name + '=' + oList1.options[oList1.selectedIndex].value);" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function clearComboOrList(oList){" & vbCrlf
		Response.Write "for (var i = oList.options.length - 1; i >= 0; i--){" & vbCrlf
		Response.Write "oList.options[i] = null;" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "oList.selectedIndex = -1;" & vbCrlf
		Response.Write "if (oList.onchange)	oList.onchange();" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function fillCombobox(oList, vValue){" & vbCrlf
		Response.Write "if (vValue != '') {" & vbCrlf
		Response.Write "if (assocArray[vValue]){" & vbCrlf
		Response.Write "oList.options[0] = new Option('Please make a selection', '');" & vbCrlf
		Response.Write "var arrX = assocArray[vValue];" & vbCrlf
		Response.Write "for (var i = 0; i < arrX.length; i = i + 2){" & vbCrlf
		Response.Write "if (arrX[i] != 'EOF') oList.options[oList.options.length] = new Option(arrX[i + 1], arrX[i]);" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "if (oList.options.length == 1){" & vbCrlf
		Response.Write "oList.selectedIndex=0;" & vbCrlf
		Response.Write "if (oList.onchange) oList.onchange();" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "oList.options[0] = new Option('None found', '');" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function fillListbox(oList, vValue){" & vbCrlf
		Response.Write "if (vValue != '') {" & vbCrlf
		Response.Write "if (assocArray[vValue]){" & vbCrlf
		Response.Write "var arrX = assocArray[vValue];" & vbCrlf
		Response.Write "for (var i = 0; i < arrX.length; i = i + 2){" & vbCrlf
		Response.Write "if (arrX[i] != 'EOF') oList.options[oList.options.length] = new Option(arrX[i + 1], arrX[i]);" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "if (oList.options.length == 1){" & vbCrlf
		Response.Write "oList.selectedIndex=0;" & vbCrlf
		Response.Write "if (oList.onchange)	oList.onchange();" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "oList.options[0] = new Option('None found', '');" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function setListToValue(oList,nValue){" & vbCrlf
		Response.Write "for (var i = 0; i < oList.options.length; i++){" & vbCrlf
		Response.Write "if (oList.options[i].value == nValue){" & vbCrlf
		Response.Write "oList.selectedIndex = i;" & vbCrlf
		Response.Write "return;" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "oList.selectedIndex = -1;" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function initListFromHidden(oList,oHidden){" & vbCrlf
		Response.Write "setListToValue(oList,oHidden.value);" & vbCrlf
		Response.Write "if (oList.onchange){" & vbCrlf
		Response.Write "oList.onchange();" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function addCommandTo(fAnon, sNewCommand){" & vbCrlf
		Response.Write "var sScript;" & vbCrlf
		Response.Write "if (fAnon){" & vbCrlf
		Response.Write "sScript = new String(fAnon);" & vbCrlf
		Response.Write "if (sScript.indexOf('{') > 0){" & vbCrlf
		Response.Write "sScript = sScript.substring(sScript.indexOf('{') + 1, sScript.lastIndexOf('}') - 1);" & vbCrlf
		Response.Write "sScript += sNewCommand;" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "sScript = new String(sNewCommand);" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "return new Function(sScript);" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "function moveCommandToEnd(fAnon, sCommand){" & vbCrlf
		Response.Write "var sScript;" & vbCrlf
		Response.Write "if (fAnon){" & vbCrlf
		Response.Write "sScript = new String(fAnon);" & vbCrlf
		Response.Write "if (sScript.indexOf('{') > 0){" & vbCrlf
		Response.Write "sScript = sScript.substring(sScript.indexOf('{') + 1, sScript.lastIndexOf('}') - 1);" & vbCrlf
		Response.Write "sScript = sScript.replace(sCommand, '');" & vbCrlf
		Response.Write "sScript += sCommand;" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "} else {" & vbCrlf
		Response.Write "sScript = new String(sCommand);" & vbCrlf
		Response.Write "}" & vbCrlf
		Response.Write "return new Function(sScript);" & vbCrlf
		Response.Write "}" & vbCrlf

		Response.Write "//--></scr" & "ipt>" & vbCrlf
	End Sub

End Class

Class cIndividualCell
	Public Size			' number -- how large is it
	Public Name			' string -- name for the form field
	Public Table		' string -- the table that this cell is associated with
	Public Value		' string -- the db field returned as the "value" parm
	Public Text			' string -- the db field displayed in the listbox
	Public AltOrderField ' kmm added 09-jan-2005
	public SourceTable	' string -- for index >= 2, if the linked table
						'			is different from the table associated
						'			with the preceding listbox, that table name
						'			goes here... unusual, but it happens
	Public AltSourceField ' string -- an alternative field name for the sourc
	Public StyleInfo	' string -- this string can be used to add extra
						'			parameters to the <select> statement
	Public Parent		' object -- a reference to the container cDynListbox object
	Public SourceLink	' string -- the joining db field in the source table
	Public DestLink		' string -- the joining db field in the dest table
	Public Index		' number -- the index of this cell
	Public InitialValue ' string -- an initial value for this cell
	Public ExtraWhereClause ' string -- an extra parameter to filter the query

	Private Sub Class_Initialize()
		' --------------------------------------------
		' this is called when our object is created...
		' it's useful for setting default properties
		' --------------------------------------------
		Size = 1
	End Sub

	Private Sub Class_Terminate()
		' --------------------------------------------
		' this is called when our object ends...
		' be sure to free any object references --
		' the only one we have is "Parent"
		' --------------------------------------------
		If IsObject(Parent) Then
			Set Parent = Nothing
		End If
	End Sub

	Public Sub Render()
		' -----------------------------------------------------------
		' method -- inserts this listbox cell into the output stream
		' -----------------------------------------------------------
		Dim sQuery
		Dim rs
		Dim oDest
		Dim sTemp
		Dim oSource
		Dim sSourceTable
		Dim oCon
		Dim i
		' -----------------------------------------------------------
		' get references to upstream and downstream cells
		' -----------------------------------------------------------
		Set oCon = Parent.Connection
		Set oSource = Parent.GetCell(Index - 1)
		Set oDest = Parent.GetCell(Index + 1)
		' insert the listbox or combo box...
		' if there's a downstream cell, add the onchange routine
		Response.Write "<input type='hidden' name='hdn" & Name & "' value='" & Replace(InitialValue, "'", "\'") & "'>" & vbCrlf
		If oDest Is Nothing Then
			Response.Write "<select name='" & Name & "' size='" & Size & "' " & StyleInfo
			If Size = 1 Then
				Response.Write " onchange='comboItemSelected(this,this.form.hdn" & Name & ");'>" & vbCrlf
			Else
				Response.Write " onchange='listboxItemSelected(this,this.form.hdn" & Name & ");'>" & vbCrlf
			End If
		Else
			Response.Write "<select name='" & Name & "' size='" & Size & "' " & StyleInfo
			If Size = 1 Then
				Response.Write " onchange='comboItemSelected(this,this.form.hdn" & Name & ",this.form." & oDest.Name & ");'>" & vbCrlf
			Else
				Response.Write " onchange='listboxItemSelected(this,this.form.hdn" & Name & ",this.form." & oDest.Name & ");'>" & vbCrlf
			End If
		End If
		' -----------------------------------------------------------
		Select Case Index
		Case 1
			' if index is 1, it is considered a "primary" listbox
			' it gets filled in directly from a database table,
			' and has a script attached to the onchange() routine
			' that causes the next downstream element to update
			'
			' size = 1 means combo box... put a "dummy" initial into the combo
			If Size = 1 Then
				Response.Write "<option>Please make a selection</option>" & vbCrlf
			End If
			' create and execute the database query
			sQuery = "select distinct " & Value & ", " & Text & " from " & Table
			If ExtraWhereClause <> "" Then
			    sQuery = sQuery & vbcrlf & "WHERE " & ExtraWhereClause & vbCrlf
			End If
			If AltOrderField & "" = "" Then
				sQuery = sQuery & " order by " & Text
			Else
				sQuery = sQuery & " order by " & AltOrderField
			End If
			On Error Resume Next
			Set rs = oCon.Execute(sQuery)
			If Err.number <> 0 Then
				Response.Write Err.Description & "<br>"
				Response.Write sQuery
				Response.End
			End If
			On Error Goto 0
			' loop for all records...
			Do Until rs.EOF
				Response.Write "<option value=""" & rs(0) & """>" & rs(1) & "</option>" & vbCrlf
				rs.MoveNext
			Loop
			' close and free the recordset
			rs.Close
			Set rs = Nothing
			Response.Write "</select>" & vbCrlf					' put a trailer on the listbox
			'Response.Write sQuery & "<hr>"
		Case Else
			' insert a dummy entry as filler...
			Response.Write "<option>Make a selection</option>"
			If Size = 1 Then
				' if it's a combo box, for NN4 and below we need to add
				' extra dummy entries to expand the pulldown area
				Response.Write "<option>Make a selection</option>"
				Response.Write "<option>Make a selection</option>"
				Response.Write "<option>Make a selection</option>"
				Response.Write "<option>Make a selection</option>"
				Response.Write "<option>Make a selection</option>"
			End If
			Response.Write "</select>" & vbCrlf					' put a trailer on the listbox
			' create and execute the query that creates the XML stream
			If IsEmpty(SourceTable) Then
				sSourceTable = oSource.Table
			Else
				sSourceTable = SourceTable
			End If
			If Len(Trim(AltSourceField & "")) = 0 Then
				sQuery = "SELECT distinct table1." & oSource.Value & " as search, table2." & _
					Value & " as dvalue, table2." & Text & " AS display " & _
					"FROM " & sSourceTable & " table1, " & Table & " table2 " & _
					"WHERE table1." & SourceLink & "=table2." & DestLink & " "
				If ExtraWhereClause <> "" Then
					sQuery = sQuery & vbcrlf & " AND " & ExtraWhereClause & vbCrlf
				End If
				sQuery = sQuery & _
					"ORDER BY table1." & oSource.Value & ", table2." & Text
			Else
				sQuery = "SELECT distinct table1." & AltSourceField & " as search, table2." & _
					Value & " as dvalue, table2." & Text & " AS display " & _
					"FROM " & sSourceTable & " table1, " & Table & " table2 " & _
					"WHERE table1." & SourceLink & "=table2." & DestLink & " "
				If ExtraWhereClause <> "" Then
					sQuery = sQuery & vbcrlf & " AND " & ExtraWhereClause & vbCrlf
				End If
				sQuery = sQuery & _
					"ORDER BY table1." & AltSourceField & ", table2." & Text
			End If
			'Response.Write sQuery
			If Parent.Is2000 Then
				sQuery = sQuery & " FOR XML AUTO"
				sTemp = RetrieveXMLStream(oCon, sQuery)			' get XML from the database
			Else
				sTemp = Non2000XML(oCon, sQuery)
			End If
			sTemp = TransformXMLStream(sTemp, oSource.Name) ' transform XML into script
			Response.Write sTemp							' write to the output stream
		End Select

		If Parent.EnablePreload Then
			AddPreloadScript Parent.Formname, Name
		End If

	End Sub

	Private Sub AddPreloadScript(sFormname, sName)
		Response.Write "<scr" & "ipt language=""javascript"">" & vbCrlf
		Response.Write "window.onload=addCommandTo(window.onload,'initListFromHidden(document." & sFormname & "." & _
			sName & ",document." & sFormname & ".hdn" & sName & ");');" & vbCrlf
		Response.Write "window.onload=moveCommandToEnd(window.onload,'varComplete = true;');" & vbCrlf
		Response.Write "</scr" & "ipt>" & vbCrlf
	End Sub

	Private Function Non2000XML(objCon, sQuery)
		Dim rs, fld, sLongString, sSearch
		Set rs = objCon.Execute(sQuery)
		sLongString = "<root xmlns:sql=""urn:schemas-microsoft-com:xml-sql"">"
		sLongString = sLongString & "<table1 search=""dummy record"">"
		sSearch = "ZZZZ9999"
		Do Until rs.EOF
			If sSearch = rs(0) & "" Then
				sLongString = sLongString & "<table2 dvalue=""" & rs(1) & """ display=""" & rs(2) & """ />"
			Else
				sSearch = rs(0) & ""
				sLongString = sLongString & "</table1>"
				sLongString = sLongString & "<table1 search=""" & sSearch & """>"
				sLongString = sLongString & "<table2 dvalue=""" & rs(1) & """ display=""" & rs(2) & """ />"
			End If
			rs.MoveNext
		Loop
		sLongString = sLongString & "</table1>"
		sLongString = sLongString & "</root>"
		rs.Close
		Set rs = Nothing
		Non2000XML = sLongString
	End Function

	Private Function GetXSLStream()
		Dim sTemp
		sTemp = "<?xml version='1.0'?>" & vbCrlf
		sTemp = sTemp & "<xsl:stylesheet xmlns:xsl=""http://www.w3.org/TR/WD-xsl"">" & vbCrlf
		sTemp = sTemp & "<xsl:template match=""/"">" & vbCrlf
		sTemp = sTemp & "if (!assocArray) var assocArray = new Object();<xsl:for-each select=""root/table1"">" & vbCrlf
		sTemp = sTemp & "assocArray[""%listname%=<xsl:value-of select=""@search"" />""] = new Array(" & vbCrlf
		sTemp = sTemp & "<xsl:for-each select=""table2"">" & vbCrlf
		sTemp = sTemp & "<xsl:value-of select=""table2"" />    ""<xsl:value-of select=""@dvalue"" />"",""<xsl:value-of select=""@display"" />""," & vbCrlf
		sTemp = sTemp & "</xsl:for-each>    ""EOF"");</xsl:for-each>" & vbCrlf
		sTemp = sTemp & "</xsl:template>" & vbCrlf
		sTemp = sTemp & "</xsl:stylesheet>" & vbCrlf
		GetXSLStream = sTemp
	End Function

	Private Function TransformXMLStream(sStream, sReplaceName)
		Dim objXML
		Dim objXSL
		Dim sXSL
		Dim fso
		Dim ts
		Dim sTemp

		' step 1: load the database string into an XMLDOM object
		set objXML = Server.CreateObject("Microsoft.XMLDOM")
		objXML.Async = False
		objXML.LoadXML(sStream)

		' step 2: load the stylesheet into a string (to play with it)
		sXSL = GetXSLStream
		sXSL = Replace(sXSL, "%listname%", sReplaceName)

		' step 3: load the stylesheet into an XMLDOM object
		Set objXSL = Server.CreateObject("Microsoft.XMLDOM")
		objXSL.Async = False
		objXSL.LoadXML(sXSL)

		' step 4: do the transform and return the results...
		On Error Resume Next
		sTemp = vbCrlf & "<scr" & "ipt language='javascript'>" & vbCrlf
		sTemp = sTemp & objXML.TransformNode(objXSL)
		sTemp = sTemp & vbCrlf & "</scr" & "ipt>" & vbCrlf
		If Err.Number = 0 Then
			TransformXMLStream = sTemp
		Else
			TransformXMLStream = Err.Description
		End If

	End Function

	Private Function PackageAsXML(sQ)
		' you have to sandwich your SQL query inside a pair of
		' <root><sql> and </sql></root> tags
		Dim sTemp
		sTemp = "<root xmlns:sql='urn:schemas-microsoft-com:xml-sql'><sql:query>"
		If Instr(1, sQ, "for xml auto", vbTextCompare) > -1 Then
			sTemp = sTemp & sQ
		Else
			sTemp = sTemp & sQ & " for xml auto"
		End If
		PackageAsXML = sTemp & "</sql:query></root>"
	End Function

	Private Function RetrieveXMLStream(objCon, sQuery)
		Dim objCmd			' ADODB.Command
		Dim objQueryStream	' ADODB.Stream
		Dim objOutputStream	' ADODB.Stream
		Dim sQ

		Set objQueryStream = Server.CreateObject("ADODB.Stream")	' create the input stream
		Set objOutputStream = Server.CreateObject("ADODB.Stream")   ' create the output stream
		Set objCmd = Server.CreateObject("ADODB.Command")
		Set objCmd.ActiveConnection = objCon

		sQ = PackageAsXML(sQuery)
		objQueryStream.Open										'   Open the command stream so it may be written to
		objQueryStream.WriteText sQ, adWriteChar				'   Set the input command stream's text with the query string
		objQueryStream.Position = 0								'   Reset the position in the stream, otherwise it will be at EOS
		Set objCmd.CommandStream = objQueryStream				'   Set the command object's command to the input stream set above
		objCmd.Dialect = "{5D531CB2-E6ED-11D2-B252-00C04F681B71}"   ' Set the dialect for the command stream to be a SQL query
		' note: the default value for dialect -- if you don't specify it -- is "{C8B521FB-5CF3-11CE-ADE5-00AA0044773D}"
		' also note... even if you leave "Dialect" as the default, this function seems to work fine for our purposes
		objOutputStream.Open									'   Open the output stream so it can receive data
		objCmd.Properties("Output Stream") = objOutputStream	'   assign the command's output to the stream just opened
		objCmd.Execute , , adExecuteStream						'   execute the command, thus filling up the output stream.
		objOutputStream.Position = 0							'   reset the output stream back to beginning-of-stream
		RetrieveXMLStream = objOutputStream.ReadText(-1)		'   assign the stream's output to the output variable
	End Function
End Class
</script>