frmownership.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Begin VB.Form frmOwnership 
   Caption         =   "Ownership"
   ClientHeight    =   2070
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5730
   LinkTopic       =   "Form1"
   ScaleHeight     =   2070
   ScaleWidth      =   5730
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdSave 
      Caption         =   "&Save Owner"
      Height          =   375
      Left            =   4500
      TabIndex        =   5
      Top             =   780
      Width           =   1095
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Default         =   -1  'True
      Height          =   375
      Left            =   4500
      TabIndex        =   4
      Top             =   300
      Width           =   1095
   End
   Begin VB.ListBox lstUsers 
      Height          =   1620
      Left            =   2340
      TabIndex        =   3
      Top             =   300
      Width           =   1995
   End
   Begin VB.ListBox lstTablesAndQueries 
      Height          =   1620
      Left            =   120
      TabIndex        =   1
      Top             =   300
      Width           =   1995
   End
   Begin VB.Label lblUsers 
      Caption         =   "&Users:"
      Height          =   255
      Left            =   2340
      TabIndex        =   2
      Top             =   60
      Width           =   1935
   End
   Begin VB.Label lblTablesAndQueries 
      Caption         =   "&Tables and Queries:"
      Height          =   255
      Left            =   180
      TabIndex        =   0
      Top             =   60
      Width           =   1935
   End
End
Attribute VB_Name = "frmOwnership"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' form level object variable used to hold the database object
Private db As Database


Private Sub Form_Load()

' if there is an error then goto the code section labeled by ERR_Form_Load
On Error GoTo ERR_Form_Load:

    Dim sUserName As String
    Dim sPassword As String
    Dim sDBName As String
    
    ' assign default user name and password
    sUserName = "Admin"
    sPassword = ""
    
    With DBEngine
        
        ' set system database path and name
        .SystemDB = GetWorkgroupDatabase

        ' set default user name and password
        .DefaultUser = sUserName
        .DefaultPassword = sPassword
    
        ' get path and name of database from ReadINI module
        sDBName = DBPath
    
        ' open database
        Set db = .Workspaces(0).OpenDatabase(sDBName)

    End With
    
    ' populate the two list boxes with the available users, tables, and
    ' queries from database
    FillUserList
    FillTableAndQueriesList
    
    ' if there are no valid users, inform the user and exit the application
    If (lstUsers.ListCount < 1) Then
        
        MsgBox "There are no users!", vbExclamation, "USERS"
        cmdClose_Click
        
    Else
    
        ' initialize the list boxes to point to the first item in each list box
        lstUsers.ListIndex = 0
        lstTablesAndQueries.ListIndex = 0
        
    End If
    
Exit Sub

ERR_Form_Load:

    ' display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With

End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    ' close the database
    Set db = Nothing
    
End Sub

Private Sub FillTableAndQueriesList()
    
    Dim oDocument As Document
    
    ' populate the TableAndQueries list boxes with all the available tables
    ' and queries except the system ones
    For Each oDocument In db.Containers("Tables").Documents
    
        With oDocument
            If (Left$(.Name, 4) <> "MSys") Then _
                    lstTablesAndQueries.AddItem .Name
        End With
        
    Next

End Sub

Private Sub FillUserList()
    
    Dim oUser As User
    
    ' populate the user list boxes with all users except CREATOR and ENGINE
    ' (these shouldn't be changed)
    For Each oUser In DBEngine.Workspaces(0).Users
        
        With oUser
            
            If (UCase$(.Name) <> "CREATOR") _
            And (UCase$(.Name) <> "ENGINE") Then
            
                lstUsers.AddItem .Name
            
            End If
        
        End With
    
    Next
    
End Sub

Private Sub lstTablesAndQueries_Click()

    Dim nCount As Integer
    Dim sCurOwner As String
    
    With lstUsers
        
        ' loop through each user until the owner of the selected table or
        ' query is found
        For nCount = 0 To .ListCount - 1
    
        sCurOwner = _
          db.Containers("Tables").Documents(lstTablesAndQueries.Text).Owner

            If (.List(nCount) = sCurOwner) Then .ListIndex = nCount

        Next nCount
    End With

End Sub

Private Sub cmdSave_Click()

' if there is an error goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:
    
    ' assign the new owner to the select table or query
    db.Containers("Tables").Documents(lstTablesAndQueries.Text).Owner = _
            lstUsers.Text

Exit Sub

ERR_cmdSave_Click:
    
    ' display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With

End Sub

Private Sub cmdClose_Click()

    ' end the application
    Unload Me
    
End Sub