也可以浏览这里，有更详细的UML类视图描述
http://leek.woku.com/article/4859859.html
作者：段利庆 QQ：14035344
这个类模块主要有两个类模块通过继承的方法和实现这个类的接口，来方便的对数据库操作，同样也符合标准的软件设计模式。
基类
【DBbase】通用的数据库操作方法的集合
重要的方法：
【DBOperate】返回数据库表和执行查询的操作方法
【Delete】删除记录 创建派生类时 给保护字段sTable 得到表名称 就可以执行删除操作了
【XXX】其他的一些数据表处理方法
接口
【ITableOperate】
【AddNew】 添加记录 由派生类实现接口
【 Update】更新记录 由派生类实现接口
'基类代码：
Public MustInherit Class DBbase
'*声明添加 和更新 记录的接口 注：删除记录的方法 由派生类继承
Public Interface ITableOperate
Sub AddNew()
Sub Update(ByVal ID As Long)
End Interface
'*可以在基类和派生类中访问
Protected sTable As String
'*【Overridable】关键字表式方法可以在派生类中重写
'Public Overridable Sub AddNew()
'End Sub
'Public Overridable Sub Update(ByVal ID As Long)
'End Sub
Public Overridable Sub Delete(ByVal ID As Long)
Dim strSQL As String
'strSQL = "DELETE FROM " & sTable & " " & _
' "WHERE 编号 = " & ID
strSQL = "UPDATE " & sTable & " " & _
"SET 删除 = " & "1" & " " & _
"WHERE 编号 = " & ID
DBOperate(strSQL)
End Sub
'*----------------------------------------------------------------------------
'*以下来自【DBOperation】
Public Function DBOperate(ByVal SQLString As String, Optional ByRef Msg As String = vbNullString) As DataTable
Try
Dim CONN As String
CONN = "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" + Application.StartupPath + "/DataBase/LeeDB.mdb"
Dim oleconn As New OleDb.OleDbConnection(CONN)
Dim cmd As OleDb.OleDbCommand = New OleDb.OleDbCommand(SQLString, oleconn)
cmd.CommandType = CommandType.Text
Dim sTokens() As String
sTokens = SQLString.Split(" ")
If Strings.InStr("INSERT,DELETE,UPDATE", sTokens(0).ToUpper) Then
If oleconn.State <> ConnectionState.Open Then
oleconn.Open() '打开数据库连接
End If
cmd.ExecuteNonQuery() '执行SQL语句
If oleconn.State <> ConnectionState.Closed Then
oleconn.Close() '关闭数据库连接
End If
If sTokens(0).ToUpper = "INSERT" Then
MsgBox("插入记录成功")
End If
If sTokens(0).ToUpper = "DELETE" Then
MsgBox("删除记录成功")
End If
If sTokens(0).ToUpper = "UPDATE" Then
MsgBox("更新记录成功")
End If
Return Nothing
Else
Dim ObjectdsDataSet As New DataSet()
Dim adapter As New OleDb.OleDbDataAdapter()
adapter.TableMappings.Add("Table", "TEMP")
adapter.SelectCommand = cmd
If oleconn.State <> ConnectionState.Open Then
oleconn.Open() '打开数据库连接
End If
cmd.ExecuteNonQuery() '执行SQL语句
If oleconn.State <> ConnectionState.Closed Then
oleconn.Close() '关闭数据库连接
End If
adapter.Fill(ObjectdsDataSet) '填充数据集
Return ObjectdsDataSet.Tables("TEMP")
End If
Catch
MsgBox(Err.Description)
End Try
End Function
Public Function QueryStr(ByVal Str_Renamed As String) As Object
'' ==========================================================
' 开发人员：段利庆
' 编写时间：06-5-23
' 过程名称：QueryStr
' 参数说明：str 待格式 的字符串
' 功能说明：返回 要过滤的查询字符串格式 例如： 'string'
'' ==========================================================
Dim pos As Integer
pos = InStr(Str_Renamed, "'")
While pos > 0
Str_Renamed = Mid(Str_Renamed, 1, pos) & "'" & Mid(Str_Renamed, pos + 1)
pos = InStr(pos + 2, Str_Renamed, "'")
End While
'UPGRADE_WARNING: 未能解析对象 QueryStr 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
QueryStr = "'" & Str_Renamed & "'"
End Function
Public Function DateToSQLstr(ByVal Date_Value As Date, Optional ByVal blnTime As Boolean = False) As String
'' ==========================================================
' 开发人员：段利庆
' 编写时间：05-6-26
' 函数名称：DateToSQLstr
' 参数说明：Date_Value 时间值
' blnTime 开始时间(False) 00:00:00点 或(True)23:59:59
' 功能说明：将日期值转换为SQL查询可用的字符串
'' ==========================================================
If Not blnTime Then
DateToSQLstr = "#" & Date_Value.Month & "-" & Date_Value.Day & "-" & Date_Value.Year & " 00:00:00#"
Else
DateToSQLstr = "#" & Date_Value.Month & "-" & Date_Value.Day & "-" & Date_Value.Year & " 23:59:59#"
End If
End Function
Public Function TimeToSQLstr(ByVal Date_Value As Date) As String
'' ==========================================================
' 开发人员：段利庆
' 编写时间：07-01-01
' 函数名称：TimeToSQLstr
' 参数说明：Date_Value 时间值
' 功能说明：将时间值转换为SQL查询可用的字符串
'' ==========================================================
TimeToSQLstr = "#" & Hour(Date_Value) & ":" & Minute(Date_Value) & ":" & Second(Date_Value) & "#"
End Function
Public Function DateToSQLstrServer(ByVal Date_Value As Date, Optional ByVal blnTime As Boolean = False) As String
'' ==========================================================
' 开发人员：段利庆
' 编写时间：05-6-26
' 函数名称：DateToSQLstr
' 参数说明：Date_Value 时间值
' blnTime 开始时间(False) 00:00:00点 或(True)23:59:59
' 功能说明：将日期值转换为SQL查询可用的字符串
' 适用于SQL SERVER
'' ==========================================================
If Not blnTime Then
DateToSQLstrServer = "' " & Date_Value.Year & "-" & Date_Value.Month & "-" & Date_Value.Day & " 00:00:00" & "' "
Else
DateToSQLstrServer = "' " & Date_Value.Year & "-" & Date_Value.Month & "-" & Date_Value.Day & " 23:59:59" & "' "
End If
End Function
Public Sub QueryToLV(ByVal strSQL As String, ByRef LV As ListView, Optional ByVal ImageID As Integer = 0)
'' ==========================================================
' 开发人员：段利庆
' 编写时间：09-07-10
' 过程名称：QueryToLV
' 参数说明：strSQL 查询字符串
' Lv ListView
' ImageID 绑定ImageList的图标 ID号
' 功能说明：将查询结果导入到<ListView>
'' ==========================================================
Dim SQLString As String = strSQL
Dim UserTable As DataTable = DBOperation.DBOperate(SQLString)
LV.Items.Clear()
LV.Columns.Clear()
LV.View = View.Details
LV.GridLines = True
LV.FullRowSelect = True
'*绑定主窗体上的【ImgLst】
LV.SmallImageList = FrmMain.ImgLst
Dim i As Integer
For i = 0 To UserTable.Columns.Count - 1
LV.Columns.Add(UserTable.Columns.Item(i).ColumnName)
Next
Dim RowCount As Integer
Dim RowName As String
Dim FidldsCount As Integer
Dim LItem As ListViewItem
For RowCount = 0 To UserTable.Rows.Count - 1
RowName = UserTable.Rows(RowCount).Item(0).ToString
'LV.Items.Add(RowName)
LItem = New ListViewItem(RowName, ImageID)
For FidldsCount = 1 To UserTable.Columns.Count - 1
LItem.SubItems.Add(UserTable.Rows(RowCount).Item(FidldsCount).ToString)
Next FidldsCount
LV.Items.Add(LItem)
Next RowCount
End Sub
Public Function GetRecordID(ByVal TableName As String, _
ByVal FieldName As String, _
ByVal FieldValue As String, _
ByVal IDName As String) As Long
'' ==========================================================
' 开发人员：段利庆
' 编写时间：2009-07-14
' 函数名称：GetRecordID
' 参数说明：TableName 表名称
' FieldName 字段名称
' FieldValue 字段值
' IDName 编号名称
' 功能说明：根据字段名称（数据库字段属性设为不重复）获得编号，应用于多表关系中
'' ==========================================================
On Error GoTo PROC_ERR
Dim strMessage As String
Dim strSQL As String
Dim RcdCount As Long
strSQL = "SELECT " & IDName & ", " & FieldName & " " & _
"FROM " & TableName & " " & _
"WHERE " & FieldName & " = " & QueryStr(FieldValue)
Dim tTable As DataTable = DBOperation.DBOperate(strSQL)
RcdCount = tTable.Rows.Count
If RcdCount = 0 Then
Debug.Print("记录表内 该名称的 字段 不存在")
Return -1
GoTo PROC_EXIT
End If
If RcdCount > 1 Then
Debug.Print("记录表内 该名称的 字段 有重复")
Return -1
GoTo PROC_EXIT
End If
Return tTable.Rows(0)(IDName)
PROC_EXIT:
Exit Function
PROC_ERR:
Call ShowError("DBbase", "GetRecordID", Err.Number, Err.Description)
GoTo PROC_EXIT
End Function
Public Function GetRecordStr(ByVal TableName As String, _
ByVal FieldName As String, _
ByVal IDValue As Long, _
ByVal IDName As String) As String
'' ==========================================================
' 开发人员：段利庆
' 编写时间：2009-07-14
' 函数名称：GetRecordStr
' 参数说明：TableName 表名称
' FieldName 字段名称
' IDValue 字段值
' IDName 编号名称
' 功能说明：根据字段[编号]（数据库字段属性设为不重复）获得字段字符值，应用于多表关系中
'' ==========================================================
'*中央错误处理
On Error GoTo PROC_ERR
Dim strMessage As String
Dim strSQL As String
Dim RcdCount As Long '记录总数
strSQL = "SELECT " & IDName & ", " & FieldName & " " & _
"FROM " & TableName & " " & _
"WHERE " & IDName & " = " & IDValue
Dim tTable As DataTable = DBOperation.DBOperate(strSQL)
RcdCount = tTable.Rows.Count
If RcdCount = 0 Then
Debug.Print("记录表内 该名称的 字段 不存在")
Return "Error Message ~~!!"
GoTo PROC_EXIT
End If
If RcdCount > 1 Then
Debug.Print("记录表内 该名称的 字段 有重复")
Return "Error Message ~~!!"
GoTo PROC_EXIT
End If
Return tTable.Rows(0)(FieldName)
PROC_EXIT:
Exit Function
PROC_ERR:
Call ShowError("DBbase", "GetRecordStr", Err.Number, Err.Description)
GoTo PROC_EXIT
End Function
Public Function GetRecordCount(ByVal strSQL As String) As Long
'' ==========================================================
' 开发人员：段利庆
' 编写时间：2009-07-22
' 函数名称：GetRecordCount
' 参数说明：strSQL SLQ查询字符串
' 功能说明：得到查询的记录条数
'' ==========================================================
'*中央错误处理
On Error GoTo PROC_ERR
Dim strMessage As String
Dim RcdCount As Long '记录总数
Dim tTable As DataTable = DBOperation.DBOperate(strSQL)
RcdCount = tTable.Rows.Count
Return RcdCount
PROC_EXIT:
Exit Function
PROC_ERR:
Call ShowError("DBbase", "GetRecordCount", Err.Number, Err.Description)
GoTo PROC_EXIT
End Function
Public Sub LoadFieldToComb(ByVal TableName As String, _
ByVal FieldName As String, _
ByVal Comb As ComboBox)
'' ==========================================================
' 开发人员：段利庆
' 编写时间：2009-07-20
' 过程名称：LoadFieldToComb
' 参数说明：TableName 表名称
' FieldName 字段名称
' Comb 要载入的下拉列表框控件
' 功能说明：将数据库的一个字段内容载入下拉列表框
'' ==========================================================
'*中央错误处理
On Error GoTo PROC_ERR
Dim strMessage As String
Dim strSQL As String
strSQL = "SELECT " & FieldName & " " & _
"FROM " & TableName
Dim RcdCount As Long '记录总数
Dim tTable As DataTable = DBOperation.DBOperate(strSQL)
RcdCount = tTable.Rows.Count
If RcdCount = 0 Then
Debug.Print("记录表内 该名称的 字段 不存在")
GoTo PROC_EXIT
End If
Comb.Items.Clear()
Comb.DataSource = tTable
PROC_EXIT:
Exit Sub
PROC_ERR:
Call ShowError("DBbase", "LoadFieldToComb", Err.Number, Err.Description)
GoTo PROC_EXIT
End Sub
Public Function GetMaxIndexVal(ByVal sTable As String, ByVal sField As String) As Long
'' ==========================================================
' 开发人员：段利庆
' 编写时间：2009-07-24
' 函数名称：GetMaxIndexVal
' 参数说明：sTable 表名称
' sField 字段名称 字段属性必须为数字
' 功能说明：获得表内最大的数字值， 防止添加有重复的字段值
'' ==========================================================
'*中央错误处理
On Error GoTo PROC_ERR
Dim strSQL As String
Dim RcdCount As Long '记录总数
strSQL = "SELECT Max(" & sField & ") AS MaxVal " & _
"FROM " & sTable & " "
Dim tTable As DataTable = DBOperation.DBOperate(strSQL)
Return tTable.Rows(0)("MaxVal")
PROC_EXIT:
Exit Function
PROC_ERR:
Call ShowError("DBbase", "GetMaxIndexVal", Err.Number, Err.Description)
Return -1
GoTo PROC_EXIT
End Function
End Class
'派生类代码：
Public Class DBMeterPrice
Inherits DBbase
'*实现对数据记录操作的接口
Implements DBbase.ITableOperate
Public ID As Long '编号
Public sCaption As String '名称
Public dPrice As Decimal '单价
Public sMemo As String '备注
Public bDelTag As Boolean '删除标记
Public Sub New()
Me.sTable = "计量仪表_价格"
End Sub
Public Sub Full(ByRef LV As ListView)
Dim strSQL As String
strSQL = "SELECT 编号 as _ ,名称,单价,备注,删除 " & _
"FROM 计量仪表_价格 " & _
"WHERE 删除 = 0 " & _
"ORDER BY 编号 "
Me.QueryToLV(strSQL, LV)
End Sub
Public Sub AddNew() Implements DBbase.ITableOperate.AddNew
On Error GoTo PROC_ERR
Dim strMessage As String
Dim strSQL As String
strSQL = "SELECT 编号,名称,单价,备注,删除 " & _
"FROM 计量仪表_价格 " & _
"WHERE 名称 = " & Me.QueryStr(Me.sCaption)
If Me.GetRecordCount(strSQL) >= 1 Then
'*防止重复添加重复记录 在这里首先判断处理
strMessage = "顾客地址已经存在"
Debug.Print(strMessage)
MessageBox.Show(strMessage, "提示", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
GoTo PROC_EXIT
End If
Dim iMaxMeterID As Integer
iMaxMeterID = Me.GetMaxIndexVal(Me.sTable, "子表号") + 1
strSQL = "INSERT INTO 计量仪表_价格(名称,子表号,单价,备注,删除 ) " & _
"VALUES( " & Me.QueryStr(Me.sCaption) & "," & _
iMaxMeterID & "," & _
Me.dPrice & "," & _
Me.QueryStr(Me.sMemo) & "," & _
"0" & ")"
DBOperate(strSQL)
PROC_EXIT:
Exit Sub
PROC_ERR:
Call ShowError("DBMeterPrice", "AddNew", Err.Number, Err.Description)
GoTo PROC_EXIT
End Sub
Public Sub Update(ByVal ID As Long) Implements DBbase.ITableOperate.Update
On Error GoTo PROC_ERR
Dim strMessage As String
Dim strSQL As String
strSQL = "UPDATE 计量仪表_价格 " & _
"SET 名称 = " & Me.QueryStr(Me.sCaption) & ", " & _
"单价 = " & Me.dPrice.ToString & ", " & _
"备注 = " & Me.QueryStr(Me.sMemo.ToString) & ", " & _
"删除 = " & Me.bDelTag.ToString & " " & _
"WHERE 编号 = " & ID
'*因名称也是唯一的 故采用名称过滤也是可以的
'*采用【编号】过滤应该是最安全的
DBOperate(strSQL)
PROC_EXIT:
Exit Sub
PROC_ERR:
Call ShowError("DBCustomer", "Update", Err.Number, Err.Description)
GoTo PROC_EXIT
End Sub
End Class
2098
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
