odbc api declarations.bas

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

    
    Do Until intResult = SQL_NO_DATA_FOUND
        'Blank out the DSN string with null characters
        strDSN = String(33, 0)
        'Fetch the data sources via the SQLDataSources command
        'Note that the SQL_FETCH_NEXT option will fetch the first
        'data source the first time SQLDataSources() is called.
        intResult = SQLDataSources(glng_hEnv, SQL_FETCH_NEXT, strDSN, intDSNMaxLen, lngDSN, strDescription, intDescMaxLen, lngDesc)
        If intResult = SQL_ERROR Then
            intErrResult = frmODBCErrors.ODBCError("Env", glng_hEnv, 0, 0, intResult, "Error getting list of data sources.")
            Exit Function
        End If
        
        'Add the data source data to the global arrays
        If Left(strDSN, 5) <> String(5, 0) Then
            If blnIncDesc Then
                strTemp = Left(strDSN, lngDSN) & " (" & Left(strDescription, lngDesc) & ")"
            Else
                strTemp = Left(strDSN, lngDSN)
            End If
            ReDim Preserve strDSNList(0 To I)
            strDSNList(I) = strTemp
            I = I + 1
        End If
    Loop
    
    ODBCDSNList = strDSNList
End Function
Public Function ODBCDriverList(lng_hEnv As Long, blnIncAttr As Boolean) As Variant
    Dim strDriverDesc As String * 512, strDriverAttr As String * 2048
    Dim intDriverDescsMax As Integer, lngDriverDesc As Integer
    Dim lngDriverAttr As Integer, intDriverAttrMax As Integer
    Dim intResult As Integer, intErrResult As Integer, intSaveCursor As Integer
    Dim strDriverList() As String, strTemp As String
    Dim I As Integer
    
    'Prep our variables
    intDriverDescsMax = 512: intDriverAttrMax = 2048
    intResult = SQL_SUCCESS: I = 0

        
    Do Until intResult = SQL_NO_DATA_FOUND
        strDriverDesc = String(512, 0)
        intResult = SQLDrivers(glng_hEnv, SQL_FETCH_NEXT, strDriverDesc, intDriverDescsMax, lngDriverDesc, strDriverAttr, intDriverAttrMax, lngDriverAttr)
        If intResult = SQL_ERROR Then
            intErrResult = frmODBCErrors.ODBCError("Env", glng_hEnv, 0, 0, intResult, "Error getting list of registered drivers.")
            Exit Function
        End If

        If Left(strDriverDesc, 5) <> String(5, 0) Then
            If blnIncAttr Then
                strTemp = Left(strDriverDesc, lngDriverDesc) & _
                    " (" & Left(strDriverAttr, lngDriverAttr) & ")"
            Else
                strTemp = Left(strDriverDesc, lngDriverDesc)
            End If
            ReDim Preserve strDriverList(I)
            strDriverList(I) = strTemp
            I = I + 1
        End If
    Loop
    
    
    ODBCDriverList = strDriverList
End Function
Function ODBCAllocateEnv(hEnv As Long)

    Dim intResult As Integer, intPointer As Integer
    ODBCLoadFuncs
    LoadGetInfo
    ODBCAllocateEnv = SQL_SUCCESS

    intResult = SQLAllocEnv(hEnv)
    
    If intResult <> SQL_SUCCESS Then
        ODBCAllocateEnv = intResult
        intResult = frmODBCErrors.ODBCError("Env", hEnv, 0, 0, intResult, "Environment Allocation Error")
        ODBCAllocateEnv = intResult
    End If
    
End Function
Function ODBCConnectDriver(hDbc As Long, hStmt As Long, Server As String)
    'Establish a connection using SQLDriverConnect
    Dim result As Integer
    Dim S As String
    Dim cbOut As Integer, rc As Integer
    Dim saveCursor
    
    
    ODBCConnectDriver = SQL_SUCCESS
    
    result = SQLAllocConnect(glng_hEnv, hDbc)
    If result <> SQL_SUCCESS Then
        ODBCConnectDriver = result
        result = frmODBCErrors.ODBCError("Dbc", glng_hEnv, hDbc, 0, result, "Error allocating hDbc connection handle.")
        Exit Function
    End If
     
    result = SQLDriverConnect(hDbc, GetParent(GetFocus()), S$, Len(S$), Server, Len(Server), cbOut%, SQL_DRIVER_COMPLETE)
    If result <> SQL_SUCCESS Then
        ODBCConnectDriver = result
        result = frmODBCErrors.ODBCError("Dbc", glng_hEnv, hDbc, 0, result, "Error connecting to driver.")
        Exit Function
    End If
    
    result = SQLAllocStmt(hDbc, hStmt)
    If result <> SQL_SUCCESS Then
        ODBCConnectDriver = result
        result = frmODBCErrors.ODBCError("Dbc", glng_hEnv, hDbc, 0, result, "Error allocating statement handle.")
        Exit Function
    End If

