来源:
为了建立一个健壮的J2EE应用,将所有对数据源的访问操作抽象封装在一个公共API中(建立一个接口)。
用户需要通过这接口,来进行和数据源的所有事务、交互。
。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
- DAO (Data Access Objects)(数据访问对象)是一种应用程序编程接口(API)。
- DAO是程序员访问数据库【Access数据库、其他的结构化查询语言(SQL)数据库】的 第一个面向对象的数据库接口。
- 它夹在业务逻辑与数据库资源中间。
- 它显露 Microsoft Jet数据库“引擎”(由 Microsoft Access 所使用),并允许开发者通过 ODBC 象直接连接到其他数据库一样,直接连接到 数据库表。
- DAO 最适用于单系统应用程序或小范围本地分布使用。
- DAO是Data Access Object数据访问接口,数据访问:顾名思义就是与数据库打交道。夹在业务逻辑与数据库资源中间。
开发人员使用数据访问对象(DAO)设计模式把底层的数据访问逻辑和高层的商务逻辑分开。
如何设计和实现数据访问对象?
- 哪些是事务性对象?
- 事务划分(transaction demarcation)包括:-
- 编程性事务(programmatic): 程序员担负编写事务逻辑代码的责任。
- 声明性事务(declarative) : 程序员使用EJB的部署描述符声明事务属性。
DAO模式是标准的J2EE设计模式之一.开发人员使用这个模式把底层的数据访问操作和上层的商务逻辑分开。
一个典型的DAO实现有下列几个组件:
- 一个DAO工厂类 (DaoFactory @ ConnectionFactory Class)
- 一个DAO接口 (Dao Interface)
- 一个实现DAO接口的具体类 (Implementation Class)
- 数据传递对象(值对象)
需知相关信息:
- 数据访问对象DAO的结构
- 数据访问对象DAO的功能
- 实战应用——使用数据访问对象DAO
。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。 Example (Visual Basic): How to use the DAO library to create, delete, modify and list the objects in Access.
[from:
http://allenbrowne.com/func-dao.html]
Option Compare Database
Option Explicit
Private Const intcIndexNone As Integer = 0
Private Const intcIndexGeneral As Integer = 1
Private Const intcIndexUnique As Integer = 3
Private Const intcIndexPrimary As Integer = 7
Function CreateTableDAO()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set db = CurrentDb()
Set tdf = db.CreateTableDef("tblDaoContractor")
With tdf
Set fld = .CreateField("ContractorID", dbLong)
fld.Attributes = dbAutoIncrField + dbFixedField
.Fields.Append fld
Set fld = .CreateField("Surname", dbText, 30)
fld.Required = True
.Fields.Append fld
.Fields.Append .CreateField("FirstName", dbText, 20)
.Fields.Append .CreateField("Inactive", dbBoolean)
.Fields.Append .CreateField("HourlyFee", dbCurrency)
.Fields.Append .CreateField("PenaltyRate", dbDouble)
Set fld = .CreateField("BirthDate", dbDate)
fld.ValidationRule = "Is Null Or <=Date()"
fld.ValidationText = "Birth date cannot be future."
.Fields.Append fld
.Fields.Append .CreateField("Notes", dbMemo)
Set fld = .CreateField("Web", dbMemo)
fld.Attributes = dbHyperlinkField + dbVariableField
.Fields.Append fld
End With
db.TableDefs.Append tdf
Set fld = Nothing
Set tdf = Nothing
Debug.Print "tblDaoContractor created."
Set tdf = db.CreateTableDef("tblDaoBooking")
With tdf
Set fld = .CreateField("BookingID", dbLong)
fld.Attributes = dbAutoIncrField + dbFixedField
.Fields.Append fld
.Fields.Append .CreateField("BookingDate", dbDate)
.Fields.Append .CreateField("ContractorID", dbLong)
.Fields.Append .CreateField("BookingFee", dbCurrency)
Set fld = .CreateField("BookingNote", dbText, 255)
fld.Required = True
.Fields.Append fld
End With
db.TableDefs.Append tdf
Set fld = Nothing
Set tdf = Nothing
Debug.Print "tblDaoBooking created."
Application.RefreshDatabaseWindow
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function ModifyTableDAO()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set db = CurrentDb()
Set tdf = db.TableDefs("tblDaoContractor")
tdf.Fields.Append tdf.CreateField("TestField", dbText, 80)
Debug.Print "Field added."
tdf.Fields.Delete "TestField"
Debug.Print "Field deleted."
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function DeleteTableDAO()
DBEngine(0)(0).TableDefs.Delete "DaoTest"
End Function
Function MakeGuidTable()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Set db = CurrentDb()
Set tdf = db.CreateTableDef("Table8")
With tdf
Set fld = .CreateField("ID", dbGUID)
fld.Attributes = dbFixedField
fld.DefaultValue = "GenGUID()"
.Fields.Append fld
End With
db.TableDefs.Append tdf
End Function
Function CreateIndexesDAO()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim ind As DAO.Index
Set db = CurrentDb()
Set tdf = db.TableDefs("tblDaoContractor")
Set ind = tdf.CreateIndex("PrimaryKey")
With ind
.Fields.Append .CreateField("ContractorID")
.Unique = False
.Primary = True
End With
tdf.Indexes.Append ind
Set ind = tdf.CreateIndex("Inactive")
ind.Fields.Append ind.CreateField("Inactive")
tdf.Indexes.Append ind
Set ind = tdf.CreateIndex("FullName")
With ind
.Fields.Append .CreateField("Surname")
.Fields.Append .CreateField("FirstName")
End With
tdf.Indexes.Append ind
tdf.Indexes.Refresh
Set ind = Nothing
Set tdf = Nothing
Set db = Nothing
Debug.Print "tblDaoContractor indexes created."
End Function
Function DeleteIndexDAO()
DBEngine(0)(0).TableDefs("tblDaoContractor").Indexes.Delete "Inactive"
End Function
Function CreateRelationDAO()
Dim db As DAO.Database
Dim rel As DAO.Relation
Dim fld As DAO.Field
Set db = CurrentDb()
Set rel = db.CreateRelation("tblDaoContractortblDaoBooking")
With rel
.Table = "tblDaoContractor"
.ForeignTable = "tblDaoBooking"
.Attributes = dbRelationUpdateCascade + dbRelationDeleteCascade
Set fld = .CreateField("ContractorID")
fld.ForeignName = "ContractorID"
.Fields.Append fld
End With
db.Relations.Append rel
Set fld = Nothing
Set rel = Nothing
Set db = Nothing
Debug.Print "Relation created."
End Function
Function DeleteRelationDAO()
DBEngine(0)(0).Relations.Delete "tblDaoContractortblDaoBooking"
End Function
Function DeleteQueryDAO()
DBEngine(0)(0).QueryDefs.Delete "qryDaoBooking"
End Function
Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As Integer, _
varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
If HasProperty(obj, strPropertyName) Then
obj.Properties(strPropertyName) = varValue
Else
obj.Properties.Append obj.CreateProperty(strPropertyName, intType, varValue)
End If
SetPropertyDAO = True
ExitHandler:
Exit Function
ErrHandler:
strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to " & varValue & _
". Error " & Err.Number & " - " & Err.Description & vbCrLf
Resume ExitHandler
End Function
Public Function HasProperty(obj As Object, strPropName As String) As Boolean
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function
Function StandardProperties(strTableName As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strCaption As String
Dim strErrMsg As String
Set db = CurrentDb()
Set tdf = db.TableDefs(strTableName)
Call SetPropertyDAO(tdf, "SubdatasheetName", dbText, "[None]", _
strErrMsg)
For Each fld In tdf.Fields
Select Case fld.Type
Case dbText, dbMemo
fld.AllowZeroLength = False
Call SetPropertyDAO(fld, "UnicodeCompression", dbBoolean, _
True, strErrMsg)
Case dbCurrency
fld.DefaultValue = 0
Call SetPropertyDAO(fld, "Format", dbText, "Currency", _
strErrMsg)
Case dbLong, dbInteger, dbByte, dbDouble, dbSingle, dbDecimal
fld.DefaultValue = vbNullString
Case dbBoolean
Call SetPropertyDAO(fld, "DisplayControl", dbInteger, _
CInt(acCheckBox))
End Select
strCaption = ConvertMixedCase(fld.Name)
If strCaption <> fld.Name Then
Call SetPropertyDAO(fld, "Caption", dbText, strCaption)
End If
Call SetFieldDescription(tdf, fld, , strErrMsg)
Next
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
If Len(strErrMsg) > 0 Then
Debug.Print strErrMsg
Else
Debug.Print "Properties set for table " & strTableName
End If
End Function
Function ConvertMixedCase(ByVal strIn As String) As String
Dim lngStart As Long
Dim strOut As String
Dim boolWasSpace As Boolean
Dim boolWasUpper As Boolean
strIn = Trim$(strIn)
boolWasUpper = True
For lngStart = 1& To Len(strIn)
Select Case Asc(Mid(strIn, lngStart, 1&))
Case vbKeyA To vbKeyZ
If boolWasSpace Or boolWasUpper Then
strOut = strOut & Mid(strIn, lngStart, 1&)
Else
strOut = strOut & " " & Mid(strIn, lngStart, 1&)
End If
boolWasSpace = False
boolWasUpper = True
Case 95
If Not boolWasSpace Then
strOut = strOut & " "
End If
boolWasSpace = True
boolWasUpper = False
Case vbKeySpace
If Not boolWasSpace Then
strOut = strOut & " "
End If
boolWasSpace = True
boolWasUpper = False
Case Else
strOut = strOut & Mid(strIn, lngStart, 1&)
boolWasSpace = False
boolWasUpper = False
End Select
Next
ConvertMixedCase = strOut
End Function
Function SetFieldDescription(tdf As DAO.TableDef, fld As DAO.Field, _
Optional ByVal strDescrip As String, Optional strErrMsg As String) _
As Boolean
If (fld.Attributes And dbAutoIncrField) > 0& Then
strDescrip = strDescrip & " Automatically generated " & _
"unique identifier for this record."
Else
If Len(strDescrip) = 0& Then
If HasProperty(fld, "Caption") Then
If Len(fld.Properties("Caption")) > 0& Then
strDescrip = fld.Properties("Caption") & "."
End If
End If
If Len(strDescrip) = 0& Then
strDescrip = fld.Name & "."
End If
End If
Select Case fld.Type
Case dbByte, dbInteger, dbLong
strDescrip = strDescrip & " Whole number."
Case dbSingle, dbDouble
strDescrip = strDescrip & " Fractional number."
Case dbText
strDescrip = strDescrip & " " & fld.Size & "-char max."
End Select
Select Case IndexOnField(tdf, fld)
Case intcIndexPrimary
strDescrip = strDescrip & " Required. Unique."
Case intcIndexUnique
If fld.Required Then
strDescrip = strDescrip & " Required. Unique."
Else
strDescrip = strDescrip & " Unique."
End If
Case Else
If fld.Required Then
strDescrip = strDescrip & " Required."
End If
End Select
If Len(fld.ValidationRule) > 0& Then
If Len(fld.ValidationText) > 0& Then
strDescrip = strDescrip & " " & fld.ValidationText
Else
strDescrip = strDescrip & " " & fld.ValidationRule
End If
End If
End If
If Len(strDescrip) > 0& Then
strDescrip = Trim$(Left$(strDescrip, 255&))
SetFieldDescription = SetPropertyDAO(fld, "Description", _
dbText, strDescrip, strErrMsg)
End If
End Function
Private Function IndexOnField(tdf As DAO.TableDef, fld As DAO.Field) _
As Integer
Dim ind As DAO.Index
Dim intReturn As Integer
intReturn = intcIndexNone
For Each ind In tdf.Indexes
If ind.Fields.Count = 1 Then
If ind.Fields(0).Name = fld.Name Then
If ind.Primary Then
intReturn = (intReturn Or intcIndexPrimary)
ElseIf ind.Unique Then
intReturn = (intReturn Or intcIndexUnique)
Else
intReturn = (intReturn Or intcIndexGeneral)
End If
End If
End If
Next
Set ind = Nothing
IndexOnField = intReturn
End Function
Function CreateQueryDAO()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDb()
Set qdf = db.CreateQueryDef("qryMyTable")
qdf.SQL = "SELECT MyTable.* FROM MyTable;"
Set qdf = Nothing
Set db = Nothing
Debug.Print "qryMyTable created."
End Function
Function CreateDatabaseDAO()
Dim dbNew As DAO.Database
Dim prp As DAO.Property
Dim strFile As String
strFile = "C:\SampleDAO.mdb"
Set dbNew = DBEngine(0).CreateDatabase(strFile, dbLangGeneral)
With dbNew
Set prp = .CreateProperty("Perform Name AutoCorrect", dbLong, 0)
.Properties.Append prp
Set prp = .CreateProperty("Track Name AutoCorrect Info", _
dbLong, 0)
.Properties.Append prp
End With
dbNew.Close
Set prp = Nothing
Set dbNew = Nothing
Debug.Print "Created " & strFile
End Function
Function ShowDatabaseProps()
Dim db As DAO.Database
Dim prp As DAO.Property
Set db = CurrentDb()
For Each prp In db.Properties
Debug.Print prp.Name
Next
Set db = Nothing
End Function
Function ShowFields(strTable As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set db = CurrentDb()
Set tdf = db.TableDefs(strTable)
For Each fld In tdf.Fields
Debug.Print fld.Name, FieldTypeName(fld)
Next
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function ShowFieldsRS(strTable)
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim strSql As String
strSql = "SELECT " & strTable & ".* FROM " & strTable & " WHERE (False);"
Set rs = DBEngine(0)(0).OpenRecordset(strSql)
For Each fld In rs.Fields
Debug.Print fld.Name, FieldTypeName(fld), "from " & fld.SourceTable & "." & fld.SourceField
Next
rs.Close
Set rs = Nothing
End Function
Public Function FieldTypeName(fld As DAO.Field)
Dim strReturn As String
Select Case CLng(fld.Type)
Case dbBoolean: strReturn = "Yes/No"
Case dbByte: strReturn = "Byte"
Case dbInteger: strReturn = "Integer"
Case dbLong
If (fld.Attributes And dbAutoIncrField) = 0& Then
strReturn = "Long Integer"
Else
strReturn = "AutoNumber"
End If
Case dbCurrency: strReturn = "Currency"
Case dbSingle: strReturn = "Single"
Case dbDouble: strReturn = "Double"
Case dbDate: strReturn = "Date/Time"
Case dbBinary: strReturn = "Binary"
Case dbText
If (fld.Attributes And dbFixedField) = 0& Then
strReturn = "Text"
Else
strReturn = "Text (fixed width)"
End If
Case dbLongBinary: strReturn = "OLE Object"
Case dbMemo
If (fld.Attributes And dbHyperlinkField) = 0& Then
strReturn = "Memo"
Else
strReturn = "Hyperlink"
End If
Case dbGUID: strReturn = "GUID"
Case dbBigInt: strReturn = "Big Integer"
Case dbVarBinary: strReturn = "VarBinary"
Case dbChar: strReturn = "Char"
Case dbNumeric: strReturn = "Numeric"
Case dbDecimal: strReturn = "Decimal"
Case dbFloat: strReturn = "Float"
Case dbTime: strReturn = "Time"
Case dbTimeStamp: strReturn = "Time Stamp"
Case 101&: strReturn = "Attachment"
Case 102&: strReturn = "Complex Byte"
Case 103&: strReturn = "Complex Integer"
Case 104&: strReturn = "Complex Long"
Case 105&: strReturn = "Complex Single"
Case 106&: strReturn = "Complex Double"
Case 107&: strReturn = "Complex GUID"
Case 108&: strReturn = "Complex Decimal"
Case 109&: strReturn = "Complex Text"
Case Else: strReturn = "Field type " & fld.Type & " unknown"
End Select
FieldTypeName = strReturn
End Function
Function DAORecordsetExample()
Dim rs As DAO.Recordset
Dim strSql As String
strSql = "SELECT MyField FROM MyTable;"
Set rs = DBEngine(0)(0).OpenRecordset(strSql)
Do While Not rs.EOF
Debug.Print rs!MyField
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function
Function ShowFormProperties(strFormName As String)
On Error GoTo Err_Handler
Dim frm As Form
Dim ctl As Control
Dim prp As Property
Dim strOut As String
DoCmd.OpenForm strFormName, acDesign, WindowMode:=acHidden
Set frm = Forms(strFormName)
For Each ctl In frm
For Each prp In ctl.Properties
strOut = strFormName & "." & ctl.Name & "." & prp.Name & ": "
strOut = strOut & prp.Type & vbTab
strOut = strOut & prp.Value
Debug.Print strOut
Next
If ctl.ControlType = acTextBox Then Stop
Next
Set frm = Nothing
DoCmd.Close acForm, strFormName, acSaveNo
Exit_Handler:
Exit Function
Err_Handler:
Select Case Err.Number
Case 2186:
strOut = strOut & Err.Description
Resume Next
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ShowFormProperties()"
Resume Exit_Handler
End Select
End Function
Public Function ExecuteInTransaction(strSql As String, Optional strConfirmMessage As String) As Long
On Error GoTo Err_Handler
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim bInTrans As Boolean
Dim bCancel As Boolean
Dim strMsg As String
Dim lngReturn As Long
Const lngcUserCancel = -2&
Set ws = DBEngine(0)
ws.BeginTrans
bInTrans = True
Set db = ws(0)
db.Execute strSql, dbFailOnError
lngReturn = db.RecordsAffected
If strConfirmMessage <> vbNullString Then
If MsgBox(lngReturn & " " & Trim$(strConfirmMessage), vbOKCancel + vbQuestion, "Confirm") <> vbOK Then
bCancel = True
lngReturn = lngcUserCancel
End If
End If
If bCancel Then
ws.Rollback
Else
ws.CommitTrans
End If
bInTrans = False
Exit_Handler:
ExecuteInTransaction = lngReturn
On Error Resume Next
Set db = Nothing
If bInTrans Then
ws.Rollback
End If
Set ws = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ExecuteInTransaction()"
lngReturn = -1
Resume Exit_Handler
End Function
Function GetAutoNumDAO(strTable) As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set db = CurrentDb()
Set tdf = db.TableDefs(strTable)
For Each fld In tdf.Fields
If (fld.Attributes And dbAutoIncrField) <> 0 Then
GetAutoNumDAO = fld.Name
Exit For
End If
Next
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Function