ASP设计模式

我佛山人

大家先讨论一下，你们是怎么设计架构一个系统的，教程稍后奉上

xwl_xiaochong

1 根据所需，整理出前台需要的功能模块，如：新闻发布模块，留言模块，在线统计模块，会员注册模块，论坛模块等等。
2 按每个功能模块写出简要的文档
3 进行数据库设计
4 把每一个功能模块实现，并做好安全测试工作！
5 进行管理功能的整合，即尽可能把所有功能模块的管理放到一快解决！
6 美工操作
7 对整个系统进行具体测试，特别是安全测试！
以上只是我一家之言！我基本上都是这样做的！呵呵！

黑色妖风

学习学习

[此贴子已经被作者于2005-6-21 15:51:15编辑过]

我佛山人

如何设计架构？

axing（转载自www.Linuxaid.com.cn）　　2003年02月01日

Part 1 层 　　层（layer）这个概念在计算机领域是非常了不得的一个概念。计算机本身就体现了一种层的概念：系统调用层、设备驱动层、操作系统层、CPU指令集。每个层都负责自己的职责。网络同样也是层的概念，最著名的OSI的七层协议。 　　层到了软件领域也一样好用。为什么呢？我们看看使用层技术有什么好处： 　　● 你使用层，但是不需要去了解层的实现细节。 　　● 可以使用另一种技术来改变基础的层，而不会影响上面的层的应用。 　　● 可以减少不同层之间的依赖。 　　● 容易制定出层标准。 　　● 底下的层可以用来建立顶上的层的多项服务。 当然，层也有弱点： 　　● 层不可能封装所有的功能，一旦有功能变动，势必要波及所有的层。 　　● 效率降低。 　　当然，层最难的一个问题还是各个层都有些什么，以及要承担何种责任。 典型的三层结构 　　三层结构估计大家都很熟悉了。就是表示（presentation）层, 领域（domain）层, 以及基础架构（infrastructure）层。 　　表示层逻辑主要处理用户和软件的交互。现在最流行的莫过于视窗图形界面（wimp）和基于html的界面了。表示层的主要职责就是为用户提供信息，以及把用户的指令翻译。传送给业务层和基础架构层。 基础架构层逻辑包括处理和其他系统的通信，代表系统执行任务。例如数据库系统交互，和其他应用系统的交互等。大多数的信息系统，这个层的最大的逻辑就是存储持久数据。 　　还有一个就是领域层逻辑，有时也被叫做业务逻辑。它包括输入和存储数据的计算。验证表示层来的数据，根据表示层的指令指派一个基础架构层逻辑。 　　领域逻辑中，人们总是搞不清楚什么事领域逻辑，什么是其它逻辑。例如，一个销售系统中有这样一个逻辑：如果本月销售量比上个月增长10％，就要用红色标记。要实现这个功能，你可能会把逻辑放在表示层中，比较两个月的数字，如果超出10％，就标记为红色。 　　这样做，你就把领域逻辑放到了表示层中了。要分离这两个层，你应该现在领域层中提供一个方法，用来比较销售数字的增长。这个方法比较两个月的数字，并返回boolean类型。表示层则简单的调用该方法，如果返回true，则标记为红色。 例子 　　层技术不存在说永恒的技巧。如何使用都要看具体的情况才能够决定，下面我就列出了三个例子： 　　例子1：一个电子商务系统。要求能够同时处理大量用户的请求，用户的范围遍及全球，而且数字还在不断增长。但是领域逻辑很简单，无非是订单的处理，以及和库存系统的连接部分。这就要求我们1、表示层要友好，能够适应最广泛的用户，因此采用html技术；2、支持分布式的处理，以胜任同时几千的访问；3、考虑未来的升级。 　　例子2：一个租借系统。系统的用户少的多，但是领域逻辑很复杂。这就要求我们制作一个领域逻辑非常复杂的系统，另外，还要给他们的用户提供一个方便的输入界面。这样，wimp是一个不错的选择。 　　例子3：简单的系统。非常简单，用户少、逻辑少。但是也不是没有问题，简单意味着要快速交付，并且还要充分考虑日后的升级。因为需求在不断的增加之中。 何时分层 　　这样的三个例子，就要求我们不能够一概而论的解决问题，而是应该针对问题的具体情况制定具体的解决方法。这三个例子比较典型。 　　第二个例子中，可能需要严格的分成三个层次，而且可能还要加上另外的中介（mediating）层。例3则不需要，如果你要做的仅是查看数据，那仅需要几个server页面来放置所有的逻辑就可以了。 　　我一般会把表示层和领域层/基础架构层分开。除非领域层/基础架构层非常的简单，而我又可以使用工具来轻易的绑定这些层。这种两层架构的最好的例子就是在VB、PB的环境中，很容易就可以构建出一个基于SQL数据库的windows界面的系统。这样的表示层和基础架构层非常的一致，但是一旦验证和计算变得复杂起来，这种方式就存在先天缺陷了。 　　很多时候，领域层和基础架构层看起来非常类似，这时候，其实是可以把它们放在一起的。可是，当领域层的业务逻辑和基础架构层的组织方式开始不同的时候，你就需要分开二者。 更多的层模式 　　三层的架构是最为通用的，尤其是对IS系统。其它的架构也有，但是并不适用于任何情况。 　　第一种是Brown model [Brown et al]。它有五个层：表示层（Presentation），控制/中介层（Controller/Mediator），领域层（Domain）, 数据映射层（Data Mapping）, 和数据源层（Data Source）。它其实就是在三层架构种增加了两个中间层。控制/中介层位于表示层和领域层之间，数据映射层位于领域层和基础架构层之间。 　　表示层和领域层的中介层，我们通常称之为表示-领域中介层，是一个常用的分层方法，通常针对一些非可视的控件。例如为特定的表示层组织信息格式，在不同的窗口间导航，处理交易边界，提供Server的facade接口（具体实现原理见设计模式）。最大的危险就是，一些领域逻辑被放到这个层里，影响到其它的表示层。 　　我常常发现把行为分配给表示层是有好处的。这可以简化问题。但表示层模型会比较复杂，所以，把这些行为放到非可视化的对象中，并提取出一个表示-领域中介层还是值得的。 　　Brown ISA 　　表示层 表示层 　　控制/中介层 表示-领域中介层 　　领域层 领域层 　　数据映射层 数据库交互模式中的Database Mapper 　　数据源层 基础架构层 　　领域层和基础架构层之间的中介层属于本书中提到的Database Mapper模式，是三种领域层到数据连接的办法之一。和表示-领域中介层一眼，有时候有用，但不是所有时候都有用。 　　还有一个好的分层架构是J2EE的架构，这方面的讨论可以见『J2EE核心模式』一书。他的分层是客户层（Client），表示层（Presentation），业务层（Business ），整合层（Integration），资源层（Resource）。差别如下图： 　　J2EE核心 ISA 　　客户层 运行在客户机上的表示层 　　表示层 运行在服务器上的表示层 　　业务层 领域层 　　整合层 基础架构层 　　资源层 基础架构层通信的外部数据 　　微软的DNA架构定义了三个层：表示层（presentation），业务层（business），和数据存储层（data access），这和我的架构相似，但是在数据的传递方式上还有很大的不同。在微软的DNA中，各层的操作都基于数据存储层传出的SQL查询结果集。这样的话，实际上是增加了表示层和业务层同数据存储层之间的耦合度。 DNA的记录集在层之间的动作类似于Data Transfer Object。 Part 2 组织领域逻辑 　　要组织基于层的系统，首要的是如何组织领域逻辑。领域逻辑的组织有好几种模式。但其中最重要的莫过于两种方法：Transation Script和Domain Model。选定了其中的一种，其它的都容易决定。不过，这两者之间并没有一条明显的分界线。所以如何选取也是门大学问。一般来说，我们认为领域逻辑比较复杂的系统可以采用Domain Model。 　　Transation Script就是对表示层用户输入的处理程序。包括验证和计算，存储，调用其它系统的操作，把数据回传给表示层。用户的一个动作表示一个程序，这个程序可以是script，也可以是transation，也可以是几个子程序。在例子1中，检验，在购物车中增加一本书，显示递送状态，都可以是一个Transation Script。 　　Domain Model是要建立对应领域名词的模型，例如例1中的书、购物车等。检验、计算等处理都放到领域模型中。 　　Transation Script属于结构性思维，Domain Model属于OO思维。Domain Model比较难使用，一旦习惯，你能够组织更复杂的逻辑，你的思想会更OO。到时候，即使是小的系统，你也会自然的使用Domain Model了。 　　但如何抉择呢？如果逻辑复杂，那肯定用Domain Model：如果只需要存取数据库，那Transation Script会好一些。但是需求是在不断进化的，你很难保证以后的需求还会如此简单。如果你的团队不善于使用Domain Model，那你需要权衡一下投入产出比。另外，即使是Transation Script，也可以做到把逻辑和基础架构分开，你可以使用Gateway。 　　对例2，毫无疑问要使用Domain Model。对例1就需要权衡了。而对于例3，你很难说它将来会不会像例2那样，你现在可以使用Transation Script，但未来你可能要使用Domain Model。所以说，架构的决策是至关紧要的。 　　除了这两种模式，还有其它中庸的模式。Use Case Controller就是处于两者之间。只有和单个的用例相关的业务逻辑才放到对象中。所以大致上他们还是在使用Transation Script，而Domain Model只是Database Gateway的一组集合而已。我不太用这种模式。 　　Table Module是另一个中庸模式。很多的GUI环境依托于SQL查询的返回结果。你可以建立内存中的对象，来把GUI和数据库分开来。为每个表写一个模块，因此每一行都需要关键字变量来识别每一个实例。 　　Table Module适用于很多的组件构建于一个通用关系型数据库之上，而且领域逻辑不太复杂的情况。Microsoft COM 环境，以及它的带ADO.NET的.NET环境都适合使用这种模式。而对于Java，就不太适用了。 　　领域逻辑的一个问题是领域对象非常的臃肿。因为对象的行为太多了，类也就太大了。它必须是一个超集。这就要考虑哪些行为是通用的，哪些不是，可以由其它的类来处理，可能是Use Case Controller，也可能是表示层。 　　还有一个问题，复制。他会导致复杂和不一致。这比臃肿的危害更大。所以，宁可臃肿，也不要复制。等到臃肿为害时再处理它吧。 选择一个地方运行领域逻辑 　　我们的精力集中在逻辑层上。领域逻辑要么运行在Client上，要么运行在Server上。 　　比较简单的做法是全部集中在Server上。这样你需要使用html的前端以及web server。这样做的好处是升级和维护都非常的简单，你也不用考虑桌面平台和Server的同步问题，也不用考虑桌面平台的其它软件的兼容问题。 　　运行在Client适合于要求快速反应和没有联网的情况。在Server端的逻辑，用户的一个再小的请求，也需要信息从Client到Server绕一圈。反应的速度必然慢。再说，网络的覆盖程度也不是说达到了100％。 　　对于各个层来说，又是怎么样的呢？ 　　基础架构层：一般都是在Server啦，不过有时候也会把数据复制到合适的高性能桌面机，但这是就要考虑同步的问题了。 　　表示层在何处运行取决于用户界面的设计。一个Windows界面只能在Client运行。而一个Web界面就是在Server运行。也有特别的例子，在桌面机上运行web server的，例如X Server。但这种情况少的多。 　　在例1中，没有更多的选择了，只能选在Server端。因此你的每一个bit都会绕一个大圈子。为了提高效率，尽量使用一些纯html脚本。 　　人们选用Windows界面的原因主要就是需要执行一些非常复杂的任务，需要一个合适的应用程序，而web GUI则无法胜任。这就是例2的做法。不过，人们应该会渐渐适应web GUI，而web GUI的功能也会越来越强大。 　　剩下的是领域逻辑。你可以全部放在Server，也可以全部放在Client，或是两边都放。 　　如果是在Client端，你可以考虑全部逻辑都放在Client端，这样至少保证所有的逻辑都在一个地方。而把web server移至Client，是可以解决没有联网的问题，但对反应时间不会有多大的帮助。你还是可以把逻辑和表示层分离开来。当然，你需要额外的升级和维护的工作。 　　在Client和Server端都具有逻辑并不是一个好的处理办法。但是对于那些仅有一些领域逻辑的情况是适用的。有一个小窍门，把那些和系统的其它部分没有联系的逻辑封装起来。 领域逻辑的接口 　　你的Server上有一些领域逻辑，要和Client通信，你应该有什么样的接口呢？要么是一个http接口，要么是一个OO接口。 　　http接口适用于web browser，就是说你要选择一个html的表示层。最近的新技术就是web service，通过基于http、特别是XML进行通信。XML有几个好处：通信量大，结构好，仅需一次的回路。这样远程调用的的开销就小了。同时，XML还是一个标准，支持平台异构。XML又是基于文本的，能够通过防火墙。 　　虽然XML有那么多的好处，不过一个OO的接口还是有它的价值的。hhtp的接口不明显，不容易看清楚数据是如何处理的。而OO的接口的方法带有变量和名字，容易看出处理的过程。当然，它无法通过防火墙，但可以提供安全和事务之类的控制。 　　最好的还是取二者所长。OO接口在下，http接口在上。但这样做就会使得实现机制非常的复杂。 Part 3 组织web Server 　　很多使用html方式的人，并不能真正理解这种方式的优点。我们有各种各样好用的工具，但是却搞到让程序难以维护。 　　在web server上组织程序的方式大致可以分为两种：脚本和server page。 　　脚本方式就是一个程序，用函数和方法来处理http调用。例如CGI脚本和java servlet。它和普通的程序并没有什么两样。它从web页面上获得html string形态的数据，有时候还要做一些表达式匹配，这正是perl能够成为CGI脚本的常用语言的原因。而java servelet则是把这种分析留给程序员，但它允许程序员通过关键字接口来访问信息，这样就会少一些表达式的判断。这种格式的web server输出是另一种html string，称为response，可以通过流数据来操作。 　　糟糕的是流数据是非常麻烦的，因此就导致了server page的产生，例如PHP，ASP，JSP。 　　server page的方式适合回应（response）的处理比较简单的情况。例如“显示歌曲的明细”，但是你的决策取决于输入的时候，就会比较杂乱。例如“通俗和摇滚的显示格式不同”。 　　脚步擅长于处理用户交互，server page擅长于处理格式化回应信息。所以很自然的就会采用脚本处理请求的交互，使用server page处理回应的格式化。这其实就是著名的MVC（Model View Controller）模式中的view/controller的处理。 web server端的MVC工作流程示意图 　　应用Model View Controller模式首要的一点就是模型要和web服务完全分离开来。使用Transaction Script或Domain Model模式来封装处理流程。 　　接下来，我们就把剩余的模式归入两类模式中：属于Controller的模式，以及属于View的模式。 View模式 　　View这边有三种模式：Transform View，Template View和Two Step View。Transform View和Template View的处理只有一步，将领域数据转换为html。Two Step View要经过两步的处理，第一步把领域数据转换为逻辑表示形式，第二步把逻辑表示转换为html。 　　两步处理的好处是可以将逻辑集中于一处，如果只有一步，变化发生时，你就需要修改每一个屏幕。但这需要你有一个很好的逻辑屏幕结构。如果一个web应用有很多的前端用户时，两步处理就特别的好用。例如航空订票系统。使用不同的第二步处理，就可以获得不同的逻辑屏幕。 　　使用单步方法有两个可选的模式：Template View，Transform View。Template View其时就是把代码嵌入到html页面中，就像现在的server page技术，如ASP，PHP，JSP。这种模式灵活，强大，但显得杂乱无章。如果你能够把逻辑程序逻辑在页面结构之外进行很好的组织，这种模式还是有它的优点的。 　　Transform View使用翻译方式。例如XSLT。如果你的领域数据是用XML处理的，那这种模式就特别的好用。 Controller模式 　　Controller有两种模式。一般我们会根据动作来决定一项控制。动作可能是一个按钮或链接。所这种模式就是Action Controller模式。 　　Front Controller更进一步，它把http请求的处理和处理逻辑分离开来。一般是只有一个web handle来处理所有的请求。你的所有的http请求的处理都由一个对象来负责。你改变动作结构的影响就会降到最小。

