getinfo.frm

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

VERSION 5.00
Begin VB.Form frmGetInfo 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 6.5 Example - Get Info"
   ClientHeight    =   3480
   ClientLeft      =   1095
   ClientTop       =   1500
   ClientWidth     =   4980
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3480
   ScaleWidth      =   4980
   Begin VB.TextBox txtStatus 
      BackColor       =   &H00C0C0C0&
      Height          =   285
      Left            =   0
      TabIndex        =   5
      Text            =   "Select the options you want to include."
      Top             =   3180
      Width           =   4965
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3540
      TabIndex        =   4
      Top             =   2730
      Width           =   1335
   End
   Begin VB.CommandButton cmdGetInfo 
      Caption         =   "&Get Info"
      Height          =   375
      Left            =   3540
      TabIndex        =   3
      Top             =   360
      Width           =   1335
   End
   Begin VB.CommandButton cmdSelection 
      Caption         =   "&Unselect All"
      Height          =   375
      Index           =   1
      Left            =   3540
      TabIndex        =   2
      Top             =   1800
      Width           =   1335
   End
   Begin VB.CommandButton cmdSelection 
      Caption         =   "&Select All"
      Height          =   375
      Index           =   0
      Left            =   3540
      TabIndex        =   1
      Top             =   1320
      Width           =   1335
   End
   Begin VB.ListBox lstGetInfoData 
      Height          =   2790
      Left            =   120
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   330
      Width           =   3255
   End
   Begin VB.Label lblGetInfo 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "SQLGetInfo Options:"
      Height          =   195
      Left            =   120
      TabIndex        =   6
      Top             =   90
      Width           =   1470
   End
End
Attribute VB_Name = "frmGetInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdGetInfo_Click()
    Dim intSelCount As Integer     'count of selected items
    Dim I As Integer, j As Integer
    
    Dim ri As Integer
    Dim rs As String * 255
    Dim rb As Long, rl As Long

    Dim lngInfoValue As Long
    Dim lngInfoValueMax As Integer, intInfoValue As Integer, intResult As Integer
    Dim intConnIndex As Integer
    Dim strTemp As String, strID As String, strErrMsg As String
    Dim strRowData() As String
    
    lngInfoValueMax = 255
    
    'Get the number of rows selected and the type of data
    intSelCount = 0
    For I = 0 To lstGetInfoData.ListCount - 1
        If lstGetInfoData.Selected(I) Then
            ReDim Preserve strRowData(intSelCount + 1)
            strRowData(intSelCount) = lstGetInfoData.List(I)
            intSelCount = intSelCount + 1
        End If
    Next
    
    If intSelCount = 0 Then
        MsgBox "No attributes were selected. Please select at least one and try again.", vbExclamation
        Exit Sub
    End If
    
    'Start by clearing the frmODBC grid
    With frmODBC.grdResults
        .Rows = intSelCount + 1: .Cols = 3
        .FixedCols = 1: .FixedRows = 1
        .ColWidth(0) = 8
        .ColWidth(1) = 0.45 * frmODBC.grdResults.Width
        .ColWidth(2) = 0.55 * frmODBC.grdResults.Width
        .Row = 0
        .Col = 1: .text = "Attribute Constant"
        .Col = 2: .text = "Value"
    End With
    frmODBC.lblGrid.Caption = frmODBC.lstODBCdbs.text & " " & "Properties"
    
    For I = 0 To intSelCount - 1
        With frmODBC.grdResults
            .Row = I + 1
            .Col = 0: .text = I + 1
            .Col = 1: .text = strRowData(I)
            .Col = 2
        End With
        
        'Get the index of ODBConn - have to do it this way
        'because there are gaps in the ODBC constants
        For j = LBound(ODBCGetInfo) To UBound(ODBCGetInfo)
            If strRowData(I) = ODBCGetInfo(j).InfoType Then Exit For
        Next
        
        'Format the data according the return type of
        'ODBCGetInfo
        Select Case Left$(ODBCGetInfo(j).ReturnType, 1)
            Case "S"    'String
                intResult = SQLGetInfo(glng_hDbc, j, ByVal rs, Len(rs), intInfoValue)
                If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
                    frmODBC.grdResults.text = SpecialStr(strRowData(I), Trim$(rs))
                Else
                    frmODBC.grdResults.text = Trim$(rs)
                End If
            Case "B"    '32-bit Bitmask
                intResult = SQLGetInfo(glng_hDbc, j, rb, 255, intInfoValue)
                frmODBC.grdResults.text = BitMask(rb)
            Case "I"    'Integer
                intResult = SQLGetInfo(glng_hDbc, j, ri, 255, intInfoValue)
                If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
                    frmODBC.grdResults.text = SpecialInt(strRowData(I), Trim$(ri))
                Else
                    frmODBC.grdResults.text = ri
                End If
            Case "L"    'Long
                intResult = SQLGetInfo(glng_hDbc, j, rl, 255, intInfoValue)
                If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
                    frmODBC.grdResults.text = SpecialLong(strRowData(I), Trim$(rl))
                Else
                    frmODBC.grdResults.text = rl
                End If
            Case Else
                'Error in array
                frmODBC.grdResults.text = "Error processing return value."
        End Select
        If intResult <> SQL_SUCCESS Then
            frmODBC.grdResults.text = "Error getting data."
        End If
    Next
    frmODBC.grdResults.Visible = True
    Unload Me
End Sub

Private Sub cmdSelection_Click(Index As Integer)
    'Select all of the items in the list
    Dim I As Integer
    For I = 0 To lstGetInfoData.ListCount - 1
        lstGetInfoData.Selected(I) = (Index > -1)
    Next
End Sub

Private Sub Form_Load()
    'Load the list box with the ODBCGetInfo array
    Dim I As Integer
    For I = 0 To SQL_INFO_LAST
        If ODBCGetInfo(I).InfoType <> "" Then
            lstGetInfoData.AddItem ODBCGetInfo(I).InfoType
        End If
    Next
    frmGetInfo.Show
End Sub

Private Function SpecialStr(Opt As String, RetStr As String)
    'Do any special processing required for a SQLGetInfo string
    Select Case Opt
        Case "SQL_ODBC_SQL_OPT_IEF"
            SpecialStr = IIf(RetStr = "Y", "Yes", "No")
        Case "SQL_COLUMN_ALIAS"
            SpecialStr = IIf(RetStr = "Y", "Yes", "No")
        Case "SQL_KEYWORDS"
            SpecialStr = "List of keywords."        '&&&
        Case "SQL_ORDER_BY_COLUMNS_IN_SELECT"
            SpecialStr = IIf(RetStr = "Y", "Yes", "No")
        Case "SQL_MAX_ROW_SIZE_INCLUDES_LONG"
            SpecialStr = IIf(RetStr = "Y", "Yes", "No")
        Case "SQL_EXPRESSIONS_IN_ORDERBY"
            SpecialStr = IIf(RetStr = "Y", "Yes", "No")
        Case "SQL_MULT_intResult_SETS"
            SpecialStr = IIf(RetStr = "Y", "Yes", "No")
        Case "SQL_OUTER_JOINS"
            Select Case RetStr
                Case "N"
                    SpecialStr = "No outer joins."
                Case "Y"
                    SpecialStr = "Yes, left-right segregation."
                Case "P"