End Function

Function ODBCConnectDS(hEnv As Long, hDbc As Long, hStmt As Long, DataSource As String, UserID As String, Password As String) As Integer
    Dim result As Integer
    Dim saveCursor
   
    ODBCConnectDS = SQL_SUCCESS
    
    result = SQLAllocConnect(hEnv, hDbc)
    If result <> SQL_SUCCESS Then
        ODBCConnectDS = result
        result = frmODBCErrors.ODBCError("Dbc", hEnv, hDbc, 0, result, "Error allocating connection handle.")
        Exit Function
    End If
  
    result = SQLConnect(hDbc, DataSource, Len(DataSource), UserID, Len(UserID), Password, Len(Password))
    If result <> SQL_SUCCESS And result <> SQL_SUCCESS_WITH_INFO Then
        ODBCConnectDS = result
        result = frmODBCErrors.ODBCError("Dbc", hEnv, hDbc, 0, result, "Error connecting to data source.")
        Exit Function
    End If
  
    result = SQLAllocStmt(hDbc, hStmt)
    If result <> SQL_SUCCESS Then
        ODBCConnectDS = result
        result = frmODBCErrors.ODBCError("Dbc", hEnv, hDbc, 0, result, "Error allocating statement handle.")
        Exit Function
    End If
  
End Function

Function ODBCDisconnectDS(hEnv As Long, hDbc As Long, hStmt As Long) As Integer
    Dim result As Integer
    Dim saveCursor

    ODBCDisconnectDS = SQL_SUCCESS
       
    If hStmt <> 0 Then
        result = SQLFreeStmt(hStmt, SQL_DROP)
        If result <> SQL_SUCCESS Then
            ODBCDisconnectDS = result
            result = frmODBCErrors.ODBCError("Env", hEnv, 0, 0, result, "Environment Allocation Error")
        End If
    End If

    If hDbc <> 0 Then
        result = SQLDisconnect(hDbc)
        If result <> SQL_SUCCESS Then
            ODBCDisconnectDS = result
            result = frmODBCErrors.ODBCError("Env", hEnv, 0, 0, result, "Environment Allocation Error")
        End If
    End If

    If hDbc <> 0 Then
        result = SQLFreeConnect(hDbc)
        If result <> SQL_SUCCESS Then
            ODBCDisconnectDS = result
            result = frmODBCErrors.ODBCError("Env", hEnv, 0, 0, result, "Environment Allocation Error")
        End If
    End If
    
End Function

Function ODBCFreeEnv(hEnv As Long) As Integer
    Dim result As Integer
  
    ODBCFreeEnv = True
  
    If hEnv <> 0 Then
        result = SQLFreeEnv(hEnv)
        If result <> SQL_SUCCESS Then
            ODBCFreeEnv = False
        End If
    End If

End Function

Private Sub ODBCLoadFuncs()
    'load the ODBC API function names into the ODBCFuncs array
    Dim I As Integer
    
    'Core ODBC API functions
    ODBCFuncs(0, 1) = "SQLAllocConnect"
    ODBCFuncs(0, 2) = "SQLAllocEnv"
    ODBCFuncs(0, 3) = "SQLAllocStmt"
    ODBCFuncs(0, 4) = "SQLBindCol"
    ODBCFuncs(0, 5) = "SQLCancel"
    ODBCFuncs(0, 6) = "SQLColAttributes"
    ODBCFuncs(0, 7) = "SQLConnect"
    ODBCFuncs(0, 8) = "SQLDescribeCol"
    ODBCFuncs(0, 9) = "SQLDisconnect"
    ODBCFuncs(0, 10) = "SQLError"
    ODBCFuncs(0, 11) = "SQLExecDirect"
    ODBCFuncs(0, 12) = "SQLExecute"
    ODBCFuncs(0, 13) = "SQLFetch"
    ODBCFuncs(0, 14) = "SQLFreeConnect"
    ODBCFuncs(0, 15) = "SQLFreeEnv"
    ODBCFuncs(0, 16) = "SQLFreeStmt"
    ODBCFuncs(0, 17) = "SQLGetCursorName"
    ODBCFuncs(0, 18) = "SQLNumResultCols"
    ODBCFuncs(0, 19) = "SQLPrepare"
    ODBCFuncs(0, 20) = "SQLRowCount"
    ODBCFuncs(0, 21) = "SQLSetCursorName"
    ODBCFuncs(0, 22) = "SQLSetParam"
    ODBCFuncs(0, 23) = "SQLTransact"
    For I = 1 To 23
        ODBCFuncs(1, I) = "Core"
    Next

    'Level 1 ODBC API Functions
    ODBCFuncs(0, 40) = "SQLColumns"
    ODBCFuncs(0, 41) = "SQLDriverConnect"
    ODBCFuncs(0, 42) = "SQLGetConnectOption"
    ODBCFuncs(0, 43) = "SQLGetData"
    ODBCFuncs(0, 44) = "SQLGetFunctions"
    ODBCFuncs(0, 45) = "SQLGetInfo"
    ODBCFuncs(0, 46) = "SQLGetStmtOption"
    ODBCFuncs(0, 47) = "SQLGetTypeInfo"
    ODBCFuncs(0, 48) = "SQLParamData"
    ODBCFuncs(0, 49) = "SQLPutData"
    ODBCFuncs(0, 50) = "SQLSetConnectOption"
    ODBCFuncs(0, 51) = "SQLSetStmtOption"
    ODBCFuncs(0, 52) = "SQLSpecialColumns"
    ODBCFuncs(0, 53) = "SQLStatictics"
    ODBCFuncs(0, 54) = "SQLTables"
    For I = 40 To 54
        ODBCFuncs(1, I) = "Level 1"
    Next
    
    'Level 2 ODBC API Functions
    ODBCFuncs(0, 55) = "SQLBrowseConnect"
    ODBCFuncs(0, 56) = "SQLColumnPrivileges"
    ODBCFuncs(0, 57) = "SQLDataSources"
    ODBCFuncs(0, 58) = "SQLDescribeParam"
    ODBCFuncs(0, 59) = "SQLExtendedFetch"
    ODBCFuncs(0, 60) = "SQLForeignKeys"
    ODBCFuncs(0, 61) = "SQLMoreResults"
    ODBCFuncs(0, 62) = "SQLNativeSQL"
    ODBCFuncs(0, 63) = "SQLNumParams"
    ODBCFuncs(0, 64) = "SQLParamOptions"
    ODBCFuncs(0, 65) = "SQLPrimaryKeys"
    ODBCFuncs(0, 66) = "SQLProcedureColumns"
    ODBCFuncs(0, 67) = "SQLProcedures"
    ODBCFuncs(0, 68) = "SQLSetPos"
    ODBCFuncs(0, 69) = "SQLSetScrollOptions"
    ODBCFuncs(0, 70) = "SQLTablePrivileges"
    ODBCFuncs(0, 71) = "SQLDrivers"
    ODBCFuncs(0, 72) = "SQLBindParameter"
    For I = 55 To 72
        ODBCFuncs(1, I) = "Level 2"
    Next
    
End Sub
Private Sub LoadGetInfo()
    ODBCGetInfo(0).InfoType = "SQL_ACTIVE_CONNECTIONS"
    ODBCGetInfo(0).ReturnType = "I"
    ODBCGetInfo(1).InfoType = "SQL_ACTIVE_STATEMENTS"
    ODBCGetInfo(1).ReturnType = "I"
    ODBCGetInfo(2).InfoType = "SQL_DATA_SOURCE_NAME"
    ODBCGetInfo(2).ReturnType = "S"
    ODBCGetInfo(3).InfoType = "SQL_DRIVER_HDBC"
    ODBCGetInfo(3).ReturnType = "L"
    ODBCGetInfo(4).InfoType = "SQL_DRIVER_HENV"
    ODBCGetInfo(4).ReturnType = "L"
    ODBCGetInfo(5).InfoType = "SQL_DRIVER_HSTMT"
    ODBCGetInfo(5).ReturnType = "L"
    ODBCGetInfo(6).InfoType = "SQL_DRIVER_NAME"
    ODBCGetInfo(6).ReturnType = "S"