ODBC SQL (Windows)

[SpriggsySpriggs]

Here is some code for using the ODBC SQL API in Windows. Testing has been done primarily in 64 bit but I am confident it will work in 32 as well. This code, in my opinion, does a good job of using the features in the ODBC API in Windows. I have tried to model it around the original Wiki example for MySQL, with some cleanup   Note, you will need to create a new 64 bit data source if you are compiling in 64 bit. 32 for 32. ODBC is more secure since you are not storing your server's information in the code.

Follow this link to see how to add a new data source:
Administer ODBC data sources

ODBC supports all SQL variants. You just need to use the proper syntax for your flavor.

Code: (Select All)

Option Explicit
$NoPrefix
$Console:Only
$VersionInfo:Comments=Testing ODBC connections in Windows using QB64
'$ExeIcon:'databases.ico'
'Icon

Type SQL_FIELD
    As Integer type
    As Unsigned Integer size
    As Byte isNullable
    As Integer decimalDigits
    As String columnName, value
End Type

Const SQL_SUCCESS = 0

Dim Shared As Offset hEnv, hDbc, hStmt
ReDim Shared As SQL_FIELD DB_Result(1 To 1, 1 To 1)
Dim Shared As String ConnectionString
Dim As String datasource: datasource = "SpriggsyWinServer" 'use your data source name here

If DB_Open(datasource) Then
    If datasource <> "" Then
        Dim As String conTitle: conTitle = "ODBC Test - " + datasource: ConsoleTitle conTitle
    Else
        conTitle = "ODBC Test": ConsoleTitle conTitle
    End If
    If DB_QUERY("SELECT * FROM root.table1") = SQL_SUCCESS Then 'insert your own query here
        DB_DetailResult
    End If
    DB_Close
Else System
End If

Declare Dynamic Library "odbc32"
    Sub SQLAllocHandle (ByVal HandleType As Integer, Byval InputHandle As Offset, Byval OutputHandlePtr As Offset)
    Function SQLGetDiagRec%& (ByVal HandleType As Integer, Byval Handle As Offset, Byval RecNumber As Integer, Byval SQLState As Offset, Byval NativeErrorPtr As Offset, Byval MessageText As Offset, Byval BufferLength As Integer, Byval TextLengthPtr As Offset)
    Sub SQLSetEnvAttr (ByVal EnvironmentHandle As Offset, Byval Attribute As Long, Byval ValuePtr As Offset, Byval StringLength As Long)
    Function SQLDriverConnect%& (ByVal ConnectionHandle As Offset, Byval WindowHandle As Offset, InConnectionString As String, Byval StringLength1 As Integer, Byval OutConnectionString As Offset, Byval BufferLength As Integer, Byval StringLength2Ptr As Offset, Byval DriverCompletion As Unsigned Integer)
    Sub SQLPrepare (ByVal StatementHandle As Offset, StatementText As String, Byval TextLength As Long)
    Sub SQLExecute (ByVal StatementHandle As Offset)
    Function SQLExecute%& (ByVal StatementHandle As Offset)
    Sub SQLNumResultCols (ByVal StatementHandle As Offset, Byval ColumnCountPtr As Offset)
    Sub SQLDescribeCol (ByVal StatementHandle As Offset, Byval ColumnNumber As Unsigned Integer, Byval ColumnName As Offset, Byval BufferLength As Integer, Byval NameLengthPtr As Offset, Byval DataTypePtr As Offset, Byval ColumnSizePtr As Offset, Byval DecimalDigitsPtr As Offset, Byval NullablePtr As Offset)
    Function SQLFetch%& (ByVal StatementHandle As Offset)
    Function SQLGetData%& (ByVal StatementHandle As Offset, Byval ColOrParamNum As Unsigned Integer, Byval TargetType As Integer, Byval TargetValuePtr As Offset, Byval BufferLength As Offset, Byval StrLenOrIndPtr As Offset)
    Function SQLRowCount%& (ByVal StatementHandle As Offset, Byval RowCountPtr As Offset)
    Sub SQLFreeHandle (ByVal HandleType As Integer, Byval Handle As Offset)
    Sub SQLDisconnect (ByVal ConnectionHandle As Offset)
End Declare

Declare CustomType Library
    Function GetDesktopWindow%& ()
End Declare

