非数据库实现数据对象的实例及说明
</tr>
</table>
</form>
</body>
</html>
三是利用代码说明xml存储的实现
<% @LANGUAGE=VBSCRIPT %>
<!-- #include file="System.inc.asp" -->
<!-- #include file="Document.inc.asp" -->
<%
'System.inc.asp中包含UniqueID()函数
'首先，获取用户客户端提交的数据信息
Dim PostData
Set PostData = Server.CreateObject("Scripting.Dictionary")
Dim Values, Key, Value, AttrID, Pos, Sign
For Each Key In DOCUMENTX
Sign = Left(Key, 1)
If Sign<>"*" Then
Value = DOCUMENTX.Item(Key)
Values = Split(Value & "%%%%%%", "%%")
Pos = InStrRev(Key, "/")
AttrID = Mid(Key, Pos + 1)
If Left(AttrID,1)="@" Then
AttrID = Mid(AttrID, 2) & "_INLINE" '也就是说@为一般为内置属性
End If
AttrID = "ATTR_" & AttrID
If Sign="+" Then
Key = Mid(Key, 2)
End If
'If Sign="+" Then '系统属性
'End If
PostData.Item(Key) = Request.Form(AttrID) '取得用户提交的数据
End If
Next
'下面是把PostData中的数据存储到XML中去
Dim oXml
Set oXml = Server.CreateObject("Msxml2.DOMDocument.4.0")
Dim TimeSpec, ZoneID, DocID, FName, FPath
'计算该文档属于的区域
'注意：创建新文档与修改原有文档的计算方式不同，这里只做了创建的处理
'新建文档的处理
TimeSpec = Now
'ZoneID为YYYYMM形式
ZoneID = Right ("20" & Year(TimeSpec), 4) & Right("0" & Month(TimeSpec), 2)
FPath = ENVIRONMENT.Item("ROOT")
If Not FSO.FileExists(FPath & "\data\" & ZoneID & ".dat") Then
If Not FSO.FileExists(FPath & "\etc\blank.dat") Then
Application("*FAIL") = "系统配置不正确，空白数据模版文件未找到！"
Set oXml = Nothing
Set PostData = Nothing
Response.Redirect "Fail.asp"
End If
FSO.CopyFile FPath & "\etc\blank.dat", FPath & "\data\" & ZoneID & ".dat"
End If
oXml.load FPath & "\data\" & ZoneID & ".dat"
'由于这里处理的是新建的情况，所以指定新的DocumentID
PostData.Item("/DOCS/DOC/@ID") = UniqueID()
PostData.Item("/DOCS/DOC/@HOT") = "0"
DocumentSaveToXml PostData, oXml
oXml.save FPath & "\data\" & ZoneID & ".dat"
Set oXml = Nothing
Set PostData = Nothing
Response.Write "OK!"
%>
DocumentSaveToXml函数在Document.inc.asp中
<%
'DocumentSaveToXml
'目的：把Dict中的数据导入到指定的Xml对象中去
'说明：如果Dict中指定ID的数据已经存在于Xml中，则替换原有数据
Function DocumentSaveToXml(ByRef Dict, ByRef oXml)
DocumentSaveToXml = False
If Dict Is Nothing Or oXml Is Nothing Then
Exit Function
End If
Dim oXmlRoot, oXmlNode, oXmlSubNode
Set oXmlRoot = oXml.documentElement
Set oXmlNode = oXml.createElement("DOC")
Dim Key, Value
Dim Pos, AttrID, DocID
For Each Key In Dict
Value = Dict.Item(Key)
'根据Key
Pos = InStrRev(Key, "/")
AttrID = Mid(Key, Pos + 1)
If Left(AttrID, 1)="@" Then '如果是属性
oXmlNode.setAttribute Mid(AttrID, 2), Value
Else
Set oXmlSubNode = oXml.createElement(AttrID)
oXmlSubNode.text = Value
oXmlNode.appendChild oXmlSubNode
End If
Next
'别忘了，这里的ID属性定义，在documentx.dna中前面加上了+号
'也正是这些加*或者加+号属性结构不可以删的原因
DocID = oXmlNode.getAttribute("ID")
Set oXmlSubNode = oXml.selectSingleNode("/DOCS/DOC[@ID=""" & DocID &
