rdbms-asp2.asp

RDBMS with flash and asp

<%@ Language=VBScript %>
<!--#include file="adovbs.inc" -->
<%

Private Function IDExists(Table,KeyField, KeyID)
	'Check to see if id field exists 
	'Would only need to be called for Microsoft Access - see comment below in each nodetype processor
	rs1.Open "select " & KeyField & " from " & Table & " where " & Keyfield & "=" & KeyID,cnn
	If rs1.RecordCount = 0 Then
		IDExists = False
	else
		IDExists = True
	End If
	If rs1.State = adStateOpen Then rs1.Close
End Function
	'Distributed configured for Microsoft Access
	CONST DBRETURNSERROR = False	' For Microsoft Access and others that do not return an error through
									'  ADO when an update or delete is called for a key value that doesn't exist.
'	CONST DBRETURNSERROR = True		' For Microsoft SQL Server and others that do return the above error.
	CONST DBRETURNSIDENTITY = False	' For Microsoft Access and others that can't return an identity field
									'  for a newly inserted record with an identity (or autonumber) field.
'	CONST DBRETURNSIDENTITY = True 	' For Microsoft SQL Server and others that return an identity during
									' an Insert, when asked nicely.

	'SETUP DB CONNECTION - General stuff.
	
	Set cnn = Server.CreateObject("ADODB.Connection")
	Set rs1 = Server.CreateObject("ADODB.RecordSet")
	cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("rdbms-asp2.mdb") & ";"
   	cnn.CursorLocation = adUseClient
    rs1.CursorLocation = adUseClient
    rs1.CacheSize = 500
    rs1.CursorType = adOpenStatic
    rs1.MaxRecords = 30000
    rs1.PageSize = 25

	'INPUT SECTION
		'Requires the incoming request to be a POST XML
		'Document with 2 nodes inside the documentElement:
		'<request>
		'	<func>SaveContacts</func>
		'	<update_packet id="xxxxxx">
		'		your update packet here........
		'	</update_packet>
		'</request>
		if Request("test")="1" then
			XMLRequest = false
			func = Request("func")
		else
			XMLRequest = true
			Set docReceived = CreateObject("MSXML2.DOMDocument") 
			docReceived.async = False 
			docReceived.load Request 
			Set RequestRoot = docReceived.documentElement
			func =	RequestRoot.getElementsByTagName("func")(0).text
		end if

	'Setup XML Response 
		'The response is an XML Document "results_packet" that is bound directly back from the connector
		'"results" property to the Resolver "updateResults" property. As long as the deltaPacket is bound
		'"in/out" from the dataSet to the resolver, it will be passed directly back to the dataSet and any 
		'inserted records will be updated with their new id value and other operations will be confirmed.
		dim ResultsPacket,dqt,dtd,ResultsPacketElement
		dqt = chr(34)
		Set ResultsPacket = Server.Createobject("MSXML.DOMDocument")
		Set dtd = ResultsPacket.createProcessingInstruction("xml", "version=" & dqt & "1.0" & dqt )
		ResultsPacket.appendChild dtd
		Set ResultsPacketElement = ResultsPacket.createElement("results_packet")
		ResultsPacket.appendChild ResultsPacketElement

	'PROCESSING SECTION
	select case func
	case "GetContacts":
		rs1.Open "select * from Contacts order by name",cnn
		  Do Until rs1.EOF
			set recElement = ResultsPacket.createElement("rec")
			for i = 0 to rs1.Fields.Count - 1
			  recElement.setAttribute rs1(i).name, rs1(i).value
			  ResultsPacket.lastChild.appendChild recElement
			next
			rs1.MoveNext
		  Loop
		  rs1.close
	case "SaveContacts"
			'GET UPDATEPACKET FROM REQUEST XML
			'assign the updatePacket text to it's own XML Document For processing.
			Set UpdatePacket = CreateObject("MSXML2.DOMDocument") 
			UpdatePacket.async = False 
			UpdatePacket.loadXML RequestRoot.getElementsByTagName("updatePacket")(0).text
			Set UP = UpdatePacket.documentElement

			'PROCESS UPDATEPACKET
			'Get appropriate data out of document node (transID,NullValue)
			Table = UP.getAttribute("tableName")
			NullValue = UP.getAttribute("nullValue")
			'Set TransID in root of our resultsPacket - must match updatePacket so DS will process properly.
			ResultsPacketElement.SetAttribute "transID",UP.getAttribute("transID")
			SQLs = ""
			
			'PROCESS ALL "UPDATE" NODES
			Set UpdateNodes = UP.getElementsByTagName("update")
			For Each UpdateNode In UpdateNodes
				'CREATE OPERATION RESULT NODE
					Set OpElement = ResultsPacket.createElement("operation")
					OpElement.SetAttribute "op","update"
					OpElement.SetAttribute "id",UpdateNode.getAttribute("id")

				Set UpdateFields = UpdateNode.getElementsByTagName("field")
				'Must iterate through fields once to get the key id -
				' No guarantee what order fields are in (key field not always the first one)
				For each UpdateField in UpdateFields
					If UpdateField.getAttribute("key") = "true" Then
						KeyField = UpdateField.getAttribute("name")
						KeyID = UpdateField.getAttribute("oldValue")
						Exit For
					End If
				Next
				
				'Check to see if id field exists, abort ADO call if it doesn't
				Dim SendCall
				If DBRETURNSERROR then
					SendCall = True
				Else
					If IDExists(Table,KeyField,KeyID) Then 
						SendCall = True
					Else
						OpElement.setAttribute "msg",KeyField & " " & KeyID & " does not exist"
						SendCall = False
					End If
				End If
				
				'Second time through For all non-key fields (fields to be updated)
				If SendCall then
					For each UpdateField in UpdateFields
						If UpdateField.getAttribute("key") = "false" Then
							fieldname = UpdateField.getAttribute("name")
							fieldtype = UpdateField.getAttribute("type")
							newfieldvalue = UpdateField.getAttribute("newValue")
							If fieldtype <> "Integer" and fieldtype <> "Number" Then
								newfieldvalue = "'" & newfieldvalue & "'"
							End If
							sql = "update " & Table & " Set " & fieldname & "=" & newfieldvalue & " where " & KeyField & "=" & KeyID
							On Error Resume Next
							cnn.Execute sql
							If cnn.Errors.Count > 0  Then
								OpElement.SetAttribute "msg",cnn.Errors(0).Description & "/" & sql
								cnn.Errors.Clear
							End If
							On Error Goto 0
						End If
					Next
				End If
	
				'Add Result Element to ResultsPacket
					ResultsPacket.lastChild.appendChild OpElement
			Next

			'PROCESS ALL "DELETE" NODES
			Set DeleteNodes = UP.getElementsByTagName("delete")
			For Each DeleteNode In DeleteNodes
				'CREATE OPERATION RESULT NODE
					Set OpElement = ResultsPacket.createElement("operation")
					OpElement.SetAttribute "op","delete"
					OpElement.SetAttribute "id",DeleteNode.getAttribute("id")

				'FIND KEY FIELD SO WE CAN BUILD SQL STMT
				Set DeleteFields = DeleteNode.getElementsByTagName("field")
				For each DeleteField in DeleteFields
					If DeleteField.getAttribute("key") = "true" Then
						KeyField = DeleteField.getAttribute("name")
						KeyID = DeleteField.getAttribute("oldValue")
						Exit For
					End If
				Next
				
				'Microsoft Access doesn't report an error when a delete is called for a keyvalue that 
				'doesn't exist, but since it's already gone from our Flash dataset, we'll just let it
				'think that it worked. Other types of errors will still be reported, and dbs that do return
				'errors are handled fine.
				
				'Delete from DB
					sql = "delete from " & Table & " where " & KeyField & "=" & KeyID
					On Error Resume Next
					cnn.Execute sql
					If cnn.Errors.Count > 0 Then
						OpElement.SetAttribute "msg",cnn.Errors(0).Description & "/" & sql
						cnn.Errors.Clear
					End If
					On Error Goto 0

				'Add Result Element to ResultsPacket
					ResultsPacket.lastChild.appendChild OpElement
			Next

			'PROCESS ALL "INSERT" NODES
			Set InsertNodes = UP.getElementsByTagName("insert")
			For Each InsertNode In InsertNodes
				'CREATE OPERATION RESULT NODE
					Set OpElement = ResultsPacket.createElement("operation")
					OpElement.SetAttribute "op","insert"
					OpElement.SetAttribute "id",InsertNode.getAttribute("id")

				'Gather fields to build SQL stmt
				Set InsertFields = InsertNode.getElementsByTagName("field")
				FieldsStr = ""
				ValuesStr = ""
				For each InsertField in InsertFields
					fieldname = InsertField.getAttribute("name")
					fieldtype = InsertField.getAttribute("type")
					If InsertField.getAttribute("key") = "false" Then
						'NON-KEY FIELD, INCLUDE IN INSERT STMT
						newfieldvalue = InsertField.getAttribute("newValue")
						If fieldtype = "Integer" or fieldtype = "Number" Then
							ValStr = newfieldvalue
						Else
							ValStr = "'" & newfieldvalue & "'"
						End If
						If len(ValuesStr) > 0 Then
							ValuesStr = ValuesStr & "," & ValStr
						Else
							ValuesStr = ValStr
						End If
						If len(FieldsStr) > 0 Then
							FieldsStr = FieldsStr & "," & InsertField.getAttribute("name")
						Else
							FieldsStr = InsertField.getAttribute("name")
						End If
					Else
						'KEY FIELD
						KeyField = fieldname
					End If
				Next

				'INSERT TO DB
					Identity = ""
					If DBRETURNSIDENTITY Then
						On Error Resume Next
						rs1.Open sql,cnn
						If cnn.Errors.Count > 0 Then
							OpElement.SetAttribute "msg",cnn.Errors(0).Description & "/" & sql
							cnn.Errors.Clear
						End If
						If rs1.State = adStateOpen Then
							rs1.Close
						End If
					Else
						'These statements will work with Micorsoft Access - unFortunately, you can't return the identity value
						'so you have to do a quick select statement - could cause data collisions in multi-user environment
						sql = "insert into " & Table & " (" & FieldsStr & ") values(" & ValuesStr & ")"
						On Error Resume Next
						cnn.Execute sql
						If cnn.Errors.Count > 0 Then
							OpElement.SetAttribute "msg",cnn.Errors(0).Description & "/" & sql
							cnn.Errors.Clear
						Else
						End If
					End If
					
					On Error Goto 0

				'IDENTIFY NEW KEY VALUE FOR THIS NEW RECORD
					If Not DBRETURNSIDENTITY Then
						'FOR ACCESS, GET LAST KEYFIELD IN DB - NOT GOOD FOR MULTIUSER ENVIRONMENT, ALL WE CAN DO FOR NOW
							rs1.open "select top 1 " & KeyField & " from " & Table & " order by " & KeyField & " desc",cnn
							Identity = rs1(KeyField)
							rs1.close
					End If

					If Len(Identity) > 0 Then
						'PUT IDENTITY IN FIELD NODE
						Set IDElement = ResultsPacket.createElement("field")
						IDElement.SetAttribute "name",KeyField
						IDElement.SetAttribute "curValue",Identity
						OpElement.appendChild IDElement
					End If

				'Add Result Element to ResultsPacket
					ResultsPacket.lastChild.appendChild OpElement
			Next
	End select

	response.write ResultsPacket.xml

	'CLEANUP DATABASE CONNECTION	
	cnn.close
	Set rs1 = nothing
	Set cnn = nothing
%>