?? rdbms-asp2.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
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -