www.pudn.com > ADO 2.6 Programmers Reference(Source Code).zip > ODBC.bas

Attribute VB_Name = "ODBC" 
Option Explicit 
 
' odbc query functions 
Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer 
Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal henv&) As Integer 
Declare Function SQLDataSources Lib "odbc32.dll" (ByVal henv&, ByVal fDirection%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, ByVal szDescription$, ByVal cbDescriptionMax%, pcbDescription%) As Integer 
Declare Function SQLDrivers Lib "odbc32.dll" (ByVal henv&, ByVal fDirection%, ByVal szDriverDesc$, ByVal cbDriverDescMax%, pcbDriverDesc%, ByVal szDriverAttr$, ByVal cbDrvrAttrMax%, pcbDrvrAttr%) As Integer 
 
' odbc constants 
Private Const SQL_NO_DATA_FOUND     As Integer = 100 
Private Const SQL_FETCH_NEXT        As Integer = 1 
Private Const SQL_FETCH_FIRST       As Integer = 2 
 
Public Function ODBCDataSources(asDSN() As String) 
 
    ' query odbc for the data sources, 
    ' and place in passed in array 
     
    ' TODO:  add error handling 
 
    Dim lEnv        As Long 
    Dim lRV         As Long 
    Dim sDSN        As String * 255 
    Dim sDSNDesc    As String * 255 
    Dim iDSNLen     As Integer 
    Dim iDSNDescLen As Integer 
    Dim iCount      As Integer 
 
    ReDim asDSN(0) 
    iDSNLen = 255 
    iDSNDescLen = 255 
    sDSN = Space(iDSNLen) 
    sDSNDesc = Space(iDSNDescLen) 
 
    ' initialise environment 
    SQLAllocEnv lEnv 
 
    ' query for first data source 
    lRV = SQLDataSources(lEnv, SQL_FETCH_FIRST, _ 
            sDSN, iDSNLen, iDSNLen, _ 
            sDSNDesc, iDSNDescLen, iDSNDescLen) 
 
    ' while there are still data sources 
    While lRV <> SQL_NO_DATA_FOUND 
        ' add data source to array 
        iCount = iCount + 1 
        ReDim Preserve asDSN(iCount) 
        asDSN(iCount - 1) = Left(sDSN, InStr(sDSN, Chr(0)) - 1) 
 
        iDSNLen = 255 
        iDSNDescLen = 255 
        sDSN = Space(iDSNLen) 
        sDSNDesc = Space(iDSNDescLen) 
 
    ' get next data source 
        lRV = SQLDataSources(lEnv, SQL_FETCH_NEXT, _ 
                sDSN, iDSNLen, iDSNLen, _ 
                sDSNDesc, iDSNDescLen, iDSNDescLen) 
    Wend 
     
    ' free environment 
    SQLFreeEnv lEnv 
 
End Function 
 
Public Sub ODBCDrivers(asDrivers() As String) 
 
    ' query odbc for the drivers, 
    ' and place in passed in array 
     
    Dim lEnv        As Long 
    Dim sDesc       As String * 255 
    Dim sAttr       As String * 255 
    Dim iDescLen    As Integer 
    Dim iAttrLen    As Integer 
    Dim iCount      As Integer 
    Dim lRV         As Long 
 
    ReDim asDrivers(0) 
    iDescLen = 255 
    iAttrLen = 255 
    sDesc = Space(iDescLen) 
    sAttr = Space(iAttrLen) 
 
    ' allocate environment 
    SQLAllocEnv lEnv 
 
    ' query for first driver 
    lRV = SQLDrivers(lEnv, SQL_FETCH_FIRST, _ 
            sDesc, iDescLen, iDescLen, _ 
            sAttr, iAttrLen, iAttrLen) 
 
    ' while there are still drivers 
    While lRV <> SQL_NO_DATA_FOUND 
        ' add driver to array 
        iCount = iCount + 1 
        ReDim Preserve asDrivers(iCount) 
        asDrivers(iCount - 1) = Left(sDesc, InStr(sDesc, Chr(0)) - 1) 
 
        iDescLen = 255 
        iAttrLen = 255 
        sDesc = Space(iDescLen) 
        sAttr = Space(iAttrLen) 
 
        ' query for the next driver 
        lRV = SQLDrivers(lEnv, SQL_FETCH_NEXT, _ 
                sDesc, iDescLen, iDescLen, _ 
                sAttr, iAttrLen, iAttrLen) 
    Wend 
     
    ' free the environment 
    SQLFreeEnv lEnv 
 
End Sub