register.frm

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

VERSION 5.00
Begin VB.Form frmODBC 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 6.3 Example"
   ClientHeight    =   2700
   ClientLeft      =   1320
   ClientTop       =   2490
   ClientWidth     =   8235
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2700
   ScaleWidth      =   8235
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCreateDSN 
      Caption         =   "&New Data Source"
      Height          =   495
      Left            =   5010
      TabIndex        =   8
      Top             =   2070
      Width           =   1455
   End
   Begin VB.Frame fraRegister 
      BackColor       =   &H00C0C0C0&
      Caption         =   "New Data Source"
      Height          =   1815
      Left            =   150
      TabIndex        =   10
      Top             =   90
      Width           =   4695
      Begin VB.TextBox txtDSNdesc 
         Height          =   285
         Left            =   1800
         TabIndex        =   3
         Top             =   840
         Width           =   2655
      End
      Begin VB.TextBox txtDSNname 
         Height          =   285
         Left            =   1800
         TabIndex        =   1
         Top             =   360
         Width           =   2655
      End
      Begin VB.ComboBox cboODBCdrivers 
         Height          =   315
         Left            =   1800
         Sorted          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   1320
         Width           =   2655
      End
      Begin VB.Label lblRegister 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Select ODBC Driver:"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   4
         Top             =   1320
         Width           =   1575
      End
      Begin VB.Label lblRegister 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Description:"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   2
         Top             =   840
         Width           =   1575
      End
      Begin VB.Label lblRegister 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Name:"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   0
         Top             =   360
         Width           =   1575
      End
   End
   Begin VB.CommandButton cmdQuit 
      Caption         =   "&Quit"
      Height          =   495
      Left            =   6630
      TabIndex        =   9
      Top             =   2070
      Width           =   1455
   End
   Begin VB.ListBox lstODBCdbs 
      BackColor       =   &H00C0C0C0&
      Height          =   1425
      Left            =   4950
      Sorted          =   -1  'True
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   480
      Width           =   3135
   End
   Begin VB.Label lblRegister 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Installed ODBC Data Sources:"
      Height          =   255
      Index           =   3
      Left            =   4950
      TabIndex        =   6
      Top             =   180
      Width           =   2535
   End
End
Attribute VB_Name = "frmODBC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Dynamic arrays to hold data
Dim strDBNames() As String
Dim strDBDescs() As String
Dim strDvrDescs() As String
Dim strDvrAttrs() As String

Private Sub cmdCreateDSN_Click()
    CreateNewDSN
End Sub

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub Form_Load()
    'Allocate the ODBC environment handle
    If SQLAllocEnv(glng_hEnv) = SQL_SUCCESS Then
        'Load the current list of data sources to list box
        GetODBCdbs
        'Get the list of installed drivers
        GetODBCdvrs
        cboODBCdrivers.ListIndex = 0
        frmODBC.Show
        txtDSNname.SetFocus
    End If
End Sub

Private Sub GetODBCdbs()
    Dim varTemp As Variant, I As Integer
    
    lstODBCdbs.Clear
    'Call the ODBCDSNList function in ODBC API Declarations.BAS.
    varTemp = ODBCDSNList(glng_hEnv, True)
    
    'If the ODBCDSNList function returns an array, populate
    'the list box.
    If IsArray(varTemp) Then
        For I = LBound(varTemp) To UBound(varTemp)
            lstODBCdbs.AddItem varTemp(I)
        Next
    End If
End Sub

Private Sub GetODBCdvrs()
    Dim varTemp As Variant, I As Integer
    
    cboODBCdrivers.Clear
    varTemp = ODBCDriverList(glng_hEnv, True)
    
    'If the ODBCDriverList function returns an array,
    'populate the list box.  If not, let the user know.
    If IsArray(varTemp) Then
        For I = LBound(varTemp) To UBound(varTemp)
            cboODBCdrivers.AddItem varTemp(I)
        Next
    Else
        MsgBox "No ODBC drivers installed or available.", vbExclamation
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intResult As Integer
    
    'Clean up the ODBC connections that we allocated
    'and opened.
    intResult = ODBCDisconnectDS(glng_hEnv, glng_hDbc, glng_hStmt)
    intResult = SQLFreeEnv(glng_hEnv)
End Sub

Sub CreateNewDSN()
    'Add a new data source name to the ODBC system
    Dim strDSNname As String, strDSNattr As String, strDSNdriver As String
    Dim intResult As Integer, intSaveCursor As Integer
    
    If txtDSNname = "" Then
        MsgBox "You must enter a name for the new data source."
        txtDSNname.SetFocus
    Else
        intSaveCursor = Screen.MousePointer
        Screen.MousePointer = vbHourglass

        'Format the arguments to RegisterDatabase
        strDSNname = txtDSNname.text
        strDSNattr = "Description=" & txtDSNdesc.text
        strDSNdriver = cboODBCdrivers.List(cboODBCdrivers.ListIndex)
    
        On Error GoTo CantRegister
            'Trap any errors so we can respond to them
            DBEngine.RegisterDatabase strDSNname, strDSNdriver, False, strDSNattr
        On Error GoTo 0
        
        'Now, rebuild the list of data source names
        GetODBCdbs
        
        Screen.MousePointer = intSaveCursor
    End If
    
    Exit Sub
    
CantRegister:
    If Err.Number = 3146 Then
        'ODBC couldn't find the setup driver specified
        'for this database in ODBCINST.INI.
        MsgBox "Cannot find driver installation DLL.", vbCritical
        Resume Next
    Else
        MsgBox Err.Number, vbExclamation
    End If
    
End Sub