我佛山人

粘贴过来乱码，看这里吧
http://tech.ccidnet.com/pub/article/c294_a47418_p1.html

linynkl

顶，呵呵，什么时候我才能学成这样呢

我佛山人

xwl_xiaochong 讲的是项目动作流程，我要讲的是针对代码层次的设计
其实用ASP(using vbscript)来讲设计模式，很多模式是实现不了的，因为VBScript不是纯粹的OO语言，缺少很多OO特性，比如说无法继承，重载，因此ASP比JSP和PHP的编写少了许多乐趣。虽然可以通过额外的扩展，使web服务器支持phyon之类的语言，不过，受安全及其它因素的限制，适用范围不大。JScript虽然也可作ASP的脚本语言，可是JScript没有Class这样显式的关键字来标示类，对类的字段也没有Get和Set这类的设置限制，如果项目足够大，将会造成混乱，给维护及管理带来隐患。
所以，这里仅仅是以设计模式思想作指导，以VBScript为实现来编写ASP。
我们研究的是单个模块的实现过程。

我佛山人

大部分ASP应用，都离不开对数据库的访问及操作，所以，对于数据库部分的访问操作，我们应该单独抽象出来，封装成一个单独的类。如果所用语言支持继承，可以封装一个这样的类，然后在数据操作层继承即可。下面是我写的一个ACCESS数据库访问的类，针对ACCESS作了优化，不过因为缺少足够的应用测试，可能仍然存在未知的bug及应用限制，主要代码如下：
<%
Class Oledb
Private IDataPath
Private IConnectionString
Private Conn
Private Cmd
Private Param
Private Rs
Public Property Let DataPath(ByVal Value)
IDataPath = Value
IConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(IDataPath)
End Property
Public Property Get DataPath()
DataPath = IDataPath
End Property
Public Property Let ConnectionString(ByVal Value)
IConnectionString = Value
End Property
Public Property Get ConnectionString()
ConnectionString = IConnectionString
End Property
Public Function OpenConn()
If Conn.State = adStateClosed Then
Conn.Open ConnectionString
End If
Set OpenConn = Conn
End Function
Public Function Insert(ByVal Sql, ByVal Values)
OpenConn()
Rs.Open Sql, Conn, 3, 3, adCmdText
Rs.AddNew
Dim i, l
l = UBound(Values)
For i = 1 To l + 1
Rs(i) = Values(i - 1)
Next
Rs.Update
Insert = Rs(0)
End Function
Public Function Execute(ByVal Sql)
OpenConn()
Set Execute = Conn.Execute(Sql)
End Function
Public Function ExecuteScalar(ByVal Sql)
Dim iRs : Set iRs = Execute(Sql)
If Not iRs.BOF Then ExecuteScalar = iRs(0)
End Function
Public Function ExecuteNonQuery(ByVal Sql)
OpenConn()
Call Conn.Execute(Sql, ExecuteNonQuery)
End Function
Public Function InsertSp(ByVal Sql, ByVal Params)
OpenConn()
Rs.Open Sql, Conn, 3, 3, adCmdStoredProc
Rs.AddNew
Dim i, l
l = UBound(Params)
For i = 1 To l + 1
Rs(i) = Params(i - 1)
Next
Rs.Update
InsertSp = Rs(0)
End Function
Public Function ExecuteSp(ByVal SpName, ByVal Params)
With Cmd
Set .ActiveConnection = OpenConn()
.CommandText = SpName
.CommandType = &H0004
.Prepared = True
Set ExecuteSp = .Execute(,Params)
End With
End Function
Public Function ExecuteDataTableSp(ByVal SpName, ByVal Params)
OpenConn()
If Rs.State <> adStateClose Then
Rs.Close()
End If
Dim SpStr
If IsNull(Params) Or IsEmpty(Params) Then
SpStr = SpName
Else
If IsArray(Params) Then
SpStr = "Execute " & SpName & " " & Join(Params, ",")
Else
SpStr = "Execute " & SpName & " " & Params
End If
End If
Call Rs.Open(SpStr, Conn, 1, 1, adCmdStoredProc)
Set ExecuteDataTableSp = Rs
End Function
Public Function ExecuteScalarSp(ByVal SpName, ByVal Params)
Dim iRs : Set iRs = ExecuteSp(SpName, Params)
If Not iRs.BOF Then ExecuteScalarSp = iRs(0)
End Function
Public Function ExecuteNonQuerySp(ByVal SpName, ByVal Params)
With Cmd
Set .ActiveConnection = OpenConn()
.CommandText = SpName
.CommandType = &H0004
.Prepared = True
Call .Execute(ExecuteNonQuerySp, Params)
End With
End Function
Private Sub Class_Initialize()
Set Conn = Server.CreateObject("ADODB.Connection")
Set Cmd = Server.CreateObject("ADODB.Command")
Set Param = Server.CreateObject("ADODB.Parameter")
Set Rs = Server.CreateObject("ADODB.RecordSet")
DataPath = "/data/data.mdb" ’这里写你的数据库默认路径，建议更改名称及扩展名
End Sub
Private Sub Class_Terminate()
Set Param = Nothing
Set Cmd = Nothing
CloseRs()
CloseConn()
End Sub
Private Sub CloseConn()
If Conn.State <> adStateClose Then
Conn.Close()
Set Conn = Nothing
End If
End Sub
Private Sub CloseRs()
If Rs.State <> adStateClose Then
Rs.Close()
Set Rs = Nothing
End If
End Sub
End Class
%>

