一个ACCESS数据库访问的类
作者：
一个ACCESS数据库访问的类
大部分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
还有一个读取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，其结构如下：
则其对应的模型层如下：
<%
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），因为需要以优雅之心情，编写优雅的代码(哎呀，谁扔的鸡蛋？拜托换个新鲜点的）。
<%
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
还有一个读取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，其结构如下：
则其对应的模型层如下：
<%
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），因为需要以优雅之心情，编写优雅的代码(哎呀，谁扔的鸡蛋？拜托换个新鲜点的）。