9-3.frm

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Form1 
   Caption         =   "ODBC API 数据访问"
   ClientHeight    =   3735
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5520
   LinkTopic       =   "Form1"
   ScaleHeight     =   3735
   ScaleWidth      =   5520
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Find 
      Caption         =   "查询"
      Height          =   495
      Left            =   600
      TabIndex        =   2
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton Exit 
      Caption         =   "退出"
      Height          =   495
      Left            =   3480
      TabIndex        =   0
      Top             =   3120
      Width           =   1215
   End
   Begin MSFlexGridLib.MSFlexGrid Grid1 
      Height          =   2895
      Left            =   120
      TabIndex        =   1
      Top             =   0
      Width           =   5295
      _ExtentX        =   9340
      _ExtentY        =   5106
      _Version        =   393216
      Rows            =   1
      Cols            =   4
      FixedCols       =   0
      AllowUserResizing=   1
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const SQL_C_CHAR As Long = 1
Const SQL_COLUMN_LABEL As Long = 18
Const SQL_DROP As Long = 1
Const SQL_DRROR As Long = -1
Const SQL_NO_DATA_FOUND As Long = 100
Const SQL_SUCCESS As Long = 0
Private Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer
Private Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv&, phdbcd&) As Integer
Private Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal hdbc&, phstmt&) As Integer
Private Declare Function SQLConnect Lib "odbc32.dll" _
            (ByVal hdbc&, ByVal szDSN$, ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, _
            ByVal szPWD$, ByVal cbPWD%) As Integer
Private Declare Function SQLColAttributes Lib "odbc32.dll" _
            (ByVal hstmt&, ByVal icol%, ByVal fDescType%, ByVal rgbDesc As String, _
            ByVal cbDescMax%, pcbDesc%, pfDesc&) As Integer
Private Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc&) As Integer
Private Declare Function SQLExecDirect Lib "odbc32.dll" _
            (ByVal hstmt&, ByVal szSqlStr$, ByVal cbSqStr&) As Integer
Private Declare Function SQLFetch Lib "odbc32.dll" (ByVal hstmt&) As Integer
Private Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc&) As Integer
Private Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal henv&) As Integer
Private Declare Function SQLFreeStmt Lib "odbc32.dll" _
            (ByVal hstmt&, ByVal fOption%) As Integer
Private Declare Function SQLGetData Lib "odbc32.dll" _
            (ByVal hstmt&, ByVal icol%, ByVal fCType%, ByVal rgbValue As String, _
            ByVal cbValueMax&, pcbValue%) As Integer
Private Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal hstmt&, pccol%) As Integer
Private Declare Function SQLNumResultRows Lib "odbc32.dll" (ByVal hstmt&, pcrow%) As Integer

'ODBC API函数的执行情况
Dim rc As Integer
'环境句柄
Dim henv As Long
'ODBC连接句柄
Dim hdbc As Long
'SQL语句执行句柄
Dim hstmt As Long
'返回数据查询结果
Dim ColVal As String * 255

Private Sub Exit_Click()
    Unload Me
End Sub

