<%
' Last Updated 19 May 2006
' Jonathan Maxwell

Function CheckData(varData, strDataType, varDefault)
	On Error Resume Next
	' Checks data, formats it and returns
	dim varTemp
	
	select case lcase(strDataType)
		case "str"
			if IsNull(varData) then
				varTemp = varDefault
			else
				varTemp = (CStr(varData))	' was FixApostrophe
			end if
				
		case "int"
			if IsNumeric(varData) then
				varTemp = varData
			else
				if IsNull(varData) or varData = "" then varData = varDefault
				varTemp = varDefault
			end if
		
		case "dbl", "cur"
			if IsNumeric(varData) then
				varTemp = varData
				if lcase(strDataType) = "cur" then varTemp = changeToCurrency(varTemp)
			else
				if IsNull(varData) or varData = "" then varData = varDefault
				varTemp = CDbl(varData)
				if lcase(strDataType) = "cur" then varTemp = changeToCurrency(varTemp)
			end if		
		
		case "bln"
			if IsNull(varData) then varData = varDefault
			
			if IsNumeric(varData) then
				if varData = 0 then
					varTemp = 0
				elseif varData = 1 or varData = -1 then
					varTemp = -1
				else
					varTemp = -1
				end if
			else
				if lcase(varData) = "true" then
					varTemp = -1
				elseif lcase(varData) = "false" then
					varTemp = 0
				end if
			end if
			
			if varTemp = "" then varTemp = CBool(varData)
			varTemp = CBool(varTemp)
			
		case "date"
			if IsNull(varData) then
				varTemp = varDefault
			elseif isDate(varData) = false then
				varTemp = varDefault
			else
				varTemp = varData
			end if
		end select
	
	if err.number <> 0 then
		varTemp = varDefault
		err.clear
	end if
	
	CheckData = varTemp
	
End Function

Sub ExecuteSQL(sql, strDbaseConnection)
	' Executes a SQL Statement
	On Error Resume Next
	dim objCon
	
	set objCon = Server.CreateObject("ADODB.Connection")
	objCon.Mode = 3
	objCon.Open strDbaseConnection
	objCon.Execute sql
	
	objCon.Close()
	set objCon = nothing
End Sub

Function FieldFormat(DataType, Data)
	' Gets valid format for database field insert/update
	dim Temp

	select case lcase(DataType)
		case "string", "memo", "ole object", "hyperlink"
			Temp = "'" & FixQuotes(Data) & "'"
			Temp = replace(Temp, "\'", "\\'")
		
		case "date"
			if isDate(Data) = false then Data = replace(Data, " - ", " ")
			if isDate(Data) then
				Temp = "'" & CDate(Data) & "'"
			else
				Temp = Data
			end if
			
		case "currency"
			Temp = ChangeToCurrency(Data)
			if isNull(Temp) = false then Temp = replace(Temp,",","")
		case else
			Temp = Data
	
	end select
	
	FieldFormat = Temp
End Function

Function DataFormat(DataTypeValue, DataTypeArray, Data)
	' Formats data from correct datatype database format
	' from XML file when 1st logged in
	' Array: 0=long name 1=type number 2=short name
	
		dim i
		dim TempData
		
		TempData = Data
		
		if isNull(Data) = false and isArray(DataTypeArray) then
			for i = 0 to ubound(DataTypeArray)
				' Find datavalue
				if CInt(DataTypeArray(i,1)) = CInt(DataTypeValue) then
					Select Case lcase(DataTypeArray(i,2))	' Format
						case "int"
							TempData = CInt(TempData)
						case "long"
							TempData = CLng(TempData)
						case "sng"
							TempData = CSng(TempData)
						case "dbl"
							TempData = CDbl(TempData)
						case "byte"
							TempData = CByte(TempData)
						case "cur"
							TempData = ChangeToCurrency(TempData)
						case "str"
							TempData = CStr(TempData)
						case "bool"
							TempData = CBool(TempData)
						case "date"
							TempData = formatdatetime(TempData, g_DateFormat)
					End Select
					exit for
				end if
			next
		end if
				
		DataFormat = TempData

End Function

Function ConvertRStoXML(objRS, strTopLevelNodeName, strRowNodeName)
	 On Error Resume Next
	
	 Dim objDom
	 Dim objRoot
	 Dim objField
	 Dim objFieldValue
	 dim objFieldType
	 Dim objcolName
	 Dim objattTabOrder
	 Dim objPI
	 Dim x
	 Dim objRSField
	 Dim objRow
	
	 'Instantiate the Microsoft XMLDOM.
	 Set objDom = server.CreateObject("Microsoft.XMLDOM")
	 objDom.preserveWhiteSpace = True
	
	 'Create your root element and append it to the XML document.
	 Set objRoot = objDom.createElement(replace(strTopLevelNodeName, " ", ""))
	 objDom.appendChild objRoot
	
	 Do While Not objRS.EOF
	   Set objRow = objDom.CreateElement(strRowNodeName)
	
	   For Each objRSField in objRS.Fields
		 Set objField = objDom.createElement("field")
	
		 Set objcolName = objDom.createAttribute("name")
		 objcolName.Text = RemoveXMLCharacters(objRSField.Name)
		 objField.SetAttributeNode(objColName)
	
		 Set objFieldValue = objDom.createElement("value")
		 objFieldValue.Text = RemoveXMLCharacters(objRSField.Value)

		 Set objFieldType = objDom.createElement("type")
		 objFieldType.Text = objRSField.Type
	

		 objField.appendChild objFieldValue
		 objField.appendChild objFieldType
	
		 objRow.appendChild objField
	   Next 
	
	   objRoot.appendChild objRow
	
	   objRS.MoveNext
	 Loop
	
	 Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
	 objDom.insertBefore objPI, objDom.childNodes(0)
	
	 ConvertRStoXML = objDom.xml
	
	 'Clean up...
	 Set objDom = Nothing
	 Set objRoot = Nothing
	 Set objField = Nothing
	 Set objFieldValue = Nothing
	 Set objcolName = Nothing
	 Set objattTabOrder = Nothing
 Set objPI = Nothing
End Function

Function RemoveXMLCharacters(Data)
	' Removes < and > characters from string
	if isNull(Data)  then Data = ""
	
	if isNumeric(Data) = false then
		Data = replace(Data, "<", "&lt;")
		Data = replace(Data, ">", "&gt;")
	end if
	
	RemoveXMLCharacters = Data
End function

Function FieldExists(FieldName, RS)
	' Checks if field exists in a recordset
	Dim fld
	FieldExists = false
	
	For Each fld In RS.Fields
		If fld.Name = FieldName Then
			FieldExists = true
			Exit For
		End If
	Next
End Function	


%>