我佛山人

再把其它的操作，比如Cookie，Session，Application封装
CookieState类：
<%
Class CookieState
Private CurrentKey
Public Default Property Get Contents(ByVal Value)
Contents = Values(Value)
End Property
Public Property Let Expires(ByVal Value)
Response.Cookies(CurrentKey).Expires = DateAdd("d", Value, Now)
End Property
Public Property Get Expires()
Expires = Request.Cookies(CurrentKey).Expires
End Property
Public Property Let Path(ByVal Value)
Response.Cookies(CurrentKey).Path = Value
End Property
Public Property Get Path()
Path = Request.Cookies(CurrentKey).Path
End Property
Public Property Let Domain(ByVal Value)
Response.Cookies(CurrentKey).Domain = Value
End Property
Public Property Get Domain()
Domain = Request.Cookies(CurrentKey).Domain
End Property
Public Sub Add(ByVal Key, ByVal Value, ByVal Options)
Response.Cookies(Key) = Value
CurrentKey = Key
If Not (IsNull(Options) Or IsEmpty(Options) Or Options = "") Then
If IsArray(Options) Then
Dim l : l = UBound(Options)
Expire = Options(0)
If l = 1 Then Path = Options(1)
If l = 2 Then Domain = Options(2)
Else
Expire = Options
End If
End If
End Sub
Public Sub Remove(ByVal Key)
CurrentKey = Key
Expires = -1000
End Sub
Public Sub RemoveAll()
Clear()
End Sub
Public Sub Clear()
Dim iCookie
For Each iCookie In Request.Cookies
Response.Cookies(iCookie).Expires = FormatDateTime(Now)
Next
End Sub
Public Function Values(ByVal Key)
Values = Request.Cookies(Key)
End Function

Private Sub Class_initialize()
End Sub
Private Sub Class_Terminate()
End Sub
End Class
%>

SessionState类：
<%
Class SessionState
Public Default Property Get Contents(ByVal Key)
Contents = Session(Key)
End Property
Public Property Let TimeOut(ByVal Value)
Session.TimeOut = Value
End Property
Public Property Get TimeOut()
TimeOut = Session.TimeOut
End Property
Public Sub Add(ByVal Key, ByVal Value)
Session(Key) = Value
End Sub
Public Sub Remove(ByVal Key)
Session.Contents.Remove(Key)
End Sub
Public Function Values(ByVal Key)
Values = Session(Key)
End Function
Public Sub Clear()
Session.Abandon()
End Sub
Public Sub RemoveAll()
Clear()
End Sub

Private Sub Class_initialize()
End Sub
Private Sub Class_Terminate()
End Sub
End Class
%>
Application类封装成CacheState类：
<%
Class CacheState
Private IExpires
Public Default Property Get Contents(ByVal Value)
Contents = Values(Value)
End Property
Public Property Let Expires(ByVal Value)
IExpires = DateAdd("d", Value, Now)
End Property
Public Property Get Expires()
Expires = IExpires
End Property
Public Sub Lock()
Application.Lock()
End Sub
Public Sub UnLock()
Application.UnLock()
End Sub
Public Sub Add(ByVal Key, ByVal Value, ByVal Expire)
Expires = Expire
Lock
Application(Key) = Value
Application(Key & "Expires") = Expires
UnLock
End Sub
Public Sub Remove(ByVal Key)
Lock
Application.Contents.Remove(Key)
Application.Contents.Remove(Key & "Expires")
UnLock
End Sub
Public Sub RemoveAll()
Clear()
End Sub
Public Sub Clear()
Application.Contents.RemoveAll()
End Sub
Public Function Values(ByVal Key)
Dim Expire : Expire = Application(Key & "Expires")
If IsNull(Expire) Or IsEmpty(Expire) Then
Values = ""
Else
If IsDate(Expire) And CDate(Expire) > Now Then
Values = Application(Key)
Else
Call Remove(Key)
Value = ""
End If
End If
End Function
Public Function Compare(ByVal Key1, ByVal Key2)
Dim Cache1 : Cache1 = Values(Key1)
Dim Cache2 : Cache2 = Values(Key2)
If TypeName(Cache1) <> TypeName(Cache2) Then
Compare = True
Else
If TypeName(Cache1)="Object" Then
Compare = (Cache1 Is Cache2)
Else
If TypeName(Cache1) = "Variant()" Then
Compare = (Join(Cache1, "^") = Join(Cache2, "^"))
Else
Compare = (Cache1 = Cache2)
End If
End If
End If
End Function

Private Sub Class_initialize()
End Sub
Private Sub Class_Terminate()
End Sub
End Class
%>


上面3个类，在实例化时可以用去掉State后的类名，比如
Dim Cookie : Set Cookie = New CookieState
Dim Session : Set Session = New SessionState
Dim Cache : Set Cache = New CacheState

我佛山人

其它的一些，比如分页类，异常类（用于信息提示），文件操作类（未完成），经常用到的工具类及验证输入的表单验证类（ASP版，配合前台JS版使用更佳）：
分页类Pager
<%
Class Pager
Private IUrl
Private IPage
Private IParam
Private IPageSize
Private IPageCount
Private IRecordCount
Private ICurrentPageIndex
Public Property Let Url(ByVal PUrl)
IUrl = PUrl
End Property
Public Property Get Url()
If IUrl = "" Then
If Request.QueryString <> "" Then
Dim query
For Each key In Request.QueryString
If key <> Param Then
query = query & key & "=" & Server.UrlEnCode(Request.QueryString(key)) & "&"
End If
Next
IUrl = Page & "?" & query & Param & "="
Else
IUrl = Page & "?" & Param & "="
End If
End If
Url =IUrl
End Property
Public Property Let Page(ByVal PPage)
IPage = PPage
End Property
Public Property Get Page()
Page = IPage
End Property
Public Property Let Param(ByVal PParam)
IParam = PParam
End Property
Public Property Get Param()
Param = IParam
End Property
Public Property Let PageSize(ByVal PPageSize)
IPageSize = PPageSize
End Property
Public Property Get PageSize()
PageSize = IPageSize
End Property
Public Property Get PageCount()
If (Not IPageCount > 0) Then
IPageCount = IRecordCount IPageSize
If (IRecordCount MOD IPageSize) > 0 Or IRecordCount = 0 Then
IPageCount = IPageCount + 1
End If
End If
PageCount = IPageCount
End Property
Public Property Let RecordCount(ByVal PRecordCount)
IRecordCount = PRecordCount
End Property
Public Property Get RecordCount()
RecordCount = IRecordCount
End Property
Public Property Let CurrentPageIndex(ByVal PCurrentPageIndex)
ICurrentPageIndex = PCurrentPageIndex
End Property
Public Property Get CurrentPageIndex()
If ICurrentPageIndex = "" Then
If Request.QueryString(Param) = "" Then
ICurrentPageIndex = 1
Else
If IsNumeric(Request.QueryString(Param)) Then
ICurrentPageIndex = CInt(Request.QueryString(Param))
If ICurrentPageIndex < 1 Then ICurrentPageIndex = 1
If ICurrentPageIndex > PageCount Then ICurrentPageIndex = PageCount
Else ICurrentPageIndex = 1
End If
End If
End If
CurrentPageIndex = ICurrentPageIndex
End Property
Private Sub Class_Initialize()
With Me
.Param = "page"
.PageSize = 10
End With
End Sub
Private Sub Class_Terminate()
End Sub
Private Function Navigation()
Dim Nav
If CurrentPageIndex = 1 Then
Nav = Nav & " 首页 上页 "
Else
Nav = Nav & " <a href=""" & Url & "1"">首页</a> <a href=""" & Url & (CurrentPageIndex - 1) & """>上页</a> "
End If
If CurrentPageIndex = PageCount Or PageCount = 0 Then
Nav = Nav & " 下页 尾页 "
Else
Nav = Nav & " <a href=""" & Url & (CurrentPageIndex + 1) & """>下页</a> <a href=""" & Url & PageCount & """>尾页</a> "
End If
Navigation = Nav
End Function
Private Function SelectMenu()
Dim Selector
Dim i : i = 1
While i <= PageCount
If i = ICurrentPageIndex Then
Selector = Selector & "<option value=""" & i & """ selected=""true"">" & i &"</option>" & vbCrLf
Else
Selector = Selector & "<option value=""" & i & """>" & i &"</option>" & vbCrLf
End If
i = i + 1
Wend
SelectMenu = vbCrLf & "<select style=""font:9px Tahoma"" onchange=""location=’" & Url & "’ + this.value"">" & vbCrLf & Selector & vbCrLf & "</select>" & vbCrLf
End Function
Public Sub Display()
If RecordCount > 0 Then
%>
<style>b{font:bold}</style>
<div style="text-align:right;width:100%">>>分页 <%=Navigation()%> 页次：<b><%=ICurrentPageIndex%></b>/<b><%=PageCount%></b>页 <b><%=PageSize%></b>个记录/页 转到<%=SelectMenu()%>页 共 <b><%=IRecordCount%></b>条记录</div>
<%
Else
Response.Write("<div style=""text-align:center"">暂无记录</div>")
End If
End Sub
End Class
%>
异常类Exception：
<%
Class Exception
Private IWindow
Private ITarget
Private ITimeOut
Private IMode
Private IMessage
Private IHasError
Private IRedirect
Public Property Let Window(ByVal Value)
IWindow = Value
End Property
Public Property Get Window()
Window = IWindow
End Property
Public Property Let Target(ByVal Value)
ITarget = Value
End Property
Public Property Get Target()
Target = ITarget
End Property
Public Property Let TimeOut(ByVal Value)
If IsNumeric(Value) Then
ITimeOut = CInt(Value)
Else
ITimeOut = 3000
End If
End Property
Public Property Get TimeOut()
TimeOut = ITimeOut
End Property
Public Property Let Mode(ByVal Value)
If IsNumeric(Value) Then
IMode = CInt(Mode)
Else
IMode = 1
End If
End Property
Public Property Get Mode()
Mode = IMode
End Property
Public Property Let Message(ByVal Value)
If IHasError Then
IMessage = IMessage & "<li>" & Value & "</li>" & vbCrLf
Else
IHasError = True
IMessage = "<li>" & Value & "</li>" & vbCrLf
End If
End Property
Public Property Get Message()
Message = IMessage
End Property
Public Property Let HasError(ByVal Value)
IHasError = CBool(Value)
End Property
Public Property Get HasError()
HasError = IHasError
End Property
Public Property Let Redirect(ByVal Value)
IRedirect = CBool(Value)
End Property
Public Property Get Redirect()
Redirect = IRedirect
End Property
Private Sub Class_initialize()
With Me
.Window = "self"
.Target = PrePage()
.TimeOut = 3000
IMode = 1
IMessage = "出现错误，正在返回，请稍候..."
.HasError = False
.Redirect = True
End With
End Sub

Private Sub Class_Terminate()
End Sub
Public Function PrePage()
If Request.ServerVariables("HTTP_REFERER") <> "" Then
PrePage = Request.ServerVariables("HTTP_REFERER")
Else
PrePage = "/index.asp"
End If
End Function
Public Function Alert()
Dim words : words = Me.Message
words = Replace(words, "<li>", " ")
words = Replace(words, "</li>", "")
words = Replace(words, vbCrLf, "")
words = "提示信息： " & words
%>
<script type="text/javascript">
<!--
alert("<%=words%>")
<%=Me.Window%>.location = "<%=Me.Target%>"
//-->
</script>
<%
End Function
Public Sub Throw()
If Not HasError Then Exit Sub
Response.Clear()
Select Case CInt(Me.Mode)
Case 1
%>
<link href="/css/admin.css" rel="stylesheet" type="text/css">
<TABLE class="border-all" cellSpacing="1" cellPadding="5" width="50%" align="center" border="0">
<TBODY>
<TR>
<TH height="21" align="middle" background="images/th_bg.gif" class="title">提示信息</TH>
</TR>
<TR>
<TD align="center" bgColor="#ffffff" height="40">
<TABLE cellSpacing="0" cellPadding="0" width="95%" border="0">
<TBODY>
<TR>
<TD height="5"></TD>
</TR>
<TR>
<TD><%=Me.Message%></TD>
</TR>
<TR>
<TD>&nbsp;</TD>
</TR>
<TR>
<TD align="center"><a href="javascript :history.back()">[返回]</a> <a href="/">[首页]</a> </TD>
</TR>
</TBODY>
</TABLE>
</TD>
</TR>
</TBODY>
</TABLE>
<% If Redirect Then%> <script type="text/javascript">
<!--
setTimeout("<%=Me.Window%>.location=’<%=Me.Target%>’",<%=Me.TimeOut%>)
//-->
</script><%end If%>
<%
Case 2
Call Alert()
Case Else
Response.Write Message
End Select
Response.End()
End Sub
End Class
%>
文件操作类File：
<%
Class File
Private FSO
Private IPath
Private IContent
Public Property Let Path(ByVal PPath)
IPath = PPath
End Property
Public Property Get Path()
Path = IPath
End Property
Public Property Let Content(ByVal PContent)
IContent = PContent
End Property
Public Property Get Content()
Content = IContent
End Property
Private Sub Class_Initialize()
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub Class_Terminate()
Set FSO = Nothing
End Sub
Public Sub Save()
Dim f
Set f = FSO.OpenTextFile(Server.MapPath(Path), 2, true)
f.Write Content
End Sub
End Class
%>

常用的工具类Utility：
<%
Class Utility
Private Reg
Public Function HTMLEncode(Str)
If IsNull(Str) Or IsEmpty(Str) Or Str = "" Then
HTMLEncode = ""
Else
Dim S : S = Str
S = Replace(S, "<", "&lt;")
S = Replace(S, ">", "&gt;")
S = Replace(S, " ", "&nbsp;")
S = Replace(S, vbCrLf, "<br />")
HTMLEncode = S
End If
End Function
Public Function HtmlFilter(ByVal Code)
If IsNull(Code) Or IsEmpty(Code) Then Exit Function
With Reg
.Global = True
.Pattern = "<[^>]+?>"
End With
Code = Reg.Replace(Code, "")
HtmlFilter = Code
End Function
Public Function Limit(ByVal Str, ByVal Num)
Dim StrLen : StrLen = Len(Str)
If StrLen * 2 <= Num Then
Limit = Str
Else
Dim StrRlen
Call Rlen(Str, StrRlen)
If StrRlen <= Num Then
Limit = Str
Else
Dim i
Dim reStr
If StrLen > Num * 2 Then
i = Num 2
reStr = Left(Str, i)
Call Rlen(reStr, StrRlen)
While StrRlen < Num
i = i + 1
reStr = Left(Str, i)
Call Rlen(reStr, StrRlen)
Wend
Else
i = StrLen
reStr = Str
Call Rlen(reStr, StrRlen)
While StrRlen > Num
i = i - 1
reStr = Left(Str, i)
Call Rlen(reStr, StrRlen)
Wend
End If
Call Rlen(Right(reStr, 1), StrRlen)
If StrRlen > 1 Then
Limit = Left(reStr, i-1) & "…"
Else
Limit = Left(reStr, i-2) & "…"
End If
End If
End If
End Function
Public Function Encode(ByVal Str)
Str = Replace(Str, """", "&#34;")
Str = Replace(Str, "’", "&#39;")
Encode = Str
End Function
Public Function EncodeAll(ByVal Str)
Dim M, MS
Reg.Pattern = "[x00-xFF]"
Set MS = Reg.Execute(Str)
For Each M In MS
Str = Replace(Str, M.Value, "&#" & Asc(M.Value) & ";")
Next
EncodeAll = Str
End Function

