databaseop.bas

群里的通讯录管理 供参考 学习专用 无其他商业意义 源码较为简单

Attribute VB_Name = "databaseop"
'***********************************************************************
'* 文件名： databaseop.bas
'* 说  明： 数据库操作模块
'* 版  本： 2005.12.16 颜志军 初版
'***********************************************************************

Option Explicit

'***********************************************************************
'模块级变量定义
Private g_dbconn As ADODB.Connection      '数据库连接

'***********************************************************************
'过程及函数定义

'***********************************************************************
'* 函数名：GetDbConnString
'* 功  能：取得连接数据库字符串
'* 参  数：无
'* 返回值：String                       数据库连接字符串
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Private Function GetDbConnString() As String
    GetDbConnString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" _
        & App.Path & "\directory.mdb;"
End Function


'***********************************************************************
'* 函数名：ConnDb
'* 功  能：连接数据库
'* 参  数：无
'* 返回值：Boolean              true    连接成功
'*       ：                     false   连接失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function ConnDb() As Boolean
    On Error GoTo FunctionEnd
    ConnDb = False
    Set g_dbconn = New ADODB.Connection
    g_dbconn.CursorLocation = adUseClient
    g_dbconn.Open GetDbConnString()
    ConnDb = True
FunctionEnd:
End Function

'***********************************************************************
'* 函数名：CloseDbConn
'* 功  能：关闭数据库连接
'* 参  数：无
'* 返回值：无
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function CloseDbConn()
    On Error Resume Next
    If IsObject(g_dbconn) Then
        g_dbconn.Close
    End If
    Set g_dbconn = Nothing
End Function

'***********************************************************************
'* 函数名：AppendGroup
'* 功  能：追加组信息
'* 参  数：GroupInfo                    组信息
'* 返回值：Boolean              true    追加成功
'*       ：                     false   追加失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function AppendGroup(ByRef newGroupInfo As GroupInfo) As Boolean
    '参数检查
    If IsNull(newGroupInfo.groupName) Or _
        IsEmpty(newGroupInfo.groupName) Or _
        newGroupInfo.groupName = "" Then
        AppendGroup = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String       'SQL
    Dim affectLines As Long '影响行数
   
    '生成SQL
    sql = "INSERT INTO groupinfo(groupname) VALUES('" & _
        newGroupInfo.groupName & "')"
    
    '执行插入
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines = 1 Then
        AppendGroup = True
    Else
        AppendGroup = False
    End If
    Exit Function
    
ERREND:
    AppendGroup = False
End Function

'***********************************************************************
'* 函数名：IsExistGroup
'* 功  能：查询组名是否存在
'* 参  数：String                       组名
'*       ：Boolean                      存在与否
'* 返回值：Boolean              true    查询成功
'*       ：                     false   查询失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function IsExistGroup(ByVal groupName As String, _
                    ByRef existFlag As Boolean) As Boolean
    '参数检查
    groupName = Trim(groupName)
    If IsNull(groupName) Or _
        IsEmpty(groupName) Or _
        groupName = "" Then
        IsExistGroup = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT * FROM groupinfo WHERE groupname='" & groupName & "'"
    
    '执行查询
    On Error GoTo ERREND
    Set rs = g_dbconn.Execute(sql)
    If rs.RecordCount > 0 Then
        IsExistGroup = True
        existFlag = True
    Else
        IsExistGroup = True
        existFlag = False
    End If
    rs.Close
    Set rs = Nothing
    Exit Function
    
ERREND:
    IsExistGroup = False
End Function

'***********************************************************************
'* 函数名：RemoveGroup
'* 功  能：删除组
'* 参  数：GroupInfo                    组信息
'* 返回值：Boolean              true    追加成功
'*       ：                     false   追加失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function RemoveGroup(ByRef removedgroup As GroupInfo) As Boolean
    '变量定义
    Dim sql As String 'SQL
    Dim affectLines As Long '影响行数
    
    '参数检查
    If removedgroup.groupid <= 0 Then           '组ID不合法
        If IsNull(removedgroup.groupName) Or _
           IsEmpty(removedgroup.groupName) Or _
           removedgroup.groupName = "" Then     '组名不合法
            '退出删除操作
            RemoveGroup = False
            Exit Function
        Else
            '生成以组名为条件的删除语句
            sql = "DELETE FROM groupinfo WHERE groupname='" & _
                Trim(removedgroup.groupName) & "'"
        End If
    Else
        '生成以组ID为条件的删除语句
        sql = "DELETE FROM groupinfo WHERE groupid=" & removedgroup.groupid
    End If
    
    '执行删除
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines >= 1 Then
        RemoveGroup = True
    Else
        RemoveGroup = False
    End If
    Exit Function
    
