| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 731
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 24
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 24
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 1,848
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,138
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 301
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 112
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,306
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 223
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 132
|
|
|
| ODBC SQL (Windows) |
|
Posted by: SpriggsySpriggs - 04-17-2022, 02:08 AM - Forum: Programs
- No Replies
|
 |
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
|
|
|
|
