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 cellpadding="0">
<tr>
<td bgcolor="#C 0C 0C 0"><b> 新建 </b></td>
</tr>
<tr>
<td>
<table cellspacing="0" cellpadding="0" bordercolor="#000000">
<tr>
<td> 项 </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><%=Values(0)%></td>
<td>
<%
If Sign="+" Then ' 如果为只读属性
%>
<input type="hidden" value="" /> 系统计算: <%=Values(3) %>
<%
Else
' 按照类型进行显示
If Values(1)="BOOL" Then
Response.Write "<input type=""checkbox""" & AttrID & """ value=""1"" />"
Else
If Values(1)="DICTIONARY" Then
'ENVIRONMENT 为 Scripting.Dictionary 对象
'ENVIRONMENT.Item(“ROOT”) 中存储了该程序管理的根目录
FName = ENVIRONMENT.Item("ROOT") & "\dictionary\" & Values(2) & ".dic"
%>
<select>
<%
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""" & AttrID & """ size=""30"" />"
End If
End If
End If
%>
</td>
</tr>
<%
'Count = Count + 1
End If
Next
%>
<tr>
<td> </td>
<td> </td>
</tr>
<tr>
<td> </td>
<td> </td>
</tr>
</table>
</td>
</tr>
<tr>
<td bgcolor="#C 0C 0C 0" valign="middle"><input type="submit" value=" 保存 " /> <input type="button" 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
%>