Private Sub Class_initialize()
Set Reg = New RegExp
Reg.Global = True
End Sub
Private Sub Class_Terminate()
Set Reg = Nothing
End Sub
Public Sub Rlen(ByRef Str, ByRef Rl)
With Reg
.Pattern = "[^x00-xFF]"
Rl = Len(.Replace(Str, ".."))
End With
End Sub
End Class
%>
<%
Dim Util : Set Util = New Utility
%>
输入验证类Validator：
<%@Language="VBScript" CodePage="936"%>
<%
’Option Explicit
Class Validator
’*************************************************
’ Validator for ASP beta 3 服务器端脚本
’ code by 我佛山人
’ wfsr@cunite.com
’*************************************************
Private Re
Private ICodeName
Private ICodeSessionName
Public Property Let CodeName(ByVal PCodeName)
ICodeName = PCodeName
End Property
Public Property Get CodeName()
CodeName = ICodeName
End Property
Public Property Let CodeSessionName(ByVal PCodeSessionName)
ICodeSessionName = PCodeSessionName
End Property
Public Property Get CodeSessionName()
CodeSessionName = ICodeSessionName
End Property
Private Sub Class_Initialize()
Set Re = New RegExp
Re.IgnoreCase = True
Re.Global = True
Me.CodeName = "vCode"
Me.CodeSessionName = "vCode"
End Sub
Private Sub Class_Terminate()
Set Re = Nothing
End Sub
Public Function IsEmail(ByVal Str)
IsEmail = Test("^w+([-+.]w+)*@w+([-.]w+)*.w+([-.]w+)*$", Str)
End Function
Public Function IsUrl(ByVal Str)
IsUrl = Test("^http://[A-Za-z0-9]+.[A-Za-z0-9]+[/=?%-&_~`@[]’:+!]*([^<>""])*$", Str)
End Function
Public Function IsNum(ByVal Str)
IsNum= Test("^d+$", Str)
End Function
Public Function IsQQ(ByVal Str)
IsQQ = Test("^[1-9]d{4,8}$", Str)
End Function
Public Function IsZip(ByVal Str)
IsZip = Test("^[1-9]d{5}$", Str)
End Function
Public Function IsIdCard(ByVal Str)
IsIdCard = Test("^d{15}(d{2}[A-Za-z0-9])?$", Str)
End Function
Public Function IsChinese(ByVal Str)
IsChinese = Test("^[u0391-uFFE5]+$", Str)
End Function
Public Function IsEnglish(ByVal Str)
IsEnglish = Test("^[A-Za-z]+$", Str)
End Function
Public Function IsMobile(ByVal Str)
IsMobile = Test("^(((d{3}))|(d{3}-))?13d{9}$", Str)
End Function
Public Function IsPhone(ByVal Str)
IsPhone = Test("^(((d{3}))|(d{3}-))?((0d{2,3})|0d{2,3}-)?[1-9]d{6,7}$", Str)
End Function
Public Function IsSafe(ByVal Str)
IsSafe = (Test("^(([A-Z]*|[a-z]*|d*|[-_~!@#$%^&*.()[]{}<>?/’""]*)|.{0,5})$|s", Str) = False)
End Function
Public Function IsNotEmpty(ByVal Str)
IsNotEmpty = LenB(Str) > 0
End Function
Public Function IsDateFormat(ByVal Str, ByVal Format)
IF Not IsDate(Str) Then
IsDateFormat = False
Exit Function
End IF
IF Format = "YMD" Then
IsDateFormat = Test("^((d{4})|(d{2}))([-./])(d{1,2})4(d{1,2})$", Str)
Else
IsDateFormat = Test("^(d{1,2})([-./])(d{1,2})2((d{4})|(d{2}))$", Str)
End IF
End Function
Public Function IsEqual(ByVal Src, ByVal Tar)
IsEqual = (Src = Tar)
End Function
Public Function Compare(ByVal Op1, ByVal Operator, ByVal Op2)
Compare = False
IF Dic.Exists(Operator) Then
Compare = Eval(Dic.Item(Operator))
Elseif IsNotEmpty(Op1) Then
Compare = Eval(Op1 & Operator & Op2 )
End IF
End Function
Public Function Range(ByVal Src, ByVal Min, ByVal Max)
Min = CInt(Min) : Max = CInt(Max)
Range = (Min < Src And Src < Max)
End Function
Public Function Group(ByVal Src, ByVal Min, ByVal Max)
Min = CInt(Min) : Max = CInt(Max)
Dim Num : Num = UBound(Split(Src, ",")) + 1
Group = Range(Num, Min - 1, Max + 1)
End Function
Public Function Custom(ByVal Str, ByVal Reg)
Custom = Test(Reg, Str)
End Function
Public Function Limit(ByVal Str, ByVal Min, ByVal Max)
Min = CInt(Min) : Max = CInt(Max)
Dim L : L = Len(Str)
Limit = (Min <= L And L <= Max)
End Function
Public Function LimitB(ByVal Str, ByVal Min, ByVal Max)
Min = CInt(Min) : Max = CInt(Max)
Dim L : L =bLen(Str)
LimitB = (Min <= L And L <= Max)
End Function
Private Function Test(ByVal Pattern, ByVal Str)
If IsNull(Str) Or IsEmpty(Str) Then
Test = False
Else
Re.Pattern = Pattern
Test = Re.Test(CStr(Str))
End If
End Function
Public Function bLen(ByVal Str)
bLen = Len(Replace(Str, "[^x00-xFF]", ".."))
End Function
Private Function Replace(ByVal Str, ByVal Pattern, ByVal ReStr)
Re.Pattern = Pattern
Replace = Re.Replace(Str, ReStr)
End Function
Private Function B2S(ByVal iStr)
Dim reVal : reVal= ""
Dim i, Code, nCode
For i = 1 to LenB(iStr)
Code = AscB(MidB(iStr, i, 1))
IF Code < &h80 Then
reVal = reVal & Chr(Code)
Else
nCode = AscB(MidB(iStr, i+1, 1))
reVal = reVal & Chr(CLng(Code) * &h100 + CInt(nCode))
i = i + 1
End IF
Next
B2S = reVal
End Function
Public Function SafeStr(ByVal Name)
If IsNull(Name) Or IsEmpty(Name) Then
SafeStr = False
Else
SafeStr = Replace(Trim(Name), "(s*ands*w*=w*)|[’%&<>=]", "")
End If
End Function
Public Function SafeNo(ByVal Name)
If IsNull(Name) Or IsEmpty(Name) Then
SafeNo = 0
Else
SafeNo = (Replace(Trim(Name), "^[D]*(d+)[Dd]*$", "$1"))
End If
End Function
Public Function IsValidCode()
IsValidCode = ((Request.Form(Me.CodeName) = Session(Me.CodeSessionName)) AND Session(Me.CodeSessionName) <> "")
End Function
Public Function IsValidPost()
Dim Url1 : Url1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
Dim Url2 : Url2 = Cstr(Request.ServerVariables("SERVER_NAME"))
IsValidPost = (Mid(Url1, 8, Len(Url2)) = Url2)
End Function
End Class
%>