Function DB_Open%% (dsn As String)
    Const SQL_HANDLE_ENV = 1
    Const SQL_HANDLE_DBC = 2
    Const SQL_HANDLE_STMT = 3
    Const SQL_DRIVER_COMPLETE = 1
    Const SQL_NULL_HANDLE = 0
    Const SQL_NTS = -3
    Const SQL_ATTR_ODBC_VERSION = 200
    Const SQL_OV_ODBC3 = 3~&

    Dim As Offset ret
    SQLAllocHandle SQL_HANDLE_ENV, SQL_NULL_HANDLE, Offset(hEnv)
    SQLSetEnvAttr hEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0
    SQLAllocHandle SQL_HANDLE_DBC, hEnv, Offset(hDbc)
    Dim As String outstr: outstr = Space$(1024)
    Dim As Integer outstrlen
    If dsn = "" Then
        ret = SQLDriverConnect(hDbc, GetDesktopWindow, "", SQL_NTS, Offset(outstr), Len(outstr), Offset(outstrlen), SQL_DRIVER_COMPLETE)
    Else
        ret = SQLDriverConnect(hDbc, 0, "DSN=" + dsn + ";", SQL_NTS, Offset(outstr), Len(outstr), Offset(outstrlen), SQL_DRIVER_COMPLETE)
    End If
    ConnectionString = Mid$(outstr, 1, outstrlen)
    SQLAllocHandle SQL_HANDLE_STMT, hDbc, Offset(hStmt)
    If SQL_SUCCEEDED(ret) Then
        DB_Open = -1
    Else
        DB_Error "DB_Open", hDbc, SQL_HANDLE_DBC
        DB_Open = 0
    End If
End Function

Sub DB_Open (dsn As String)
    Const SQL_HANDLE_ENV = 1
    Const SQL_HANDLE_DBC = 2
    Const SQL_HANDLE_STMT = 3
    Const SQL_DRIVER_COMPLETE = 1
    Const SQL_NULL_HANDLE = 0
    Const SQL_NTS = -3
    Const SQL_ATTR_ODBC_VERSION = 200
    Const SQL_OV_ODBC3 = 3~&

    Dim As Offset ret
    SQLAllocHandle SQL_HANDLE_ENV, SQL_NULL_HANDLE, Offset(hEnv)
    SQLSetEnvAttr hEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0
    SQLAllocHandle SQL_HANDLE_DBC, hEnv, Offset(hDbc)
    Dim As String outstr: outstr = Space$(1024 + 1)
    Dim As Integer outstrlen
    If dsn = "" Then
        ret = SQLDriverConnect(hDbc, GetDesktopWindow, "", SQL_NTS, Offset(outstr), Len(outstr), Offset(outstrlen), SQL_DRIVER_COMPLETE)
    Else
        ret = SQLDriverConnect(hDbc, 0, "DSN=" + dsn + ";", SQL_NTS, Offset(outstr), Len(outstr), Offset(outstrlen), SQL_DRIVER_COMPLETE)
    End If
    ConnectionString = Mid$(outstr, 1, outstrlen)
    SQLAllocHandle SQL_HANDLE_STMT, hDbc, Offset(hStmt)
    If Not (SQL_SUCCEEDED(ret)) Then
        DB_Error "DB_Open", hDbc, SQL_HANDLE_DBC
    End If
End Sub

