services.frm

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

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmODBC 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 6.5 Example - Details"
   ClientHeight    =   4515
   ClientLeft      =   1095
   ClientTop       =   1515
   ClientWidth     =   7050
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4515
   ScaleWidth      =   7050
   Begin MSFlexGridLib.MSFlexGrid grdResults 
      Height          =   2535
      Left            =   90
      TabIndex        =   6
      Top             =   1890
      Visible         =   0   'False
      Width           =   6855
      _ExtentX        =   12091
      _ExtentY        =   4471
      _Version        =   393216
      HighLight       =   0
   End
   Begin VB.CommandButton cmdProperties 
      Caption         =   "Get &Properties"
      Height          =   495
      Left            =   5460
      TabIndex        =   2
      Top             =   330
      Width           =   1455
   End
   Begin VB.CommandButton cmdFunctions 
      Caption         =   "Get &Functions"
      Height          =   495
      Left            =   3840
      TabIndex        =   1
      Top             =   330
      Width           =   1455
   End
   Begin VB.CommandButton cmdQuit 
      Caption         =   "&Quit"
      Height          =   495
      Left            =   5460
      TabIndex        =   3
      Top             =   1080
      Width           =   1455
   End
   Begin VB.ListBox lstODBCdbs 
      BackColor       =   &H00FFFFFF&
      Height          =   1230
      Left            =   90
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   330
      Width           =   3585
   End
   Begin VB.Label lblGrid 
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Properties"
      Height          =   255
      Left            =   90
      TabIndex        =   5
      Top             =   1620
      Width           =   6855
   End
   Begin VB.Label lblServices 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Installed ODBC Data Sources:"
      Height          =   255
      Left            =   90
      TabIndex        =   4
      Top             =   90
      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

Private Sub cmdFunctions_Click()
    Dim strDataSource As String
    Dim strUserName As String, strPassword As String
    Dim intResult As Integer, intErrResult As Integer
    ReDim intFuncList(100) As Integer
    Dim I As Integer, j As Integer

    'First, check to see if anything is selected
    'If not, notify user then return to form.
    If lstODBCdbs.ListIndex >= 0 Then
        
        strDataSource = lstODBCdbs.List(lstODBCdbs.ListIndex)
        
        If SQLAllocStmt(glng_hDbc, glng_hStmt) Then _
            intResult = ODBCConnectDS(glng_hEnv, glng_hDbc, glng_hStmt, strDataSource, strUserName, strPassword)
            
        If intResult = SQL_SUCCESS Then _
            intResult = SQLGetFunctions(glng_hDbc, SQL_API_ALL_FUNCTIONS, intFuncList(0))
            
        If intResult <> SQL_SUCCESS Then
            intErrResult = frmODBCErrors.ODBCError("Dbc", glng_hEnv, glng_hDbc, 0, intResult, "Error getting list of ODBC functions")
        Else
            'Run through the array and get the number of functions
            j = 0
            For I = 0 To 99
                If intFuncList(I) Then j = j + 1
            Next
        
            'Start by clearing the frmODBC grid
            With frmODBC.grdResults
                .Rows = j
                .Cols = 3
                .FixedCols = 1
                .FixedRows = 0
                .ColWidth(0) = 8
                .ColWidth(1) = 0.65 * frmODBC.grdResults.Width
                .ColWidth(2) = 0.35 * frmODBC.grdResults.Width
            End With
            
            lblGrid.Caption = lstODBCdbs.text & ": " & Trim(Val(j)) & " Functions"
            
            'Populate the grid with the function names
            j = 0
            For I = 0 To 99
                If intFuncList(I) <> 0 Then
                    With frmODBC.grdResults
                        .Row = j
                        .Col = 0: .text = j
                        .Col = 1: .text = ODBCFuncs(0, I)
                        .Col = 2: .text = ODBCFuncs(1, I)
                    End With
                    j = j + 1
                End If
            Next
        
            'Move to the top row
            frmODBC.grdResults.Row = 0
            frmODBC.grdResults.Col = 1
            
            'free the data source connection
            intResult = ODBCDisconnectDS(glng_hEnv, glng_hDbc, SQL_NULL_HSTMT)
        
            frmODBC.grdResults.Visible = True
        End If
    Else
        MsgBox "Please select a data source name first.", vbCritical, "ODBC Functions"
    End If
End Sub

Private Sub cmdProperties_Click()
    Dim intResult As Integer
    If lstODBCdbs.ListIndex < 0 Then
        MsgBox "Please select a data source name first.", vbCritical, "ODBC Properties"
    Else
        intResult = ODBCConnectDS(glng_hEnv, glng_hDbc, glng_hStmt, lstODBCdbs.text, "", "")
        If intResult = SQL_SUCCESS Then Load frmGetInfo
    End If
End Sub

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub Form_Load()
    'Log on to an ODBC data source
    'First, allocate ODBC memory and get handles
    Dim intResult As Integer
    
    'Allocate the ODBC environment handle
    If ODBCAllocateEnv(glng_hEnv) = SQL_SUCCESS Then
        'Load the current list of data sources to list box
        GetODBCdbs
        'Show the form
        frmODBC.Show
    Else
        End
    End If
End Sub

Private Sub GetODBCdbs()
    Dim varTemp As Variant, I As Integer
    
    lstODBCdbs.Clear
    varTemp = ODBCDSNList(glng_hEnv, False)
    
    If IsArray(varTemp) Then
        ReDim strDBNames(LBound(varTemp) To UBound(varTemp))
        For I = LBound(varTemp) To UBound(varTemp)
            lstODBCdbs.AddItem varTemp(I)
            strDBNames(I) = varTemp(I)
        Next
    Else
        MsgBox "No ODBC data sources to load!", vbCritical
        End
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim intResult As Integer
    
    intResult = ODBCDisconnectDS(glng_hEnv, glng_hDbc, glng_hStmt)
    intResult = SQLFreeEnv(glng_hEnv)
End Sub

Private Function convCh(inChar As String, num As Integer)
    inChar = LTrim$(Left$(inChar, num))

    Select Case inChar
        Case "Y"
            convCh = "Yes"
        Case "N"
            convCh = "No"
        Case Else
            convCh = inChar
    End Select

End Function