Private Sub Find_Click()
    Dim pcblen As Integer
    Dim SQLstmt As String
    Dim i, j As Integer
    Dim Cols As Integer
    Dim Rows As Integer
    Dim Larg As Long
    
    '分配SQL命令执行空间
    If SQLAllocStmt(hdbc, hstmt) Then
        MsgBox "无法执行SQL语句 ！", , "ODBC API执行错误"
        Unload Me
    End If
    SQLstmt = "select * from Demo" '设置SQL命令字符串
    If SQLExecDirect(hstmt, SQLstmt, Len(SQLstmt)) Then
    '执行查询时出错
        MsgBox "执行SQL语句产生错误 ！", , "ODBC API执行错误"
        rc = SQLFreeStmt(hstmt, SQL_DROP)
        Unload Me
    End If
    '获取结果集中的字段数量
    If SQLNumResultCols(hstmt, Cols) Then
        MsgBox "查询结果集中的字段数量错 ！", , "ODBC API执行错误"
        rc = SQLFreeStmt(hstmt, SQL_DROP)
        Unload Me
    End If
    '显示各字段名
    Grid1.Cols = Cols '设置显示列数
    Grid1.Row = 0
    For i = 1 To Cols
        Grid1.Col = i - 1
        '获取字段名
        rc = SQLColAttributes(hstmt, i, SQL_COLUMN_LABEL, ColVal, _
                    Len(ColVal), pcblen, Larg)
        '显示字段名
        '由于BASIC(Left、Right、Len和Mid)函数使用的字符数参数与
        'API函数返回的长度不同,
        '如：字符串"姓名"在API函数中返回长度是4,而BASIC函数返回长度2。
        '必须使用如下循环程序方可正确显示返回值
        For j = 1 To pcblen
            If Asc(Mid(ColVal, j, 1)) = 0 Then '字符串以空字符结尾
                Exit For
            Else
                Grid1.Text = Grid1.Text + Mid(ColVal, j, 1)
            End If
        Next j
    Next i
    j = 1
    Do Until SQLFetch(hstmt) = SQL_NO_DATA_FOUND
        Grid1.Rows = j + 1
        Grid1.Row = j
        '获得第一字段数据
        Grid1.Col = 0 '设置网格字段
        ColVal = String(255, 0) '取得空字符串
        rc = SQLGetData(hstmt, 1, SQL_C_CHAR, ColVal, Len(ColVal), pcblen)
        '以下循环用于正确显示查询结果
        For i = 1 To pcblen
            If Asc(Mid(ColVal, i, 1)) = 0 Then
                Exit For
            Else
                Grid1.Text = Grid1.Text + Mid(ColVal, i, 1)
            End If
        Next i
        '获得第二字段数据
        Grid1.Col = 1
        ColVal = String(255, 0)
        rc = SQLGetData(hstmt, 2, SQL_C_CHAR, ColVal, Len(ColVal), pcblen)
        For i = 1 To pcblen
            If Asc(Mid(ColVal, i, 1)) = 0 Then
                Exit For
            Else
                Grid1.Text = Grid1.Text + Mid(ColVal, i, 1)
            End If
        Next i
        '获得第三字段数据
        Grid1.Col = 2 '设置网格字段
        ColVal = String(255, 0) '取得空字符串
        rc = SQLGetData(hstmt, 3, SQL_C_CHAR, ColVal, Len(ColVal), pcblen)
        For i = 1 To pcblen
            If Asc(Mid(ColVal, i, 1)) = 0 Then
                Exit For
            Else
                Grid1.Text = Grid1.Text + Mid(ColVal, i, 1)
            End If
        Next i
        j = j + 1
    Loop
    rc = SQLFreeStmt(hstmt, SQL_DROP)
End Sub

Private Sub Form_Load()
    '数据源名
    Dim DSN As String
    '用户名
    Dim UID As String
    '用户密码
    Dim PWD As String
    
    '创建ODBC环境空间
    If SQLAllocEnv(henv) Then
        MsgBox "无法初始化ODBC环境 ！", , "ODBC API执行错误"
        Unload Me
    End If
    '创建连接空间
    If SQLAllocConnect(henv, hdbc) Then
        MsgBox "无法连接ODBC ！", , "ODBC API执行错误"
        Unload Me
    End If
    DSN = "Demo"
    UID = "admin"
    PWD = ""
    '建立连接
    '本程序需要有名为“Demo”的ODBC数据源支持
    If SQLConnect(hdbc, DSN, Len(DSN), UID, Len(UID), PWD, Len(PWD)) Then
        MsgBox "无法获得连接句柄 ！", , "ODBC API执行错误"
        Unload Me
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '结束连接
    rc = SQLDisconnect(hdbc)
    '释放连接句柄
    rc = SQLFreeConnect(hdbc)
    '释放ODBC环境
    rc = SQLFreeEnv(henv)
End Sub