databaseop.bas

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

        UpdateGroupInfo = False
    End If
    Exit Function
    
ERREND:
    UpdateGroupInfo = False
End Function


'***********************************************************************
'* 函数名：GetGroupMember
'* 功  能：取得组成员记录集
'* 参  数：long                         组ID
'* 返回值：Recordset
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function GetGroupMember(ByVal groupid As Long) _
    As ADODB.Recordset
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT * FROM people WHERE groupId=" & CStr(groupid)
    
    '执行查询
    On Error GoTo ERREND
    Set rs = g_dbconn.Execute(sql)
    Set GetGroupMember = rs
    Exit Function
ERREND:
    Set GetGroupMember = Nothing
End Function

'***********************************************************************
'* 函数名：AppendPeople
'* 功  能：增加成员记录
'* 参  数：PeopleInfo                   人员信息
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function AppendPeople(ByRef newPeopleInfo As PeopleInfo) _
        As Boolean
    '参数检查,姓名及性别必须
    If IsNull(newPeopleInfo.peopleName) Or _
            IsEmpty(newPeopleInfo.peopleName) Or _
            newPeopleInfo.peopleName = "" Or _
            IsNull(newPeopleInfo.sex) Or _
            IsEmpty(newPeopleInfo.sex) Or _
            newPeopleInfo.sex = "" Then
        AppendPeople = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String       'SQL
    Dim affectLines As Long '影响行数
    
    '生成SQL
    sql = "INSERT INTO people(groupId, peopleName, sex, companyName, " _
            & "companyDepartment, appointment, companyAddress, " _
            & "companyPostcode, companyPhone, companyFax, " _
            & "compnaywebsite, familyAddress, familyPostcode, " _
            & "familyPhone, mobilePhone, homepage, email, emailbak, " _
            & "MSN, QQ, QQbak, otherInfo) "
    sql = sql _
            & " VALUES(" & newPeopleInfo.groupid & ",'" _
            & newPeopleInfo.peopleName & "','" _
            & newPeopleInfo.sex & "','" _
            & newPeopleInfo.companyName & "','" _
            & newPeopleInfo.companyDepartment & "','" _
            & newPeopleInfo.appointment & "','" _
            & newPeopleInfo.companyAddress & "','" _
            & newPeopleInfo.companyPostcode & "','" _
            & newPeopleInfo.companyPhone & "','" _
            & newPeopleInfo.companyFax & "','" _
            & newPeopleInfo.compnaywebsite & "','" _
            & newPeopleInfo.familyAddress & "','" _
            & newPeopleInfo.familyPostcode & "','" _
            & newPeopleInfo.familyPhone & "','" _
            & newPeopleInfo.mobilePhone & "','" _
            & newPeopleInfo.homepage & "','" _
            & newPeopleInfo.email & "','" _
            & newPeopleInfo.emailbak & "','" _
            & newPeopleInfo.MSN & "','" _
            & newPeopleInfo.QQ & "','" _
            & newPeopleInfo.QQbak & "','" _
            & newPeopleInfo.otherInfo _
            & "')"
    
    '执行插入
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines = 1 Then
        AppendPeople = True
    Else
        AppendPeople = False
    End If
    Exit Function
    
ERREND:
    AppendPeople = False
End Function