我佛山人

还有一个读取XML的类 XmlReader：
<%
Class XmlReader
Private Xml
Public Sub Load(ByVal Path)
Xml.Load(Server.MapPath(Path))
End Sub
Public Function SelectSingleNode(ByVal XPath)
Set SelectSingleNode = Xml.SelectSingleNode(XPath)
End Function
Public Function SelectNodes(ByVal XPath)
Set SelectNodes = Xml.SelectNodes(XPath)
End Function

Private Sub Class_initialize()
Set Xml = Server.CreateObject("Microsoft.XMLDOM")
Xml.async = False
’Xml.setProperty "ServerHTTPRequest", True
End Sub
Private Sub Class_Terminate()
Set Xml = Nothing
End Sub
End Class
%>

好了，万事俱备，开始搭建基本的三层：
数据模型层：此层对应成一个类，类的类名和字段属性对应于数据库的相应表名及字段。
考虑表News，其结构如下：


[upload=gif]UploadFile/2005-6/2005621151025908.gi

则其对应的模型层如下：
<%
Class DataNews
Private IAddDate
Private IContent
Private ICount
Private INewsID
Private ITitle
Private IUserID
Private IUserName
Public Property Let AddDate(ByVal Value)
IAddDate = Value
End Property
Public Property Get AddDate()
AddDate = IAddDate
End Property
Public Property Let Content(ByVal Value)
IContent = Value
End Property
Public Property Get Content()
Content = IContent
End Property
Public Property Let Count(ByVal Value)
ICount = Value
End Property
Public Property Get Count()
Count = ICount
End Property
Public Property Let NewsID(ByVal Value)
INewsID = Value
End Property
Public Property Get NewsID()
NewsID = INewsID
End Property
Public Property Let Title(ByVal Value)
ITitle = Value
End Property
Public Property Get Title()
Title = ITitle
End Property
Public Property Let UserID(ByVal Value)
IUserID = Value
End Property
Public Property Get UserID()
UserID = IUserID
End Property
Public Property Let UserName(ByVal Value)
IUserName = Value
End Property
Public Property Get UserName()
UserName = IUserName
End Property
Private Sub Class_initialize()
End Sub
Private Sub Class_Terminate()
End Sub
End Class
%>

