modbuddy.bas

计算机网络与通信的知识

Attribute VB_Name = "modBuddy"
Option Explicit
'好友数据类型
Public Type BuddyNode
    strAccount As String
    strName As String
    strSex As String
    strFancy As String
End Type
'定义好友序列动态数组
Public arrayBuddy() As BuddyNode
Public intAllBuddyNum As Integer  '好友的合计数

'====================================
' 初始化好友列表
'====================================
Public Sub InitBuddyList(ByVal ltwTp As ListView)
Dim obtDBs As Database
Dim obtRst As Recordset
Dim intTp As Integer

Set obtDBs = OpenDatabase(App.Path + "\sys.mdb")
Set obtRst = obtDBs.OpenRecordset("buddy")
If obtRst.EOF Then Exit Sub
intAllBuddyNum = 0
ReDim arrayBuddy(0)
While Not obtRst.EOF
    intAllBuddyNum = intAllBuddyNum + 1
    ReDim Preserve arrayBuddy(intAllBuddyNum)
    With arrayBuddy(intAllBuddyNum)
        .strAccount = obtRst.Fields("account")
        .strName = obtRst.Fields("name")
        .strSex = obtRst.Fields("sex")
        .strFancy = obtRst.Fields("fancy")
    End With
    If Not obtRst.EOF Then obtRst.MoveNext
Wend
For intTp = 1 To intAllBuddyNum
    ltwTp.ListItems.Add , "lst" + CStr(intTp), arrayBuddy(intTp).strName, , GetSmallIcon(intTp)
Next intTp
ltwTp.ColumnHeaders.Item(1).Text = "  我的好友(" + CStr(intAllBuddyNum) + ")"
Set obtRst = Nothing
Set obtDBs = Nothing
End Sub
'==========================
' 产生图标号
'==========================
Public Function GetSmallIcon(ByVal intNum As Integer) As Integer
Dim intTp As Integer
intTp = 1
If arrayBuddy(intNum).strSex = "女" Then intTp = 10
Randomize   ' 对随机数生成器做初始化的动作。
GetSmallIcon = Int((9 * Rnd) + intTp)
End Function
'=====================
'从数据库中删除好友
'=====================
Public Sub DeleteBuddy(ByVal strAccount As String)
Dim obtDBs As Database
Set obtDBs = OpenDatabase(App.Path + "\sys.mdb")
obtDBs.Execute "DELETE * FROM buddy WHERE account= '" + strAccount + "'", dbFailOnError
Set obtDBs = Nothing
End Sub
'=====================
'数据库中增加好友
' 成功返回 True
'=====================
Public Function AddBuddy(ByVal strAccount As String, _
                          strName As String, _
                          strSex As String, _
                          strFancy As String) As Boolean
Dim obtDBs As Database
Dim obtQdf As QueryDef
Dim obtRst As Recordset

Set obtDBs = OpenDatabase(App.Path + "\sys.mdb")
Set obtQdf = obtDBs.CreateQueryDef("", "SELECT account FROM buddy WHERE account = '" + strAccount + "'")
Set obtRst = obtQdf.OpenRecordset
If obtRst.EOF Then
    Set obtRst = Nothing
    Set obtQdf = Nothing
    obtDBs.Execute "INSERT INTO buddy (account,name,sex,fancy) VALUES ('" + _
                                     strAccount + "','" + strName + "','" + strSex + "','" + strFancy + "')"
    Set obtDBs = Nothing
    AddBuddy = True
Else
    Set obtRst = Nothing
    Set obtDBs = Nothing
    AddBuddy = False
End If
End Function
'================================
'获取用户登录时的用户号、密码、IP
'================================
Public Sub GetLoginMsg()
Dim obtDBs As Database
Dim obtRst As Recordset
Set obtDBs = OpenDatabase(App.Path + "\sys.mdb")
Set obtRst = obtDBs.OpenRecordset("me")
strLoginAccount = obtRst!account
strLoginPwd = obtRst!pwd
strLoginIP = obtRst!ip
Set obtRst = Nothing
Set obtDBs = Nothing
End Sub
'================================
'保存用户登录时的用户号、密码、IP
'================================
Public Sub SetLoginMsg()
Dim obtDBs As Database
Dim obtRst As Recordset
Set obtDBs = OpenDatabase(App.Path + "\sys.mdb")
Set obtRst = obtDBs.OpenRecordset("me")
obtRst.Edit
obtRst!account = strLoginAccount
obtRst!pwd = strLoginPwd
obtRst!ip = strLoginIP
obtRst.Update
Set obtRst = Nothing
Set obtDBs = Nothing
End Sub