Sub DB_QUERY (sql_command As String)
    Const SQL_CHAR = 1
    Const SQL_C_CHAR = SQL_CHAR
    Const SQL_NO_NULLS = 0
    Const SQL_NULLABLE = 1
    Const SQL_NULLABLE_UNKNOWN = 2
    Const SQL_NULL_DATA = -1
    Const SQL_NTS = -3

    Dim As Offset ret, execCode
    SQLPrepare hStmt, sql_command, SQL_NTS
    execCode = SQLExecute(hStmt)
    If SQL_SUCCEEDED(execCode) Then
        Dim As Integer columns
        SQLNumResultCols hStmt, Offset(columns)
        ret = SQLFetch(hStmt)
        Dim As Long row
        While SQL_SUCCEEDED(ret)
            Dim As Unsigned Integer i
            row = row + 1
            For i = 1 To columns
                Dim As Long indicator
                Dim As String buf: buf = Space$(4096 + 1)
                Dim As String columnName: columnName = Space$(128)
                Dim As Integer colNameLength, dataType, decimalDigits, nullable
                Dim As Unsigned Integer columnSize
                ret = SQLGetData(hStmt, i, SQL_C_CHAR, Offset(buf), Len(buf), Offset(indicator))
                If SQL_SUCCEEDED(ret) Then
                    ReDim Preserve As SQL_FIELD DB_Result(columns, row)
                    buf = Mid$(buf, 1, indicator)
                    If indicator = SQL_NULL_DATA Then buf = "NULL"
                    SQLDescribeCol hStmt, i, Offset(columnName), Len(columnName), Offset(colNameLength), Offset(dataType), Offset(columnSize), Offset(decimalDigits), Offset(nullable)
                    columnName = Mid$(columnName, 1, colNameLength)
                    DB_Result(i, row).type = dataType
                    DB_Result(i, row).size = columnSize
                    DB_Result(i, row).decimalDigits = decimalDigits
                    DB_Result(i, row).columnName = columnName
                    DB_Result(i, row).value = buf
                    Select Case nullable
                        Case SQL_NO_NULLS
                            DB_Result(i, row).isNullable = 0
                        Case SQL_NULLABLE
                            DB_Result(i, row).isNullable = -1
                    End Select
                End If
            Next
            ret = SQLFetch(hStmt)
        Wend
    Else
        DB_Error "DB_QUERY", hStmt, 3
    End If
End Sub

Function DB_QUERY%& (sql_command As String)
    Const SQL_CHAR = 1
    Const SQL_C_CHAR = SQL_CHAR
    Const SQL_NO_NULLS = 0
    Const SQL_NULLABLE = 1
    Const SQL_NULLABLE_UNKNOWN = 2
    Const SQL_NULL_DATA = -1
    Const SQL_NTS = -3
    Const SQL_SUCCESS = 0

    Dim As Offset ret, execCode
    SQLPrepare hStmt, sql_command, SQL_NTS
    execCode = SQLExecute(hStmt)
    If SQL_SUCCEEDED(execCode) Then
        Dim As Integer columns
        SQLNumResultCols hStmt, Offset(columns)
        ret = SQLFetch(hStmt)
        Dim As Long row
        While SQL_SUCCEEDED(ret)
            Dim As Unsigned Integer i
            row = row + 1
            For i = 1 To columns
                Dim As Long indicator
                Dim As String buf: buf = Space$(4096 + 1)
                Dim As String columnName: columnName = Space$(128)
                Dim As Integer colNameLength, dataType, decimalDigits, nullable
                Dim As Unsigned Integer columnSize
                ret = SQLGetData(hStmt, i, SQL_C_CHAR, Offset(buf), Len(buf), Offset(indicator))
                If SQL_SUCCEEDED(ret) Then
                    ReDim Preserve As SQL_FIELD DB_Result(columns, row)
                    buf = Mid$(buf, 1, indicator)
                    If indicator = SQL_NULL_DATA Then buf = "NULL"
                    SQLDescribeCol hStmt, i, Offset(columnName), Len(columnName), Offset(colNameLength), Offset(dataType), Offset(columnSize), Offset(decimalDigits), Offset(nullable)
                    columnName = Mid$(columnName, 1, colNameLength)
                    DB_Result(i, row).type = dataType
                    DB_Result(i, row).size = columnSize
                    DB_Result(i, row).decimalDigits = decimalDigits
                    DB_Result(i, row).columnName = columnName
                    DB_Result(i, row).value = buf
                    Select Case nullable
                        Case SQL_NO_NULLS
                            DB_Result(i, row).isNullable = 0
                        Case SQL_NULLABLE
                            DB_Result(i, row).isNullable = -1
                    End Select
                End If
            Next
            ret = SQLFetch(hStmt)
        Wend
    Else
        DB_Error "DB_QUERY", hStmt, 3
    End If
    DB_QUERY = execCode
End Function

Function DB_Esc$ (columnName As String)
    DB_Esc = "`" + columnName + "`"
End Function

Function DB_Q$ (value As String)
    DB_Q = "'" + value + "'"
End Function

Function DB_AffectedRows%&
    Dim As Offset rowCount
    Dim As Offset ret: ret = SQLRowCount(hStmt, Offset(rowCount))
    If SQL_SUCCEEDED(ret) Then DB_AffectedRows = rowCount
