frmexlusive.frm

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

VERSION 5.00
Begin VB.Form frmExlusive 
   Caption         =   "USER"
   ClientHeight    =   2910
   ClientLeft      =   3600
   ClientTop       =   3195
   ClientWidth     =   1695
   LinkTopic       =   "Form1"
   ScaleHeight     =   2910
   ScaleWidth      =   1695
   Begin VB.CommandButton cmdExit 
      Caption         =   "E&xit"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   2400
      Width           =   1455
   End
   Begin VB.CommandButton cmdCloseDatabase 
      Caption         =   "&Close Database"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   1800
      Width           =   1455
   End
   Begin VB.CommandButton cmdOpenShared 
      Caption         =   "Open &Shared"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   1320
      Width           =   1455
   End
   Begin VB.CommandButton cmdOpenExclusive 
      Caption         =   "Open &Exclusive"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   840
      Width           =   1455
   End
   Begin VB.Label lblDBStatus 
      Alignment       =   2  'Center
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   360
      Width           =   1455
   End
   Begin VB.Label lblDBStatusLabel 
      Alignment       =   2  'Center
      Caption         =   "Database Status"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1455
   End
End
Attribute VB_Name = "frmExlusive"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' this is the database object variable used throughout this project
Private db As Database

' these are private constants used to indicate the desired state of the
' database when opened
Private Const OPEN_EXCLUSIVE = True
Private Const OPEN_SHARED = False


Private Sub Form_Initialize()
    
    ' when the form is initialized, ensure that the proper states of the
    ' command buttons and labels are set by calling the Close Database
    ' command buttons click event
    cmdCloseDatabase_Click

End Sub

Private Sub cmdOpenExclusive_Click()
    
    ' call the OpenDB procedure of this project, passing the OPEN_EXCLUSIVE
    ' constant (this constant holds the value of TRUE)
    OpenDB OPEN_EXCLUSIVE

End Sub

Private Sub cmdOpenShared_Click()
    
    ' call the OpenDB procedure of this project, passing the OPEN_SHARED
    ' constant (this constant holds the value of FALSE)
    OpenDB OPEN_SHARED

End Sub

Private Sub cmdCloseDatabase_Click()
    
    ' set the database object variable to nothing, which is the equivalent
    ' of closing the database
    Set db = Nothing
    
    ' change the label that displays the database status to closed
    lblDBStatus = "CLOSED"
    
    ' only allow the user to open the database and not close it
    cmdOpenExclusive.Enabled = True
    cmdOpenShared.Enabled = True
    cmdCloseDatabase.Enabled = False

End Sub

Private Sub cmdExit_Click()
    
    ' call the close database command button click event to ensure that the
    ' database is closed before we terminate the project
    cmdCloseDatabase_Click
    
    ' end the application by calling Unload
    Unload Me

End Sub

Private Sub OpenDB(bDataMode As Boolean)

' if any error is encountered, call the code specified by the ERR_OpenDB
' label
On Error GoTo ERR_OpenDB:

    Dim sDBName As String
    
    ' on slower machines, this may take a moment, therefore we will change
    ' the mousepointer to an hourglass to indicate that the project is
    ' still working
    Screen.MousePointer = vbHourglass
    
    ' retrieve the database name and path from the ReadINI module
    sDBName = DBPath
    
    ' open the database using the desired data mode specified by the user
    ' if bDataMode = OPEN_EXCLUSIVE then the value of bDataMode is TRUE,
    ' telling the OpenDatabase method to open the database exclusively,
    ' otherwise OPEN_SHARED = FALSE, opening the database in a shared mode
    Set db = dbengine.Workspaces(0).OpenDatabase(sDBName, bDataMode)
    
    ' if we are at this point, then the database was opened succesfully,
    ' now display the appropriate label depending on the data mode selected
    Select Case bDataMode
        
        Case OPEN_EXCLUSIVE:
            lblDBStatus = "OPEN: EXCLUSIVE"
        
        Case OPEN_SHARED:
            lblDBStatus = "OPEN: SHARED"
    
    End Select
    
    ' only allow the user to close that database, and do not allow opening
    ' of the database again
    cmdOpenExclusive.Enabled = False
    cmdOpenShared.Enabled = False
    cmdCloseDatabase.Enabled = True
    
    ' set the mousepointer to the default icon
    Screen.MousePointer = vbDefault

Exit Sub

ERR_OpenDB:

    ' set the mousepointer to the default icon
    Screen.MousePointer = vbDefault
    
    ' call the DatabaseError procedure, passing the Err object which
    ' describes the error that has just occured
    DatabaseError Err
    
End Sub

Private Sub DatabaseError(oErr As ErrObject)

    Dim sMessage As String
    
    ' these are the constant values used to represent the two errors that
    ' we are going to trap in this code
    Const DB_OPEN = 3356    ' database already open in shared mode
    Const DB_IN_USE = 3045  ' database already open exclusively
    
    With oErr
        
        ' select the appropriate code depending upon the error number
        Select Case .Number
            
            ' attempted to open the database exclusively, but it is already
            ' open in shared mode
            Case DB_OPEN:
                sMessage = "You cannot open the database exclusively " _
                         & "becuase it is already opened be another user."
            
            ' attempted to open the database either exclusively or shared,
            ' but it is opened exclusively by another user
            Case DB_IN_USE:
                sMessage = "You cannot open the database because it is " _
                         & "opened exclusively by another user."
            
            ' unexpected error: display the error number and description
            ' for the user
            Case Else
                sMessage = "Error #" & .Number & ": " & .Description
        
        End Select
    
    End With
    
    ' display the message for the user
    MsgBox sMessage, vbExclamation, "DATABASE ERROR"
    
    ' ensure that the database is closed because of the error, and properly
    ' set all the command button enabled properties as well as the status
    ' label
    cmdCloseDatabase_Click

End Sub