这里用了类名DataNews，因为VBScript不支持Namespace(-_-)，以前缀区分，而类中私有属性用I作前缀，没什么特别含义，仅仅是因为I所占宽度较小，不影响理解时的联想反应速度，如果非要拉点合理的解释的话，那么就是，Private中的I，以区分于Public，不用m_之类，是因为觉得它不够美观，影响编码心情（所以不喜欢写C），因为需要以优雅之心情，编写优雅的代码(哎呀，谁扔的鸡蛋？拜托换个新鲜点的）。

我佛山人

继续我们的数据访问层：
<!--#include virtual="/data/News.asp"-->
<%
Class DalNews
Private news
Private db
Public Property Let NewsID(ByVal Value)
news.NewsID = Value
End Property
Public Property Get NewsID()
NewsID = news.NewsID
End Property
Public Property Let UserID(ByVal Value)
news.UserID = Value
End Property
Public Property Get UserID()
UserID = news.UserID
End Property
Public Property Let Title(ByVal Value)
news.Title = Value
End Property
Public Property Get Title()
Title = news.Title
End Property
Public Property Let Content(ByVal Value)
news.Content = Value
End Property
Public Property Get Content()
Content = news.Content
End Property
Public Property Let Count(ByVal Value)
news.Count = Value
End Property
Public Property Get Count()
Count = news.Count
End Property
Public Property Let AddDate(ByVal Value)
news.AddDate = Value
End Property
Public Property Get AddDate()
AddDate = news.AddDate
End Property
Public Property Let UserName(ByVal Value)
news.UserName = Value
End Property
Public Property Get UserName()
UserName = news.UserName
End Property
Public Function SelectOne()
Dim rs : Set rs = db.ExecuteSp("News_SelectOne", Me.NewsID)
If Not (rs.BOF OR rs.EOF) Then
With Me
.NewsID = rs(0)
.UserID = rs(1)
.Title = rs(2)
Dim tmpContent : tmpContent = rs(3)
.Content = tmpContent
.Count = rs(4)
.AddDate = rs(5)
.UserName = rs(6)
End With
SelectOne = True
Else
SelectOne = False
End If
End Function
Public Function SelectTop()
Dim rs : Set rs = db.ExecuteSp("News_SelectTop", Null)
If Not (rs.BOF OR rs.EOF) Then
With Me
.NewsID = rs(0)
.UserID = rs(1)
.Title = rs(2)
Dim tmpContent : tmpContent = rs(3)
.Content = tmpContent
.Count = rs(4)
.AddDate = rs(5)
.UserName = rs(6)
End With
End If
Set SelectTop = rs
End Function
Public Function SelectAll()
Set SelectAll = db.ExecuteDataTableSp("News_SelectAll", Null)
End Function
Public Function Insert()
Me.NewsID = db.InsertSp("News_Insert", Array(Me.UserID, Me.Title, Me.Content, Me.Count))
Insert = Me.NewsID
End Function
Public Function Update()
Update = db.ExecuteNonQuerySp("News_Update", Array(Me.Title, Me.Content, Me.Count, Me.NewsID)) > 0
End Function
Public Function UpdateCount()
UpdateCount = db.ExecuteNonQuerySp("News_UpdateCount", Me.NewsID) > 0
End Function
Public Function Delete()
Delete = db.ExecuteNonQuerySp("News_Delete", Me.NewsID) > 0
End Function
Public Function BatchDelete(ByVal NewsIDs)
BatchDelete = db.ExecuteNonQuery("DELETE * FROM News WHERE NewsID IN (" & NewsIDs & ")")
End Function
Private Sub Class_initialize()
Set news = New DataNews
Set db = New Oledb
End Sub
Private Sub Class_Terminate()
Set news = Nothing
Set db = Nothing
End Sub
End Class
%>

第一行是导入之前的模型层，可以看到虽然模型层类名为DataNews，但文件名为News.asp，我们把所有类名都是表名相关，文件名与表名一样，分别存于不同文件夹。这个数据访问层的类名为DalNews，类里实例化刚才的模型层，实例名是表名的小写。
这一层里我们还实例化了Oledb，类名就用db，可以看到，类里只看到一句批量删除时的SQL语句(因为ACCESS查询不支持，也有可能是我测试不成功，方法不对)，其它的只是一个名称，有点象MSSQL里的存储过程，其实这是ACCESS里的查询，轻量级的存储过程，仅仅支持简单的SQL语句，参数以中括号及书写顺序标识。

[upload=gif]UploadFile/2005-6/2005621153140958.gi
附上News_Update查询的截图：
SQL视图：
[upload=gif]UploadFile/2005-6/2005621153328656.gi

设计视图：
[upload=gif]UploadFile/2005-6/2005621153524129.gi

我佛山人

下来是逻辑层，这个层比较重要，因为主要判断都在这里，把数据访问层包含进来，类名为BllNews.asp，放于/Bll/文件夹下，刚才的数据访问层放于/Dal/文件夹下，数据模型层放于/Data/文件夹下，所有文件名都是News.asp。商业逻辑层的类需要实例化Validator和Exception，实例化的Cookie类主要用于限制点击数的增加。可以根据需要去留。这里还对每个属性接受的数据进行判断，判断依据主要是根据数据库的字段属性限制，比如字段类型，字段长度等，对于数字的验证，用Validator中的SafeNo，使本应用可以免受SQL Injection之扰。

<!--#include virtual="/dal/News.asp"-->
<%
Class BllNews
Private v
Private e
Private news
Private Cookie
Public Property Let NewsID(ByVal Value)
If Not IsEmpty(Value) And v.IsNum(v.SafeNo(Value)) Then
news.NewsID = CInt(v.SafeNo(Value))
Else
news.NewsID = 0
e.Message = "NewsID参数错误"
End If
End Property
Public Property Get NewsID()
NewsID = news.NewsID
End Property
Public Property Let UserID(ByVal Value)
If Not IsEmpty(Value) And v.IsNum(v.SafeNo(Value)) Then
news.UserID = CInt(v.SafeNo(Value))
Else
news.UserID = 0
e.Message = "UserID参数错误"
End If
End Property
Public Property Get UserID()
UserID = news.UserID
End Property
Public Property Let Title(ByVal Value)
If v.Limit(Value, 1, 100) Then
news.Title = Value
Else
If IsNull(Value) or IsEmpty(Value) Or Value = "" Then
news.Title = ""
e.Message = "新闻标题不允许为空"
Else
news.Title = Left(Value, 100)
e.Message = "新闻标题字符长度超过100"
End If
End If
End Property
Public Property Get Title()
Title = news.Title
End Property
Public Property Let Content(ByVal Value)
If IsNull(Value) or IsEmpty(Value) Or Value = "" Then
news.Content = ""
e.Message = "新闻内容不允许为空"
Else
news.Content = Value
End If
End Property
Public Property Get Content()
Content = news.Content
End Property
Public Property Let Count(ByVal Value)
If Not IsEmpty(Value) And v.IsNum(v.SafeNo(Value)) Then
news.Count = CInt(v.SafeNo(Value))
Else
news.Count = 0
e.Message = "新闻点击数设置错误"
End If
End Property
Public Property Get Count()
Count = news.Count
End Property
Public Property Let AddDate(ByVal Value)
news.AddDate = Value
End Property
Public Property Get AddDate()
AddDate = FormatDateTime(CDate(news.AddDate), 1)
End Property
Public Property Let UserName(ByVal Value)
news.UserName = Value
End Property
Public Property Get UserName()
UserName = news.UserName
End Property
Public Sub Throw()
e.Throw()
End Sub
Public Function SelectOne()
NewsID = NewsID
If Not IsEmpty(NewsID) Then
SelectOne = news.SelectOne()
If SelectOne = False Then
e.Message = "参数错误，该新闻不存在或已被删除"
End If
End If
e.Throw()
End Function
Public Function SelectTop()
Set SelectTop = news.SelectTop()
End Function
Public Function SelectAll()
Set SelectAll = news.SelectAll()
End Function
Public Sub Insert()
UserID = UserID
Title = Title
Content = Content
Count = Count
e.Target = "/admin/News.asp"
e.Throw()
news.Insert()
If Me.NewsID > 0 Then
e.Message = "新闻添加成功，正在转到列表"
e.Target = "/admin/NewsList.asp"
Else
e.Message = "新闻添加失败，请检查输入"
End If
e.Throw()
End Sub
Public Sub Update()
e.Target = "/admin/NewsList.asp"
If news.Update() Then
e.Message = "新闻更新成功,正在返回..."
Else
e.Message = "新闻更新失败，请确认参数是否正确或新闻是否存在"
End If
e.Throw()
End Sub
Public Sub UpdateCount()
If Cookie("News" & Me.NewsID) = "" Then
news.UpdateCount()
Call Cookie.Add("News" & Me.NewsID, 1, 1)
End If
End Sub
Public Sub Delete()
e.Target = "/admin/NewsList.asp"
If news.Delete() Then
e.Message = "新闻删除成功,正在返回..."
Else
e.Message = "新闻删除失败，请确认参数是否正确或新闻是否存在"
End If
e.Throw()
End Sub
Public Sub BatchDelete(ByVal NewsIDs)
e.Target = "/admin/NewsList.asp"
Dim Rows : Rows = news.BatchDelete(NewsIDs)
If Rows > 0 Then
e.Message = "成功删除新闻<font color=’red’> " & Rows & " </font>条,正在返回..."
Else
e.Message = "新闻删除失败，请确认参数是否正确或新闻是否存在" & NewsIDs
End If
e.Throw()
End Sub
Private Sub Class_initialize()
Set v = New Validator
Set e = New Exception
Set news = New DalNews
Set Cookie = New CookieState
End Sub
Private Sub Class_Terminate()
Set v = Nothing
Set e = Nothing
Set news = Nothing
Set Cookie = Nothing
End Sub
End Class
%>

我佛山人

最终的表现层：
<!--#include virtual="/Inc/Package.asp"-->
<!--#include virtual="/Bll/News.asp"-->
<%
Dim news : Set news = New BllNews
Dim navString : navString = " &raquo; <a href=""/news.asp"">XX动态</a>"
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>XX有限公司</title>
<link href="css/news.css" rel="stylesheet" type="text/css">
</head>
<body>
<!--#include file="inc/top.asp"-->
<table width="760" border="0" align="center" cellpadding="0" cellspacing="0" bgcolor="#FFFFFF">
<tr>
<td width="220" align="center" valign="top">
<!--#include virtual="/inc/Left.asp"-->
</td>
<td width="540" align="center" valign="top" class="border"><table width="540" border="0" cellspacing="0" cellpadding="0">
<tr>
<td height="28" background="images/bar_mid_3.jpg" class="right_title">旅游新闻</td>
</tr>
<tr>
<td><table width=96% border=0 align=center cellpadding=2 cellspacing=0>
<tr>
<td height="5"> </td>
</tr>
<%
Dim rs : Set rs = news.SelectAll()
Dim p : Set p = New Pager
p.PageSize = 20
p.RecordCount = rs.RecordCount
Dim iIndex : iIndex = 0

If Not (rs.BOF or rs.EOF) Then
rs.Move((p.CurrentPageIndex - 1) * p.PageSize)
While Not rs.EOF And iIndex < p.PageSize
%>
<tr>
<td width=12><img src="images/dot_01.gif" width="12" height="9"></td>
<td><a href="NewsDetail.asp?ID=<%=rs("NewsID")%>" target="_blank" title="<%=Util.Encode(rs("Title"))%>"><%=Util.Limit(rs("Title"), 80)%>&nbsp;&nbsp;[<%=rs("AddDate")%>]</a></td>
</tr>
<tr>
<td height=1 colspan=2 background="images/line_03.gif"></td>
</tr>
<%
iIndex = iIndex + 1
rs.MoveNext()
Wend
End If
Set rs = Nothing
%>
</table>
<table width="540" border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="40%" height="30" align="center"><%=p.Display()%></td>
</tr>
</table></td>
</tr>
</table>
</td>
</tr>
<tr>
<td colspan="2" align="center">&nbsp;</td>
</tr>
</table>
<!--#include file="inc/footer.asp"-->
</body>
</html>
<%
Set news = Nothing
%>

第一行导入的Package.asp，是把需要导入的文件单独写到一个文件里，它的代码如下：
<!--#include virtual="/inc/validator.asp"-->
<!--#include virtual="/Inc/Exception.asp"-->
<!--#include virtual="/inc/Cache.asp"-->
<!--#include virtual="/inc/Session.asp"-->
<!--#include virtual="/inc/Cookie.asp"-->
<!--#include virtual="/Inc/Pager.asp"-->
<!--#include virtual="/Inc/Utility.asp"-->
<!--#include virtual="/Inc/Oledb.asp"-->
第二行导入的就是最后的商业逻辑层类。分页用了之前给的分页类Pager，可以看到，这里少了很多平时分页用到的if else等等的判断处理，这些都交由Pager类，而参数合法性则由逻辑层处理，表现层只负责数据的显示表现。

我佛山人

可以看到，这三层的代码编写，跟数据库的设计有很大关系，而且有规律，所以我尝试写了一个代码生成器。
1.第一次编写，只能生成模型类
<style>
* {font:12px Tahoma}
table{width:760px}
</style>
<%
Class Generator
Private IDataPath
Private IConnectionString
Private IDataDir
Private FSO
Private File
Private Conn
Private Rs
Public Property Let DataPath(ByVal Value)
IDataPath = Value
IConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(IDataPath)
End Property
Public Property Get DataPath()
DataPath = IDataPath
End Property
Public Property Let ConnectionString(ByVal Value)
IConnectionString = Value
End Property
Public Property Get ConnectionString()
ConnectionString = IConnectionString
End Property
Public Property Let DataDir(ByVal Value)
IDataDir = Value
End Property
Public Property Get DataDir()
DataDir = IDataDir
End Property
Public Sub Generate()
Dim Tables, i, L
Tables = ReadTable()
L = UBound(Tables)
For i=0 To L
Call Process(Tables(i), ReadColumn(Tables(i)))
Next
End Sub
Public Sub GenerateByTable(ByVal Table)
Call Process(Table, ReadColumn(Table))
End Sub
Private Sub Class_initialize()
Set Conn = Server.CreateObject("ADODB.Connection")
Set Rs = Server.CreateObject("ADODB.RecordSet")
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
DataDir = "Data/"
End Sub
Private Sub Class_Terminate()
CloseConn()
CloseRs()
Set FSO = Nothing
Set File = Nothing
End Sub
Private Sub Process(ByVal Table, ByVal Columns)
Dim i
Dim L : L = UBound(Columns)
Dim TmpString : TmpString = "<%" & vbCrLf & "Class Data" & Table & vbCrLf & vbCrLf
Dim Def, Pro
For i=0 To L
Def = Def & vbTab & "Private I" & Columns(i) & vbCrLf
Pro = Pro&vbCrLf&vbTab & "Public Property Let " & Columns(i) & "(ByVal Value)" & vbCrLf & vbTab &_
vbTab & "I" & Columns(i) & " = Value" &_
vbCrlf & vbTab & "End Property" &_
vbCrlf & vbTab & "Public Property Get " & Columns(i) & "()" &_
vbCrLf & vbTab & vbTab & Columns(i) & " = I" & Columns(i) &_
vbCrlf & vbTab & "End Property" & vbCrlf
Next
TmpString = TmpString & Def & Pro &_
vbCrlf & vbTab & "Private Sub Class_initialize()" &_
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbTab & "Private Sub Class_Terminate()" &_
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbCrLf& "End Class" & vbCrLf & "%" & Chr(62)
Call Save(Table, TmpString)
End Sub
Private Sub Save(ByVal Table, ByRef Content)
DetectDir(DataDir)
Dim Path : Path = Server.MapPath(DataDir & Table & ".asp")
Set File = FSO.OpenTextFile(Path, 2, true)
File.Write Content
Response.Write("<li>" & Path & "</li>")
End Sub
Private Sub DetectDir(DirName)
Dim Path : Path = Server.MapPath(DirName)
If Not FSO.FolderExists(Path) Then
FSO.CreateFolder(Path)
End If
End Sub
Private Sub OpenConn()
If Conn.State = adStateClosed Then
Conn.Open ConnectionString
End If
End Sub
Private Sub CloseConn()
If Conn.State = adStateOpen Then
Conn.Close()
Set Conn = Nothing
End If
End Sub
Private Sub CloseRs()
If Rs.State = adStateOpen Then
Rs.Close()
Set Rs = Nothing
End If
End Sub
Private Function ReadTable()
Dim TmpTable
OpenConn()
Set Rs = Conn.openSchema(20, Array(Empty, Empty, Empty,"TABLE"))
Rs.MoveFirst()
Do While Not Rs.EOF
TmpTable = TmpTable & "," & Rs("TABLE_NAME")
Rs.MoveNext()
Loop
ReadTable = Split(Mid(TmpTable, 2), ",")
End Function
Private Function ReadColumn(ByVal TableName)
Dim TmpColumn
OpenConn()
Set Rs = Conn.openSchema(4, Array(Empty, Empty, TableName, Empty))
Rs.MoveFirst()
Do While Not Rs.EOF
TmpColumn = TmpColumn & "," & Rs("COLUMN_NAME")
Rs.MoveNext()
Loop
ReadColumn = Split(Mid(TmpColumn, 2), ",")
End Function
End Class
Dim g : Set g = New Generator
g.DataPath = "/data/data.mdb"
g.Generate()
Set g = Nothing
%>

我佛山人

第二次编写，可以生成模型类和数据访问类，在数据访问类上的备注字段和主键的判断还需要推敲确定，现在是我根据Connection.openSchema方法遍历出的字段属性比较判断出来的。如果时间和技术允许，我希望能把另外的事件处理类，前台表现类（包括表单生成，数据列表页，详细显示页）一并生成，这将大大减轻程序员的编码时间和难度，前提是这个框架设计是健壮，安全且合理的，这就需要大家来一起测试改进。目前用VC做个界面的计划也在进行中
<style>
* {font:12px Tahoma}
table{width:760px}
</style>
<%
’On Error Resume Next
Class Generator
Private IDataPath
Private IConnectionString
Private IDataDir
Private IDalDir
Private IBllDir
Private IEventDir
Private FSO
Private File
Private Conn
Private cmd
Private Rs
Private Cat
Public Property Let DataPath(ByVal Value)
IDataPath = Value
IConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(IDataPath)
End Property
Public Property Get DataPath()
DataPath = IDataPath
End Property
Public Property Let ConnectionString(ByVal Value)
IConnectionString = Value
End Property
Public Property Get ConnectionString()
ConnectionString = IConnectionString
End Property
Public Property Let DataDir(ByVal Value)
DetectDir(Value)
IDataDir = Value
End Property
Public Property Get DataDir()
DataDir = IDataDir
End Property
Public Property Let DalDir(ByVal Value)
DetectDir(Value)
IDalDir = Value
End Property
Public Property Get DalDir()
DalDir = IDalDir
End Property
Public Property Let BllDir(ByVal Value)
DetectDir(Value)
IBllDir = Value
End Property
Public Property Get BllDir()
BllDir = IBllDir
End Property
Public Property Let EventDir(ByVal Value)
DetectDir(Value)
IEventDir = Value
End Property
Public Property Get EventDir()
EventDir = IEventDir
End Property
Public Sub Generate()
Dim Tables, i, L
Tables = ReadTable()
L = UBound(Tables)
For i=0 To L
Call Process(Tables(i))
Next
End Sub
Public Sub GenerateByTable(ByVal Table)
Call Process(Table)
End Sub
Private Sub Class_Initialize()
Set Conn = Server.CreateObject("ADODB.Connection")
Set Rs = Server.CreateObject("ADODB.RecordSet")
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Set Cat = Server.CreateObject("ADOX.Catalog")
Set Cmd = Server.CreateObject("ADODB.Command")
DataDir = "DataClass/"
DalDir = "DalClass/"
BllDir = "BllClass/"
EventDir = "Action/"
End Sub
Private Sub Class_Terminate()
CloseConn()
CloseRs()
Set Cat = Nothing
Set Cmd = Nothing
Set FSO = Nothing
Set File = Nothing
End Sub
Private Sub Process(ByVal Table)
Set Rs = ReadColumn(Table)
’Call ProcessData(Rs)
’Call ProcessDal(Rs)
Call ProcessBll(Rs)
’Call ProcessEvent(Rs)
End Sub
Private Sub ProcessData(ByRef Rs)
Rs.Filter = "ORDINAL_POSITION=1"
If Rs.EOF Then Exit Sub
Dim n : n = 0
Dim Table : Table = Rs("TABLE_NAME")
Dim TmpString : TmpString = "<%" & vbCrLf & "Class Data" & Table & vbCrLf & vbCrLf
Dim Def, Pro
Do
n = n + 1
Rs.Filter = "ORDINAL_POSITION=" & n
If Rs.EOF Then Exit Do
Def = Def & vbTab & "Private I" & Rs("COLUMN_NAME") & vbCrLf
Pro = Pro & vbCrLf & vbTab & "’" & Rs("COLUMN_NAME") & vbCrLf &_
vbTab & "Public Property Let " & Rs("COLUMN_NAME") & "(ByVal Value)" & vbCrLf & vbTab &_
vbTab & "I" & Rs("COLUMN_NAME") & " = Value" &_
vbCrlf & vbTab & "End Property" &_
vbCrlf & vbTab & "Public Property Get " & Rs("COLUMN_NAME") & "()" &_
vbCrLf & vbTab & vbTab & Rs("COLUMN_NAME") & " = I" & Rs("COLUMN_NAME") &_
vbCrlf & vbTab & "End Property" & vbCrlf
Loop
TmpString = TmpString & Def & Pro &_
vbCrlf & vbTab & "Private Sub Class_Initialize()" &_
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbTab & "Private Sub Class_Terminate()" &_
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbCrLf& "End Class" & vbCrLf & "%" & Chr(62)
Call SaveDataClass(Table, TmpString)
End Sub
Private Sub ProcessDal(ByRef Rs)
Rs.Filter = "ORDINAL_POSITION=1"
If Rs.EOF Then Exit Sub
Dim n : n = 0
Dim Table : Table = Rs("TABLE_NAME")
Dim LTable : LTable = LCase(Table)
Dim TmpString : TmpString = "<!--#include virtual=""/" & DataDir & Table & ".asp""-->" & vbCrLf & "<%" & vbCrLf & "Class Dal" & Table & vbCrLf & vbCrLf & vbTab & "Private db" & vbCrLf & vbTab & "Private " & LTable & vbCrLf
Dim Def, Pro
Dim PK, Columns, ColumnName, LongTextField, soSql
Do
n = n + 1
Rs.Filter = "ORDINAL_POSITION=" & n
If Rs.EOF Then Exit Do
ColumnName = Rs("COLUMN_NAME")
If CInt(Rs("COLUMN_FLAGS")) = 90 AND CInt(Rs("DATA_TYPE")) = 3 Then PK = ColumnName
If CInt(Rs("COLUMN_FLAGS")) = 234 AND CInt(Rs("DATA_TYPE")) = 130 AND Rs("CHARACTER_OCTET_LENGTH") = "0" Then LongTextField = LongTextField & "," & ColumnName
Columns = Columns & "," & ColumnName
If n = 1 Then
soSql = vbTab & vbTab & " ." & ColumnName & " = rs(""" & ColumnName & """)" & vbCrLf
Else
soSql = soSql & vbTab & vbTab & " ." & ColumnName & " = rs(""" & ColumnName & """)" & vbCrLf
End If
Pro = Pro & vbCrLf & vbTab & "’" & ColumnName & vbCrLf &_
vbTab & "Public Property Let " & ColumnName & "(ByVal Value)" & vbCrLf & vbTab &_
vbTab & LTable & "." & ColumnName & " = Value" &_
vbCrlf & vbTab & "End Property" &_
vbCrlf & vbTab & "Public Property Get " & ColumnName & "()" &_
vbCrLf & vbTab & vbTab & ColumnName & " = " & LTable & "." & ColumnName &_
vbCrlf & vbTab & "End Property" & vbCrlf
Loop
Columns = Replace(Columns, "," & PK & ",", "")
If LongTextField <> "" Then
LongTextField = Mid(LongTextField, 2)
Dim arr : arr = Split(LongTextField, ",")
Dim arrLen : arrLen = UBound(arr)
Dim arrI
For arrI=0 To arrLen
soSql = Replace(soSql, "." & arr(arrLen) & " = rs(""" & arr(arrLen) & """)", "Dim tmp" & arr(arrLen) & " : tmp" & arr(arrLen) & " = rs(""" & arr(arrLen) & """)" & vbCrLf & " ." & arr(arrLen) & " = tmp" & arr(arrLen))
Next
End If
Dim SelectOneSp, SelectTopSp, SelectAllSp, InsertSp, UpdateSp, DeleteSp, BatchDeleteSp
SelectOneSp = vbTab &"Public Function SelectOne()" & vbCrLf &_
vbTab & vbTab & "Dim rs : Set rs = db.ExecuteSp(""" & Table & "_SelectOne"", " & PK & ")" & vbCrLf &_
vbTab & vbTab & "If Not (rs.BOF OR rs.EOF) Then" & vbCrLf &_
vbTab & vbTab & " With Me" & vbCrLf &_
soSql & _
vbTab & vbTab & " End With" & vbCrLf &_
vbTab & vbTab & " SelectOne = True" & vbCrLf &_
vbTab & vbTab & "Else" & vbCrLf &_
vbTab & vbTab & " SelectOne = False" & vbCrLf &_
vbTab & vbTab & "End If" & vbCrLf &_
vbTab &"End Function"
SelectTopSp = vbTab &"Public Function SelectTop()" & vbCrLf &_
vbTab & vbTab & "Set SelectTop = db.ExecuteDataTableSp(""" & Table & "_SelectTop"", Null)" & vbCrLf &_
vbTab &"End Function"
SelectAllSp = vbTab &"Public Function SelectAll()" & vbCrLf &_
vbTab & vbTab & "Set SelectAll = db.ExecuteDataTableSp(""" & Table & "_SelectAll"", Null)" & vbCrLf &_
vbTab & "End Function"
InsertSp = vbTab &"Public Function Insert()" & vbCrLf &_
vbTab & vbTab & PK & " = db.InsertSp(""" & Table & "_Insert"", Array(" & Join(Split(Columns, ","), ", ") & "))" & vbCrLf &_
vbTab & vbTab &"Insert = " & PK & vbCrLf &_
vbTab &"End Function"
UpdateSp = vbTab &"Public Function Update()" & vbCrLf &_
vbTab & vbTab & "Update = db.ExecuteNonQuerySp(""" & Table & "_Update"", Array(" & Join(Split(Columns, ","), ", ") & ", " & PK & ")) > 0" & vbCrLf &_
vbTab &"End Function"
DeleteSp = vbTab &"Public Function Delete()" & vbCrLf &_
vbTab & vbTab & "Delete = db.ExecuteNonQuerySp(""" & Table & "_Delete"", " & PK & ") > 0" & vbCrLf &_
vbTab &"End Function"
BatchDeleteSp = vbTab &"Public Function BatchDelete(ByVal " & PK & "s)" & vbCrLf &_
vbTab & vbTab & "BatchDelete = db.ExecuteNonQuery(""DELETE * FROM [" & Table & "] WHERE " & PK & " IN ("" & " & PK & "s & "")"")" & vbCrLf &_
vbTab &"End Function"
TmpString = TmpString & Pro &_
vbCrlf & SelectOneSp & vbCrLf &_
vbCrlf & SelectTopSp & vbCrLf &_
vbCrlf & SelectAllSp & vbCrLf &_
vbCrlf & InsertSp & vbCrLf &_
vbCrlf & UpdateSp & vbCrLf &_
vbCrlf & DeleteSp & vbCrLf &_
vbCrlf & BatchDeleteSp & vbCrLf &_
vbCrlf & vbTab & "Private Sub Class_Initialize()" &_
vbCrlf & vbTab & vbTab & "Set db = New Oledb" & _
vbCrlf & vbTab & vbTab & "Set " & LTable & " = New Data" & Table & _
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbTab & "Private Sub Class_Terminate()" &_
vbCrlf & vbTab & vbTab & "Set db = Nothing" & _
vbCrlf & vbTab & vbTab & "Set " & LTable & " = Nothing" & _
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbCrLf& "End Class" & vbCrLf & "%" & Chr(62)
Call SaveDalClass(Table, TmpString)
Call CreateSp(Table, PK, Columns)
’Response.Write "<div>" & PK & ":" & Columns & ":" & LongTextField & "</div>"
End Sub
Private Sub ProcessBll(ByRef Rs)
Rs.Filter = "ORDINAL_POSITION=1"
If Rs.EOF Then Exit Sub
Dim n : n = 0
Dim Table : Table = Rs("TABLE_NAME")
Dim LTable : LTable = LCase(Table)
Dim TmpString : TmpString = "<!--#include virtual=""/" & DalDir & Table & ".asp""-->" & vbCrLf & "<%" & vbCrLf & "Class Bll" & Table & vbCrLf & vbCrLf & vbTab & "Private v" & vbCrLf & vbTab & "Private e" & vbCrLf & vbTab & "Private " & LTable & vbCrLf
Dim Def, Pro
Dim PK
Do
n = n + 1
Rs.Filter = "ORDINAL_POSITION=" & n
If Rs.EOF Then Exit Do
If CInt(Rs("COLUMN_FLAGS")) = 90 Then PK = Rs("COLUMN_NAME")
Pro = Pro & vbCrLf & vbTab & "’" & Rs("COLUMN_NAME") & vbCrLf &_
vbTab & "Public Property Let " & Rs("COLUMN_NAME") & "(ByVal Value)" & vbCrLf & vbTab &_
vbTab & LTable & "." & Rs("COLUMN_NAME") & " = Value" &_
vbCrlf & vbTab & "End Property" &_
vbCrlf & vbTab & "Public Property Get " & Rs("COLUMN_NAME") & "()" &_
vbCrLf & vbTab & vbTab & Rs("COLUMN_NAME") & " = " & LTable & "." & Rs("COLUMN_NAME") &_
vbCrlf & vbTab & "End Property" & vbCrlf
Loop
TmpString = TmpString & Pro &_
vbCrlf & vbTab & "Public Sub Throw()" &_
vbCrlf & vbTab & " e.Throw()" &_
vbCrlf & vbTab & "End Sub" & vbCrlf &_
vbCrlf & vbTab & "Private Sub Class_Initialize()" &_
vbCrlf & vbTab & vbTab & "Set v = New Validator" & _
vbCrlf & vbTab & vbTab & "Set e = New Exception" & _
vbCrlf & vbTab & vbTab & "Set " & LTable & " = New Data" & Table & _
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbTab & "Private Sub Class_Terminate()" &_
vbCrlf & vbTab & vbTab & "Set v = Nothing" & _
vbCrlf & vbTab & vbTab & "Set e = Nothing" & _
vbCrlf & vbTab & vbTab & "Set " & LTable & " = Nothing" & _
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbCrLf& "End Class" & vbCrLf & "%" & Chr(62)
Call SaveBllClass(Table, TmpString)
End Sub
Private Sub ProcessEvent(ByRef Rs)
Rs.Filter = "ORDINAL_POSITION=1"
If Rs.EOF Then Exit Sub
Dim n : n = 0
Dim Table : Table = Rs("TABLE_NAME")
Dim LTable : LTable = LCase(Table)
Dim TmpString : TmpString = "<!--#include virtual=""/Inc/Package.asp""-->" & vbCrLf & "<!--#include virtual=""/" & BllDir & Table & ".asp""-->" & vbCrLf & "<%" & vbCrLf & "Class Data" & Table & vbCrLf & vbCrLf & vbTab & "Private db" & vbCrLf & vbTab & "Private " & LTable & vbCrLf
Dim Def, Pro
Dim PK
Do
n = n + 1
Rs.Filter = "ORDINAL_POSITION=" & n
If Rs.EOF Then Exit Do
If CInt(Rs("COLUMN_FLAGS")) = 90 Then PK = Rs("COLUMN_NAME")
Pro = Pro & vbCrLf & vbTab & "’" & Rs("COLUMN_NAME") & vbCrLf &_
vbTab & "Public Property Let " & Rs("COLUMN_NAME") & "(ByVal Value)" & vbCrLf & vbTab &_
vbTab & LTable & "." & Rs("COLUMN_NAME") & " = Value" &_
vbCrlf & vbTab & "End Property" &_
vbCrlf & vbTab & "Public Property Get " & Rs("COLUMN_NAME") & "()" &_
vbCrLf & vbTab & vbTab & Rs("COLUMN_NAME") & " = " & LTable & "." & Rs("COLUMN_NAME") &_
vbCrlf & vbTab & "End Property" & vbCrlf
Loop
TmpString = TmpString & Pro &_
vbCrlf & vbTab & "Private Sub Class_Initialize()" &_
vbCrlf & vbTab & vbTab & "Set db = New Oledb" & _
vbCrlf & vbTab & vbTab & "Set " & LTable & " = New Data" & Table & _
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbTab & "Private Sub Class_Terminate()" &_
vbCrlf & vbTab & vbTab & "Set db = Nothing" & _
vbCrlf & vbTab & vbTab & "Set " & LTable & " = Nothing" & _
vbCrlf & vbTab & "End Sub" &_
vbCrlf & vbCrLf& "End Class" & vbCrLf & "%" & Chr(62)
Call SaveEventClass(Table, TmpString)
End Sub
Private Sub SaveDataClass(ByVal Table, ByRef Content)
Call Save(DataDir, Table, Content)
End Sub
Private Sub SaveDalClass(ByVal Table, ByRef Content)
Call Save(DalDir, Table, Content)
End Sub
Private Sub SaveBllClass(ByVal Table, ByRef Content)
Call Save(BllDir, Table, Content)
End Sub
Private Sub SaveEventClass(byVal Table, ByRef Content)
Call Save(EventDir, Table, Content)
End Sub
Private Sub Save(ByVal Dir, ByVal FileName, ByRef Content)
Dim Path : Path = Server.MapPath(Dir & FileName & ".asp")
Set File = FSO.OpenTextFile(Path, 2, true)
File.Write Content
Response.Write("<li>" & Path & "</li>")
End Sub
Private Sub DetectDir(DirName)
Dim Path : Path = Server.MapPath(DirName)
If Not FSO.FolderExists(Path) Then
FSO.CreateFolder(Path)
End If
End Sub
Private Sub OpenConn()
If Conn.State = adStateClosed Then
Conn.Open ConnectionString
End If
End Sub
Private Sub CloseConn()
If Conn.State <> adStateClose Then
Conn.Close()
Set Conn = Nothing
End If
End Sub
Private Sub CloseRs()
If Rs.State <> adStateClose Then
Rs.Close()
Set Rs = Nothing
End If
End Sub
Private Sub CreateSp(ByVal Table, ByVal Key, ByVal Columns)
Call CreateSelectOneSp(Table, Key, Columns)
Call CreateSelectTopSp(Table, Key, Columns)
Call CreateSelectAllSp(Table, Key, Columns)
Call CreateInsertSp(Table, Key, Columns)
Call CreateUpdateSp(Table, Key, Columns)
Call CreateDeleteSp(Table, Key, Columns)
End Sub
Private Sub CreateSelectOneSp(ByVal Table, ByVal Key, ByVal Columns)
Call CreateProcedure(Table & "_SelectOne", "SELECT " & Key & "," & Columns & " FROM [" & Table & "] WHERE " & Key & " = [@" & Key & "]")
End Sub
Private Sub CreateSelectTopSp(ByVal Table, ByVal Key, ByVal Columns)
Call CreateProcedure(Table & "_SelectTop", "SELECT TOP 10 " & Key & "," & Columns & " FROM [" & Table & "]")
End Sub
Private Sub CreateSelectAllSp(ByVal Table, ByVal Key, ByVal Columns)
Call CreateProcedure(Table & "_SelectAll", "SELECT " & Key & "," & Columns & " FROM [" & Table & "]")
End Sub
Private Sub CreateInsertSp(ByVal Table, ByVal Key, ByVal Columns)
Call CreateProcedure(Table & "_Insert", "SELECT " & Key & "," & Columns & " FROM [" & Table & "]")
End Sub
Private Sub CreateUpdateSp(ByVal Table, ByVal Key, ByVal Columns)
Dim ar : ar = Split(Columns, ",")
Dim sql : sql = "UPDATE [" & Table & "] SET "
Dim i, l : l = UBound(ar)
For i = 0 To l
If i = l Then
sql = sql & Table & "." & ar(i) & " = [@" & ar(i) & "] "
Else
sql = sql & Table & "." & ar(i) & " = [@" & ar(i) & "], "
End If
Next
sql = sql & "WHERE " & Table & "." & Key & " = [@" & Key & "]"
Call CreateProcedure(Table & "_Update", sql)
End Sub
Private Sub CreateDeleteSp(ByVal Table, ByVal Key, ByVal Columns)
Call CreateProcedure(Table & "_Delete", "DELETE * FROM [" & Table & "] WHERE " & Key & " = [@" & Key & "]")
End Sub
Private Function ReadTable()
Dim TmpTable
OpenConn()
Set Rs = Conn.openSchema(20, Array(Empty, Empty, Empty,"TABLE"))
Rs.MoveFirst()
Do While Not Rs.EOF
TmpTable = TmpTable & "," & Rs("TABLE_NAME")
Rs.MoveNext()
Loop
ReadTable = Split(Mid(TmpTable, 2), ",")
End Function
Private Function ReadColumn(ByVal TableName)
OpenConn()
Set ReadColumn = Conn.openSchema(4, Array(Empty, Empty, TableName, Empty))
End Function
Private Sub CreateProcedure(ByVal SpName, ByVal SpSql)
OpenConn()
Set cmd.ActiveConnection = Conn
cmd.CommandText = SpSql
Set Cat.ActiveConnection = Conn
Cat.Procedures.Append SpName, Cmd
End Sub
End Class
Dim g : Set g = New Generator
g.DataPath = "data.mdb"
g.GenerateByTable("News")
’g.CreateTable
Set g = Nothing
%>

Diablo32

好厉害~！

longerface

太长了。~~~

coldstone

今天才抽空认真看了看，结构很清晰啊。如果偶这两天有空就帮忙把注释加上去。
PS:--------------------------------------------------------------------------------------
如果还有朋友不知道什么是ASP的类的话，建议先看看这篇帖子：

《如何编写ASP类》
dispbbs.asp?boardid=20&id=253022

[此贴子已经被作者于2005-7-21 16:24:00编辑过]

TZBAO1975

缺的就是注释，对于新手不容易看懂，如果有谁能提供一些单个语句，并附上注释就更好了，易于初学者

actionhhw

顶一个,但是最好加点注释才好,要不是显的很乱,楼主辛苦了.

willinee

我晕晕啦，一点都看不懂咯，我真的很想学ＡＳＰ呀，能不能从最最简单的开始！！

goldcar

好顶
希望继续写下去