End Function

Sub DB_DetailResult
    Const SQL_DECIMAL = 3
    Const SQL_NUMERIC = 2
    Dim As Unsigned Integer row, column
    Print "Connection: "; ConnectionString
    For row = 1 To UBound(DB_Result, 2)
        Print "Row"; row
        For column = 1 To UBound(DB_Result, 1)
            Print "  "; column; GetDataType(DB_Result(column, row).type);
            If DB_Result(column, row).type = SQL_DECIMAL Or DB_Result(column, row).type = SQL_NUMERIC Then
                Print "("; Trim$(Str$(DB_Result(column, row).size)); ","; Trim$(Str$(DB_Result(column, row).decimalDigits)); ") ";
            Else
                Print "("; Trim$(Str$(DB_Result(column, row).size)); ") ";
            End If

            If DB_Result(column, row).isNullable = 0 Then
                Print DB_Result(column, row).columnName; " "; DB_Result(column, row).value; " "; "Not nullable"
            Else Print DB_Result(column, row).columnName; " "; DB_Result(column, row).value
            End If
        Next
    Next
End Sub

Sub DB_Close
    Const SQL_HANDLE_ENV = 1
    Const SQL_HANDLE_DBC = 2
    SQLDisconnect (hDbc)
    SQLFreeHandle SQL_HANDLE_DBC, hDbc
    SQLFreeHandle SQL_HANDLE_ENV, hEnv
End Sub

Function GetDataType$ (dataType As Integer)
    Const SQL_CHAR = 1
    Const SQL_C_CHAR = SQL_CHAR
    Const SQL_VARCHAR = 12
    Const SQL_LONGVARCHAR = -1
    Const SQL_WCHAR = -8
    Const SQL_WVARCHAR = -9
    Const SQL_WLONGVARCHAR = -10
    Const SQL_DECIMAL = 3
    Const SQL_NUMERIC = 2
    Const SQL_SMALLINT = 5
    Const SQL_INTEGER = 4
    Const SQL_REAL = 7
    Const SQL_FLOAT = 6
    Const SQL_DOUBLE = 8
    Const SQL_BIT = -7
    Const SQL_TINYINT = -6
    Const SQL_BIGINT = -5
    Const SQL_BINARY = -2
    Const SQL_VARBINARY = -3
    Const SQL_LONGVARBINARY = -4
    Const SQL_TYPE_DATE = 91
    Const SQL_TYPE_TIME = 92
    Const SQL_TYPE_TIMESTAMP = 93
    Const SQL_INTERVAL_MONTH = -81
    Const SQL_INTERVAL_YEAR = -80
    Const SQL_INTERVAL_YEAR_TO_MONTH = -82
    Const SQL_INTERVAL_DAY = -83
    Const SQL_INTERVAL_HOUR = -84
    Const SQL_INTERVAL_MINUTE = -85
    Const SQL_INTERVAL_SECOND = -86
    Const SQL_INTERVAL_DAY_TO_HOUR = -87
    Const SQL_INTERVAL_DAY_TO_MINUTE = -88
    Const SQL_INTERVAL_DAY_TO_SECOND = -89
    Const SQL_INTERVAL_HOUR_TO_MINUTE = -90
    Const SQL_INTERVAL_HOUR_TO_SECOND = -91
    Const SQL_INTERVAL_MINUTE_TO_SECOND = -92
    Const SQL_GUID = -11

    Select Case dataType
        Case SQL_CHAR, SQL_C_CHAR
            GetDataType = "CHAR"
        Case SQL_VARCHAR
            GetDataType = "VARCHAR"
        Case SQL_LONGVARCHAR
            GetDataType = "LONG VARCHAR"
        Case SQL_WCHAR
            GetDataType = "WCHAR"
        Case SQL_WVARCHAR
            GetDataType = "VARWCHAR"
        Case SQL_WLONGVARCHAR
            GetDataType = "LONGWVARCHAR"
        Case SQL_DECIMAL
            GetDataType = "DECIMAL"
        Case SQL_NUMERIC
            GetDataType = "NUMERIC"
        Case SQL_SMALLINT
            GetDataType = "SMALLINT"
        Case SQL_INTEGER
            GetDataType = "INTEGER"
        Case SQL_REAL
            GetDataType = "REAL"
        Case SQL_FLOAT
            GetDataType = "FLOAT"
        Case SQL_DOUBLE
            GetDataType = "DOUBLE PRECISION"
        Case SQL_BIT
            GetDataType = "BIT"
        Case SQL_TINYINT
            GetDataType = "TINYINT"
        Case SQL_BIGINT
            GetDataType = "BIGINT"
        Case SQL_BINARY
            GetDataType = "BINARY"
        Case SQL_VARBINARY
            GetDataType = "VARBINARY"
        Case SQL_LONGVARBINARY
            GetDataType = "LONG VARBINARY"
        Case SQL_TYPE_DATE
            GetDataType = "DATE"
        Case SQL_TYPE_TIME
            GetDataType = "TIME"
        Case SQL_TYPE_TIMESTAMP
            GetDataType = "TIMESTAMP"
        Case SQL_INTERVAL_MONTH
            GetDataType = "INTERVAL MONTH"
        Case SQL_INTERVAL_YEAR
            GetDataType = "INTERVAL YEAR"
        Case SQL_INTERVAL_YEAR_TO_MONTH
            GetDataType = "INTERVAL YEAR TO MONTH"
        Case SQL_INTERVAL_DAY
            GetDataType = "INTERVAL DAY"
        Case SQL_INTERVAL_HOUR
            GetDataType = "INTERVAL HOUR"
        Case SQL_INTERVAL_MINUTE
            GetDataType = "INTERVAL MINUTE"
        Case SQL_INTERVAL_SECOND
            GetDataType = "INTERVAL SECOND"
        Case SQL_INTERVAL_DAY_TO_HOUR
            GetDataType = "INTERVAL DAY TO HOUR"
        Case SQL_INTERVAL_DAY_TO_MINUTE
            GetDataType = "INTERVAL DAY TO MINUTE"
        Case SQL_INTERVAL_DAY_TO_SECOND
            GetDataType = "INTERVAL DAY TO SECOND"
        Case SQL_INTERVAL_HOUR_TO_MINUTE
            GetDataType = "INTERVAL HOUR TO MINUTE"
        Case SQL_INTERVAL_HOUR_TO_SECOND
            GetDataType = "INTERVAL HOUR TO SECOND"
        Case SQL_INTERVAL_MINUTE_TO_SECOND
            GetDataType = "INTERVAL MINUTE TO SECOND"
        Case SQL_GUID
            GetDataType = "GUID"
    End Select