ERREND:
    RemoveGroup = False
End Function

'***********************************************************************
'* 函数名：GetGroupRecordset
'* 功  能：取得组信息记录集
'* 参  数：
'* 返回值：Recordset
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function GetGroupRecordset() As ADODB.Recordset
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT * FROM groupinfo"
    
    '执行查询
    On Error GoTo ERREND
    Set rs = g_dbconn.Execute(sql)
    Set GetGroupRecordset = rs
    Exit Function
ERREND:
    Set GetGroupRecordset = Nothing
End Function

'***********************************************************************
'* 函数名：GetGroupId
'* 功  能：取得组ID
'* 参  数：String                       组名
'* 返回值：Long                         组ID
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function GetGroupId(ByVal groupName As String) As Long
    '初始化返回值
    GetGroupId = -1
    
    '参数检查
    groupName = Trim(groupName)
    If IsNull(groupName) Or _
        IsEmpty(groupName) Or _
        groupName = "" Then
        Exit Function
    End If
    
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT * FROM groupinfo WHERE groupname='" & groupName & "'"
    
    '执行查询
    On Error Resume Next
    Set rs = g_dbconn.Execute(sql)
    If rs.RecordCount > 0 Then
        GetGroupId = rs("groupid")
    End If
    rs.Close
    Set rs = Nothing
End Function

'***********************************************************************
'* 函数名：GetGroupInfo
'* 功  能：根据组ID取得组信息
'* 参  数：Long                         组ID
'* 返回值：Boolean              true    取得成功
'*       ：                     false   取得失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function GetGroupInfo(ByVal groupid As Long, _
            ByRef curPeopleInfo As GroupInfo) As Boolean
    '初始化返回值
    GetGroupInfo = False
    
    '参数检查
    If groupid <= 0 Then
        Exit Function
    End If
    
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT * FROM groupinfo WHERE groupid=" & groupid
    
    '执行查询
    On Error Resume Next
    Set rs = g_dbconn.Execute(sql)
    If Not rs.EOF Then
        curPeopleInfo.groupid = rs("groupid")
        curPeopleInfo.groupName = rs("groupname")
        GetGroupInfo = True
    End If
    rs.Close
    Set rs = Nothing
End Function

'***********************************************************************
'* 函数名：GetGroupNum
'* 功  能：取得组数量
'* 参  数：
'* 返回值：Integer                      数量
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function GetGroupNum() As Integer
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT COUNT(*) FROM groupinfo"
    
    '初始化返回值
    GetGroupNum = 0
    
    '执行查询
    On Error Resume Next
    Set rs = g_dbconn.Execute(sql)
    If Not rs.EOF Then
        GetGroupNum = rs(0)
    End If
    rs.Close
    Set rs = Nothing
End Function

'***********************************************************************
'* 函数名：UpdateGroupInfo
'* 功  能：更新组信息
'* 参  数：GroupInfo                    组信息
'* 返回值：Boolean              true    更新成功
'*       ：                     false   更新失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function UpdateGroupInfo(ByRef newGroupInfo As GroupInfo)
     '参数检查
    If IsNull(newGroupInfo.groupName) Or _
        IsEmpty(newGroupInfo.groupName) Or _
        newGroupInfo.groupName = "" Or _
        newGroupInfo.groupid <= 0 Then
        UpdateGroupInfo = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String       'SQL
    Dim affectLines As Long '影响行数
   
    '生成SQL
    sql = "UPDATE groupinfo SET groupname = '" & newGroupInfo.groupName _
        & "' WHERE groupid=" & newGroupInfo.groupid
    
    '执行更新
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines = 1 Then
        UpdateGroupInfo = True
    Else