ASP中非数据库实现数据对象的定义及处理
ASP中非数据库实现数据对象的定义及处理
说非数据库方式，有些托大，但在没有数据库的情况下，也算给了一个锻炼的好机会，更何况本人对有事没事就整数据库玩的方式是深恶痛绝，有些时候，在资源有限及功能简单的情况下，利用文件管理本身就能很好的实现一个系统，又何必非用数据库不可呢？
好的，开说ASP程序，ASP程序强大的原因主要在于COM对象的扩展，所以在一阵的头脑风暴后，打起了一套组合拳：Scripting.FileSystemObject，Scripting.Dictionary以及Msxml2.DOMDocument.4.0。
下面就以文件管理程序为例，对实现做简要说明：
首先，是构思。
1. 管理的数据对象是文件对象，而文件对象可以对应到XML中的某个结点
2. 文件对象的结构，可以自行定义
3. 文件对象的增加、删除、修改以及查询
XML中充分利用Xpath，实现查询比较简单，所以构思后问题主要应该归结为XML结点的增删改的问题，以及对象结构的定义。增删改不必多说，关键是对象结构的自定义（在面向对象中就是类的声明）。
接下来，是实现。
一是结构文件
这里结构包括：英文名字，中文显示名，类型，显示模版（或参照），默认值等
其实就是类似schema的东西，然后把这些结构保存在一个文件中，很多操作时就可以在循环中自动处理了，比如显示一个文件时，就可以按照这个结构来显示所有属性字段。
如下为一个结构文件documentx.dna的示范内容：
*/DOCS=文件
*/DOCS/@VERSION=版本%%STRING%%[NUM].[NUM].[NUM].[NUM]%%1.0.0.0
*/DOCS/DOC=文件
+/DOCS/DOC/@ID=标识%%STRING%%%%=UniqueID()
+/DOCS/DOC/@HOT=人气%%NUM%%%%0
/DOCS/DOC/TITLE=标题
/DOCS/DOC/DEPARTFROM=来文单位%%DICTIONARY%%department%%
/DOCS/DOC/@DONE=是否处理完毕%%BOOL%%%%
需要说明的是英文名称采用Xpath的方式，是为了方便XML处理。
英文名称前加*号表示为系统字段，同时也是非文件对象的属性字段
英文名称前加+表示该字段对用户来说是只读的，其值由系统指定。
另外前加*或者加+号也好，也有防止误删的原因，因为*号或+号是不会显示给用户的。
用=号分隔英文名称与其他部分，而其他部分中用%%分隔，依次为中文显示名，该项类型，显示模版（或参照），默认值。
需要说明的是类型，如果类型为DICTIONARY的话，显示模版（或参照）或参照的为具体的DICTIONARY文件，DICTIONARY的保存形式，形同Delphi中TstringList的保存形式，用=号把关键字与值分隔：
CS1=测试单位1
CS2=测试单位2
二是利用新建一个文件，说明显示的问题
先看示范文件：
<% @LANGUAGE=VBSCRIPT %>
<%
Dim sKey, sValue, Sign, Pos, AttrID, Values, F, FName, Count
%>
<html>
<head>
<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>
<meta http-equiv='Content-Language' content='zh-cn'>
</head>
<body>
<form method='POST' action='Documents!Save.asp'>
<table border='0' width='100%' cellpadding='0' style='border-collapse: collapse'>
<tr>
<td bgcolor='#C0C0C0'><b>新建</b></td>
</tr>
<tr>
<td>
<table border='1' width='100%' cellspacing='0' cellpadding='0' style='border-collapse: collapse' bordercolor='#000000'>
<tr>
<td width='10%'>项</td>
<td>值</td>
</tr>
<%
'Count = 0
'DOCUMENTX为Scripting.Dictionary对象，为documentx.dna的内容
For Each sKey In DOCUMENTX
Sign = Left(sKey, 1)
If Sign<>'*' Then
sValue = DOCUMENTX.Item(sKey)
Values = Split(sValue & '%%%%%%', '%%')
Pos = InStrRev(sKey, '/')
AttrID = Right(sKey, Len(sKey) - Pos)
If Left(AttrID,1)='@' Then
AttrID = Mid(AttrID, 2) & '_INLINE' '也就是说@为一般为内置属性
End If
AttrID = 'ATTR_' & AttrID
%>
<tr>
<td width='10%'><%=Values(0)%></td>
<td>
<%
If Sign='+' Then '如果为只读属性
%>
<input type='hidden' name='<%=AttrID %>' value='' />系统计算：<%=Values(3) %>
<%
Else
'按照类型进行显示
If Values(1)='BOOL' Then
Response.Write '<input type=''checkbox'' name=''' & AttrID & ''' value=''1'' />'
Else
If Values(1)='DICTIONARY' Then
'ENVIRONMENT为Scripting.Dictionary对象
'ENVIRONMENT.Item(“ROOT”)中存储了该程序管理的根目录
FName = ENVIRONMENT.Item('ROOT') & '\dictionary\' & Values(2) & '.dic'
%>
<select name='<%=AttrID %>'>
<%
If FSO.FileExists(FName) Then
Set F = FSO.OpenTextFile(FName, 1, False)
Do While Not F.AtEndOfStream
sValue = F.ReadLine
Pos = InStr(sValue, '=')
If Pos>0 Then
Response.Write '<option value=''' & Left(sValue, Pos-1) & '''>' & Right(sValue, Len(sValue)-Pos) & '</option>'
End If
Loop
F.Close
End If
%>
</select>
<%
Else
Response.Write '<input type=''textbox'' name=''' & AttrID & ''' size=''30'' />'
End If
End If
End If
%>
</td>
</tr>
<%
'Count = Count + 1
End If
Next
%>
<tr>
<td width='10%'></td>
<td></td>
</tr>
<tr>
<td width='10%'></td>
<td></td>
</tr>
</table>
</td>
</tr>
<tr>
<td bgcolor='#C0C0C0' align='right' valign='middle'><input type='submit' name='btnSave' value='保存' /> <input type='button' name='btnReset' value='重输' /></td>
</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 & ''']')
If oXmlSubNode Is Nothing Then
oXmlRoot.appendChild oXmlNode
Else
oXmlRoot.replaceChild oXmlNode, oXmlSubNode
End If
DocumentSaveToXml = True
End Function
%>