End Function

Sub DB_Error (__fn As String, handle As Offset, __type As Integer)
    Const SQL_SUCCESS = 0
    Const MB_OK = 0 'OK button only
    Const MB_ICONEXCLAMATION = 48
    Dim As Long i, NativeError
    Dim As String SQLState: SQLState = Space$(5 + 1)
    Dim As String MessageText: MessageText = Space$(256 + 1)
    Dim As Integer TextLength
    Dim As Offset ret

    Do
        i = i + 1
        ret = SQLGetDiagRec(__type, handle, i, Offset(SQLState), Offset(NativeError), Offset(MessageText), Len(MessageText), Offset(TextLength))
        If SQL_SUCCEEDED(ret) Then
            MessageBox 0, "Error reported in " + __fn + ":" + Chr$(10) + Mid$(SQLState, 1, InStr(SQLState, Chr$(0)) - 1) + ":" + Trim$(Str$(i)) + ":" + Trim$(Str$(NativeError)) + ":" + Mid$(MessageText, 1, TextLength) + Chr$(0), "ODBC Error" + Chr$(0), MB_OK Or MB_ICONEXCLAMATION
        End If
    Loop While ret = SQL_SUCCESS
End Sub

Function SQL_SUCCEEDED& (rc As Offset)
    SQL_SUCCEEDED = (((rc) And (Not 1)) = 0)
End Function

$If MESSAGEBOX = UNDEFINED Then
    Declare Library
        Function MessageBox& (ByVal hWnd As _Offset, message As String, title As String, Byval uType As _Unsigned Long)
        Sub MessageBox (ByVal hWnd As _Offset, message As String, title As String, Byval uType As _Unsigned Long)
    End Declare
    $Let MESSAGEBOX = TRUE
$End If

Some screenshots:
   
   
Happy coding, and let me know if you have any questions on how to use it or get started