'***********************************************************************
'* 函数名：UpdatePeopleInfo
'* 功  能：更新成员记录
'* 参  数：PeopleInfo                   人员信息
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function UpdatePeopleInfo(ByRef newPeopleInfo As PeopleInfo) _
        As Boolean
    '参数检查,姓名及性别必须, 人员ID须大于0
    If IsNull(newPeopleInfo.peopleName) Or _
            IsEmpty(newPeopleInfo.peopleName) Or _
            newPeopleInfo.peopleName = "" Or _
            IsNull(newPeopleInfo.sex) Or _
            IsEmpty(newPeopleInfo.sex) Or _
            newPeopleInfo.sex = "" Or _
            newPeopleInfo.peopleId <= 0 Then
        UpdatePeopleInfo = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String       'SQL
    Dim affectLines As Long '影响行数
    
    '生成SQL
    sql = "UPDATE people SET peopleName='" & newPeopleInfo.peopleName & "'"
    sql = sql & ", sex='" & newPeopleInfo.sex & "'"
    sql = sql & ", groupId='" & newPeopleInfo.groupid & "'"
    sql = sql & ", companyName='" & newPeopleInfo.companyName & "'"
    sql = sql & ", companyDepartment='" & newPeopleInfo.companyDepartment & "'"
    sql = sql & ", appointment='" & newPeopleInfo.appointment & "'"
    sql = sql & ", companyAddress='" & newPeopleInfo.companyAddress & "'"
    sql = sql & ", companyPostcode='" & newPeopleInfo.companyPostcode & "'"
    sql = sql & ", companyPhone='" & newPeopleInfo.companyPhone & "'"
    sql = sql & ", companyFax='" & newPeopleInfo.companyFax & "'"
    sql = sql & ", compnaywebsite='" & newPeopleInfo.compnaywebsite & "'"
    sql = sql & ", familyAddress='" & newPeopleInfo.familyAddress & "'"
    sql = sql & ", familyPostcode='" & newPeopleInfo.familyPostcode & "'"
    sql = sql & ", familyPhone='" & newPeopleInfo.familyPhone & "'"
    sql = sql & ", mobilePhone='" & newPeopleInfo.mobilePhone & "'"
    sql = sql & ", homepage='" & newPeopleInfo.homepage & "'"
    sql = sql & ", email='" & newPeopleInfo.email & "'"
    sql = sql & ", emailbak='" & newPeopleInfo.emailbak & "'"
    sql = sql & ", MSN='" & newPeopleInfo.MSN & "'"
    sql = sql & ", QQ='" & newPeopleInfo.QQ & "'"
    sql = sql & ", QQbak='" & newPeopleInfo.QQbak & "'"
    sql = sql & ", otherInfo='" & newPeopleInfo.otherInfo & "'"
    sql = sql & " WHERE peopleId=" & newPeopleInfo.peopleId
    
    '执行更新
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines = 1 Then
        UpdatePeopleInfo = True
    Else
        UpdatePeopleInfo = False
    End If
    Exit Function
    
ERREND:
    UpdatePeopleInfo = False
End Function


'***********************************************************************
'* 函数名：RemovePeople
'* 功  能：删除指定ID人员
'* 参  数：Long                         人员ID
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function RemovePeople(ByVal peopleId As Long) As Boolean
    '参数检查
    If peopleId <= 0 Then
        RemovePeople = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String 'SQL
    Dim affectLines As Long '影响行数
    
    '生成删除语句
    sql = "DELETE FROM people WHERE peopleId=" & peopleId
    
    '执行删除
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines >= 1 Then
        RemovePeople = True
    Else
        RemovePeople = False
    End If
    Exit Function
    
ERREND:
    RemovePeople = False
End Function

'***********************************************************************
'* 函数名：GetSinglePeopleInfo
'* 功  能：取得指定ID人员信息
'* 参  数：Long                         人员ID
'*       ：PeopleInfo(OUT)              人员信息
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Public Function GetSinglePeopleInfo(ByVal peopleId As Long, _
                ByRef singlePeopleInfo As PeopleInfo) As Boolean
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
   
    '生成SQL
    sql = "SELECT * FROM people WHERE peopleId=" & CStr(peopleId)
    
    '初始化返回值
    GetSinglePeopleInfo = False
    
    '执行查询
    On Error Resume Next
    Set rs = g_dbconn.Execute(sql)
    If Not rs.EOF Then
        singlePeopleInfo.peopleId = rs("peopleId")
        singlePeopleInfo.peopleName = rs("peopleName")
        singlePeopleInfo.groupid = rs("groupId")
        singlePeopleInfo.sex = rs("sex")
        singlePeopleInfo.companyName = rs("companyName")
        singlePeopleInfo.companyDepartment = rs("companyDepartment")
        singlePeopleInfo.appointment = rs("appointment")
        singlePeopleInfo.companyAddress = rs("companyAddress")
        singlePeopleInfo.companyPostcode = rs("companyPostcode")
        singlePeopleInfo.companyPhone = rs("companyPhone")
        singlePeopleInfo.companyFax = rs("companyFax")
        singlePeopleInfo.compnaywebsite = rs("compnaywebsite")
        singlePeopleInfo.familyAddress = rs("familyAddress")
        singlePeopleInfo.familyPostcode = rs("familyPostcode")
        singlePeopleInfo.familyPhone = rs("familyPhone")
        singlePeopleInfo.mobilePhone = rs("mobilePhone")
        singlePeopleInfo.homepage = rs("homepage")
        singlePeopleInfo.email = rs("email")
        singlePeopleInfo.emailbak = rs("emailbak")
        singlePeopleInfo.MSN = rs("MSN")
        singlePeopleInfo.QQ = rs("QQ")
        singlePeopleInfo.QQbak = rs("QQbak")
        singlePeopleInfo.otherInfo = rs("otherInfo")
        
        rs.Close
        Set rs = Nothing
        
        '设定返回值
        GetSinglePeopleInfo = True
    End If
End Function
                
'***********************************************************************
'* 函数名：AppendPhoto
'* 功  能：追加像片信息
'* 参  数：GroupInfo                    组信息
'* 返回值：Boolean              true    追加成功
'*       ：                     false   追加失败
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Public Function AppendPhoto(ByRef newPhotoInfo As PhotoInfo) As Boolean
    '参数检查
    If IsNull(newPhotoInfo.photoFile) Or _
        IsEmpty(newPhotoInfo.photoFile) Or _
        newPhotoInfo.photoFile = "" Or _
        newPhotoInfo.peopleId <= 0 Then
        AppendPhoto = False
        Exit Function
    End If
    
    '变量定义
    Dim sql As String       'SQL
    Dim affectLines As Long '影响行数
   
    '生成SQL
    sql = "INSERT INTO photo(peopleId, photoFile) VALUES(" & _
        CStr(newPhotoInfo.peopleId) & ",'" & newPhotoInfo.photoFile & "')"
    
    '执行插入
    On Error GoTo ERREND
    g_dbconn.Execute sql, affectLines
    If affectLines = 1 Then
        AppendPhoto = True
    Else
        AppendPhoto = False
    End If
    Exit Function
    
ERREND:
    AppendPhoto = False
End Function

'***********************************************************************
'* 函数名：GetPeoplePhoto
'* 功  能：取得指定联系人像片信息
'* 参  数：Long                         联系人ID
'*       ：PhotoInfo()(OUT)             像片信息数组
'* 返回值：Boolean              true    取得成功
'*       ：                     false   取得失败
'* 版  本：2005.12.16 颜志军 初版
'***********************************************************************
Public Function GetPeoplePhoto(ByVal peopleId As Long, _
        ByRef photoArray() As PhotoInfo) As Boolean
    '初始化返回值
    GetPeoplePhoto = False
    
    '参数检查
    If peopleId <= 0 Then
        Exit Function
    End If
    
    '变量定义
    Dim sql As String           'SQL
    Dim rs As ADODB.Recordset   '记录集
    Dim iLoop As Integer        '循环变量
    
    '生成SQL
    sql = "SELECT * FROM photo WHERE peopleId=" & CStr(peopleId)
    
    '执行查询
    On Error Resume Next
    Set rs = g_dbconn.Execute(sql)
    GetPeoplePhoto = True
    If Not rs.EOF Then
        ReDim photoArray(rs.RecordCount)
        iLoop = 0
        Do While Not rs.EOF
            photoArray(iLoop).peopleId = rs("peopleId")
            photoArray(iLoop).photoFile = rs("photoFile")
            photoArray(iLoop).photoId = rs("photoId")
            iLoop = iLoop + 1
            rs.MoveNext
        Loop
    End If
End Function