513 lines
15 KiB
Scheme
513 lines
15 KiB
Scheme
;;; handle type identifiers from sql.h
|
|
(define handle-type-env 1)
|
|
(define handle-type-dbc 2)
|
|
(define handle-type-stmt 3)
|
|
(define handle-type-desc 4)
|
|
|
|
;;; options for SQLFreeStmt from sql.h
|
|
(define sql-disconnect-opt-close 0)
|
|
(define sql-disconnect-opt-drop 1)
|
|
(define sql-disconnect-opt-unbind 2)
|
|
(define sql-disconnect-opt-reset-params 3)
|
|
|
|
;;; options for SQLDataSource from sql.h
|
|
(define sql-datasources-fetch-next 1)
|
|
(define sql-datasources-fetch-first 2)
|
|
|
|
;;; C type identifier
|
|
(define sql-type-c-char 1)
|
|
(define sql-type-c-long 4)
|
|
(define sql-type-c-short 5)
|
|
(define sql-type-c-float 7)
|
|
(define sql-type-c-double 8)
|
|
(define sql-type-c-numeric 2)
|
|
(define sql-type-c-default 99)
|
|
(define sql-type-c-date 9)
|
|
(define sql-type-c-time 10)
|
|
(define sql-type-c-timestamp 11)
|
|
(define sql-type-c-binary -2)
|
|
(define sql-type-c-bit -7)
|
|
|
|
;;; ODBC type identifier
|
|
(define sql-type-unknown 0)
|
|
(define sql-type-char 1)
|
|
(define sql-type-numeric 2)
|
|
(define sql-type-decimal 3)
|
|
(define sql-type-integer 4)
|
|
(define sql-type-smallint 5)
|
|
(define sql-type-float 6)
|
|
(define sql-type-real 7)
|
|
(define sql-type-double 8)
|
|
(define sql-type-datetime 9)
|
|
(define sql-type-varchar 12)
|
|
(define sql-type-date 91)
|
|
(define sql-type-time 92)
|
|
(define sql-type-timestamp 93)
|
|
|
|
;;; ODBC function ids for SQLGetFunctions
|
|
(define sql-api-sqlallocconnect 1)
|
|
(define sql-api-sqlallocenv 2)
|
|
(define sql-api-sqlallochandle 1001)
|
|
(define sql-api-sqlallocstmt 3)
|
|
(define sql-api-sqlbindcol 4)
|
|
(define sql-api-sqlbinparam 1002)
|
|
(define sql-api-sqlcancel 5)
|
|
(define sql-api-sqlclosecursor 1003)
|
|
(define sql-api-sqlcolattribute 6)
|
|
(define sql-api-sqlcolumns 40)
|
|
(define sql-api-sqlconnect 7)
|
|
(define sql-api-sqlcopydesc 1004)
|
|
(define sql-api-sqldatasources 57)
|
|
(define sql-api-sqldescribecol 8)
|
|
(define sql-api-sqldisconnect 9)
|
|
(define sql-api-sqlendtran 1005)
|
|
(define sql-api-sqlerror 10)
|
|
(define sql-api-sqlexecdirect 11)
|
|
(define sql-api-sqlexecute 12)
|
|
(define sql-api-sqlfetch 13)
|
|
(define sql-api-sqlfetchscroll 1021)
|
|
(define sql-api-sqlfreeconnect 14)
|
|
(define sql-api-sqlfreeenv 15)
|
|
(define sql-api-sqlfreehandle 1006)
|
|
(define sql-api-sqlfreestmt 16)
|
|
(define sql-api-sqlgetconnectattr 1007)
|
|
(define sql-api-sqlgetconenctoption 42)
|
|
(define sql-api-sqlgetcursorname 17)
|
|
(define sql-api-sqlgetdata 43)
|
|
(define sql-api-sqlgetdescfield 1008)
|
|
(define sql-api-sqlgetdescrec 1009)
|
|
(define sql-api-sqlgetdiagfield 1010)
|
|
(define sql-api-sqlgetdiagrec 1011)
|
|
(define sql-api-sqlgetenvattr 1012)
|
|
(define sql-api-sqlgetfunctions 44)
|
|
(define sql-api-sqlgetinfo 45)
|
|
(define sql-api-sqlgetstmtattr 1014)
|
|
(define sql-api-sqlgetstmtoption 46)
|
|
(define sql-api-sqlgettypeinfo 47)
|
|
(define sql-api-sqlnumresultcols 18)
|
|
(define sql-api-sqlparamdata 48)
|
|
(define sql-api-sqlprepare 19)
|
|
(define sql-api-sqlputdata 49)
|
|
(define sql-api-sqlrowcount 20)
|
|
(define sql-api-sqlsetconnectattr 1016)
|
|
(define sql-api-sqlsetconnectoption 50)
|
|
(define sql-api-sqlsetcursorname 21)
|
|
(define sql-api-sqlsetdescfield 1017)
|
|
(define sql-api-sqlsetdescrec 1018)
|
|
(define sql-api-sqlsetenvattr 1019)
|
|
(define sql-api-sqlsetparam 22)
|
|
(define sql-api-sqlsetstmtattr 1020)
|
|
(define sql-api-sqlsetstmtoption 51)
|
|
(define sql-api-sqlspecialcolumns 52)
|
|
(define sql-api-sqlstatistics 53)
|
|
(define sql-api-sqltables 54)
|
|
(define sql-api-transact 23)
|
|
|
|
;;; additional function identifiers
|
|
(define sql-api-sqlallochandlestd 73)
|
|
(define sql-api-sqlbulkoperations 24)
|
|
(define sql-api-sqlbindparameter 72)
|
|
(define sql-api-sqlbrowseconnect 55)
|
|
(define sql-api-sqlcolattributes 6)
|
|
(define sql-api-sqlcolumnprivileges 56)
|
|
(define sql-api-sqldescribeparam 58)
|
|
(define sql-api-sqldriverconnect 41)
|
|
(define sql-api-sqldrivers 71)
|
|
(define sql-api-sqlextendedfetch 59)
|
|
(define sql-api-sqlforeignkeys 60)
|
|
(define sql-api-sqlmoreresults 61)
|
|
(define sql-api-sqlnativesql 62)
|
|
(define sql-api-sqlnumparams 63)
|
|
(define sql-api-sqlparamoptions 64)
|
|
(define sql-api-sqlprimarykeys 65)
|
|
(define sql-api-sqlprocedurecolumns 66)
|
|
(define sql-api-sqlprcoedures 67)
|
|
(define sql-api-sqlsetpos 68)
|
|
(define sql-api-sqlsetscrolloptions 69)
|
|
(define sql-api-sqltableprivileges 70)
|
|
|
|
;;; info keys for odbc-sql-get-info-int/string
|
|
;;; TODO: sort on return value type!
|
|
|
|
(define sql-get-info-maxdriverconnections 0)
|
|
(define sql-get-info-maximumdriverconnections 0)
|
|
(define sql-get-info-maxconcurrentactivities 1)
|
|
(define sql-get-info-maximumconcurrentactivities 1)
|
|
(define sql-get-info-datasourcename 2)
|
|
(define sql-get-info-fetchdirection 8)
|
|
(define sql-get-info-servername 13)
|
|
(define sql-get-info-searchpatternescape 14)
|
|
(define sql-get-info-dbmsname 17)
|
|
(define sql-get-info-dbmsver 18)
|
|
(define sql-get-info-accessibletable 19)
|
|
(define sql-get-info-accessibaleprocedures 20)
|
|
(define sql-get-info-cursor-commit-behaviour 23)
|
|
(define sql-get-info-datasourcereadonly 25)
|
|
(define sql-get-info-defaulttxnisolation 26)
|
|
(define sql-get-info-identifiercase 28)
|
|
(define sql-get-info-identifierquotechar 29)
|
|
(define sql-get-info-maxcolumnnamelen 30)
|
|
(define sql-get-info-maximumcolumnnamelen 30)
|
|
(define sql-get-info-maxcursornamelen 31)
|
|
(define sql-get-info-maximumcursornamelen 31)
|
|
(define sql-get-info-maxschemanamelen 32)
|
|
(define sql-get-info-maximumschemenamelen 32)
|
|
(define sql-get-info-maxcatalognamelen 34)
|
|
(define sql-get-info-maximumcatalognamelen 34)
|
|
(define sql-get-info-maxtablenamelen 35)
|
|
(define sql-get-info-scrollconcurrency 43)
|
|
(define sql-get-info-txncapable 46)
|
|
(define sql-get-info-transaction-capable 46)
|
|
(define sql-get-info-username 47)
|
|
(define sql-get-info-txpisolationoption 72)
|
|
(define sql-get-info-transcationisolationoption 72)
|
|
(define sql-get-info-integrity 73)
|
|
(define sql-get-info-getdataextensions 81)
|
|
(define sql-get-info-nullcollation 85)
|
|
(define sql-get-info-altertable 86)
|
|
(define sql-get-info-specialcharacters 94)
|
|
(define sql-get-info-maxcolumnsingroupby 97)
|
|
(define sql-get-info-maximumcolumnsingroupby 97)
|
|
(define sql-get-info-maxcolumnsinindex 98)
|
|
(define sql-get-info-maximumcolumnsinindex 98)
|
|
(define sql-get-info-maxcolumnsinorderby 99)
|
|
(define sql-get-info-maximumcolumnsinorderby 99)
|
|
(define sql-get-info-maxcolumnsinselect 100)
|
|
(define sql-get-info-maximumcolumnsinselect 100)
|
|
(define sql-get-info-maxcolumnsintable 101)
|
|
(define sql-get-info-maxindexsize 102)
|
|
(define sql-get-info-maximumindexsize 102)
|
|
(define sql-get-info-maxrowsize 104)
|
|
(define sql-get-info-maximumrowsize 104)
|
|
(define sql-get-info-maxstatementlen 105)
|
|
(define sql-get-info-maximumstatemenlen 105)
|
|
(define sql-get-info-maxtablesinselect 106)
|
|
(define sql-get-info-maximumtablesinselect 106)
|
|
(define sql-get-info-maxusernamelen 107)
|
|
(define sql-get-info-maximumusernamelen 107)
|
|
(define sql-get-info-ojcapabilities 115)
|
|
(define sql-get-info-outerjoincapabilities 115)
|
|
|
|
;;; ODBC return values
|
|
(define sql-error -1)
|
|
(define sql-success 0)
|
|
(define sql-success-with-info 1)
|
|
(define sql-no-data 100)
|
|
(define sql-invalid-handle -2)
|
|
(define sql-need-data 99)
|
|
|
|
(define-record-type odbc-environment :odbc-environment
|
|
(really-make-odbc-environment handle)
|
|
odbc-environment?
|
|
(handle odbc-environment-handle set-odbc-environment-handle!))
|
|
|
|
(define-record-type odbc-connection :odbc-connection
|
|
(really-make-odbc-connection handle)
|
|
odbc-connection?
|
|
(handle odbc-connection-handle set-odbc-connection-handle!))
|
|
|
|
(define-record-type odbc-statement :odbc-statement
|
|
(really-make-odbc-statment sql-query handle)
|
|
odbc-statement?
|
|
(sql-query odbc-statement-sql-query)
|
|
(handle odbc-statement-handle odbc-statement-handle!))
|
|
|
|
(define-record-type odbc-column :odbc-column
|
|
(really-make-odbc-column name type size digits nullable)
|
|
odbc-column?
|
|
(name odbc-column-name)
|
|
(type odbc-column-type)
|
|
(size odbc-column-size)
|
|
(digits odbc-column-digits)
|
|
(nullable odbc-column-nullable))
|
|
|
|
(define make-odbc-environment
|
|
(lambda ()
|
|
(really-make-odbc-environment (odbc-alloc-environment-handle))))
|
|
|
|
(define make-odbc-connection
|
|
(lambda (odbc-environment datasource-name user password)
|
|
(let ((conn-handle (odbc-alloc-connection-handle
|
|
(odbc-environment-handle odbc-environment))))
|
|
(odbc-sql-connect conn-handle datasource-name user password)
|
|
(really-make-odbc-connection conn-handle))))
|
|
|
|
(define odbc-disconnect
|
|
(lambda (odbc-connection)
|
|
(odbc-sql-disconnect (odbc-connection-handle odbc-connection))))
|
|
|
|
(define make-odbc-statement
|
|
(lambda (odbc-connection sql-text)
|
|
(let* ((conn-handle (odbc-connection-handle odbc-connection))
|
|
(stmt-handle (odbc-alloc-statement-handle conn-handle)))
|
|
(odbc-sql-prepare stmt-handle)
|
|
(really-make-odbc-statment sql-text stmt-handle))))
|
|
|
|
(define odbc-get-datasources
|
|
(lambda (odbc-environment)
|
|
(let ((env-handle (odbc-environment-handle odbc-environment)))
|
|
(odbc-sql-data-sources env-handle))))
|
|
|
|
(define odbc-get-drivers
|
|
(lambda (odbc-environment)
|
|
#t))
|
|
|
|
(define odbc-get-environment-info
|
|
(lambda (odbc-environment key)
|
|
#t))
|
|
|
|
(define odbc-get-type-info
|
|
(lambda (odbc-statement type)
|
|
#t))
|
|
|
|
(define odbc-connection-attribute
|
|
(lambda (odbc-connection key)
|
|
#t))
|
|
|
|
(define set-odbc-connection-attribute!
|
|
(lambda (odbc-connection key value)
|
|
#t))
|
|
|
|
(define odbc-environment-attribute
|
|
(lambda (odbc-environment key)
|
|
#t))
|
|
|
|
(define set-odbc-environment-attribute!
|
|
(lambda (odbc-environment key value)
|
|
#t))
|
|
|
|
(define odbc-statement-attribute
|
|
(lambda (odbc-statement key)
|
|
#t))
|
|
|
|
(define set-odbc-statement-attribute!
|
|
(lambda (odbc-statement key value)
|
|
#t))
|
|
|
|
(define odbc-sql-execute-direct
|
|
(lambda (odbc-connection sql-query)
|
|
(let* ((conn-handle (odbc-connection-handle odbc-connection))
|
|
(stmt-handle (odbc-alloc-statement-handle conn-handle)))
|
|
(odbc-sql-execute-direct stmt-handle sql-query))))
|
|
|
|
(define odbc-sql-execute
|
|
(lambda (odbc-statement)
|
|
(let ((stmt-handle (odbc-statement-handle odbc-statement)))
|
|
(odbc-sql-execute odbc-statement))))
|
|
|
|
(define odbc-count-result-cols
|
|
(lambda (odbc-statement)
|
|
(let ((stmt-handle (odbc-statement-handle odbc-statement)))
|
|
(odbc-sql-num-result-cols stmt-handle))))
|
|
|
|
(define odbc-describe-column
|
|
(lambda (odbc-statement column-number)
|
|
(let ((stmt-handle (odbc-statement-handle odbc-statement)))
|
|
(odbc-sql-describe-col stmt-handle column-number))))
|
|
|
|
(define odbc-fetch-row
|
|
(lambda (odbc-statement)
|
|
(let* ((stmt-handle (odbc-statement-handle odbc-statement))
|
|
(retval (odbc-sql-fetch stmt-handle)))
|
|
(if (equal? retval sql-no-data)
|
|
'()
|
|
(let loop ((row '())
|
|
(col (odbc-sql-num-result-cols odbc-statement)))
|
|
(if (> col 1)
|
|
(let* ((col-info
|
|
(odbc-describe-column odbc-statement col))
|
|
(data
|
|
(odbc-sql-get-data stmt-handle col
|
|
(odbc-column-type col-info))))
|
|
(loop (cons data row) (- col 1)))
|
|
row))))))
|
|
|
|
;;;; just for testing purposes, will disappear soon
|
|
;(define open-db
|
|
; (lambda (server user auth)
|
|
; (let* ((env-handle (odbc-alloc-environment-handle))
|
|
; (conn-handle (odbc-alloc-connection-handle env-handle)))
|
|
; (odbc-sql-connect conn-handle server user auth))))
|
|
|
|
;(define list-datasources
|
|
; (lambda ()
|
|
; (let ((env-handle (odbc-alloc-environment-handle)))
|
|
; (odbc-sql-data-sources env-handle sql-datasources-fetch-first))))
|
|
|
|
;(define list-drivers
|
|
; (lambda ()
|
|
; (let ((env-handle (odbc-alloc-environment-handle)))
|
|
; (odbc-sql-drivers env-handle))))
|
|
|
|
;(define free-handle
|
|
; (lambda (handle handle-type)
|
|
; (odbc-sql-free-handle handle-type handle)))
|
|
|
|
;(define free-environment-handle
|
|
; (lambda (handle)
|
|
; (free-handle handle handle-type-env)))
|
|
|
|
;(define free-connection-handle
|
|
; (lambda (handle)
|
|
; (free-handle handle handle-type-dbc)))
|
|
|
|
;(define free-statement-handle
|
|
; (lambda (handle)
|
|
; (free-handle handle handle-type-stmt)))
|
|
|
|
;(define free-description-handle
|
|
; (lambda (handle)
|
|
; (free-handle handle handle-type-desc)))
|
|
|
|
;;; PART 1
|
|
|
|
(import-lambda-definition odbc-alloc-environment-handle
|
|
()
|
|
"odbc_alloc_environment_handle")
|
|
|
|
(import-lambda-definition odbc-alloc-connection-handle
|
|
(env-handle)
|
|
"odbc_alloc_connection_handle")
|
|
|
|
(import-lambda-definition odbc-alloc-statement-handle
|
|
(db-handle)
|
|
"odbc_alloc_statement_handle")
|
|
|
|
(import-lambda-definition odbc-sql-connect
|
|
(conn-handle server-name user-name auth)
|
|
"odbc_sql_connect")
|
|
|
|
;;; PART 2
|
|
|
|
(import-lambda-definition odbc-sql-data-sources
|
|
(env-handle direction)
|
|
"odbc_sql_data_sources")
|
|
|
|
(import-lambda-definition odbc-sql-drivers
|
|
(env-handle)
|
|
"odbc_sql_drivers")
|
|
|
|
(import-lambda-definition odbc-sql-get-info-int
|
|
(conn-handle info-key)
|
|
"odbc_sql_get_info_int")
|
|
|
|
(import-lambda-definition odbc-sql-get-info-string
|
|
(conn-handle info-key)
|
|
"odbc_sql_get_info_string")
|
|
|
|
(import-lambda-definition odbc-sql-get-func-exists
|
|
(conn-handle fun-id)
|
|
"odbc_sql_get_func_exists")
|
|
|
|
(import-lambda-definition odbc-sql-get-type-info
|
|
(stmt-handle data-type)
|
|
"odbc_sql_get_type_info")
|
|
|
|
;;; PART 3
|
|
|
|
(import-lambda-definition odbc-sql-set-connect-attr-int
|
|
(conn-handle attribute value)
|
|
"odbc_sql_set_connect_attr_int")
|
|
|
|
(import-lambda-definition odbc-sql-set-connect-attr-string
|
|
(conn-handle attribute value)
|
|
"odbc_sql_set_connect_attr_string")
|
|
|
|
(import-lambda-definition odbc-sql-get-connect-attr-string
|
|
(conn-handle attribute)
|
|
"odbc_sql_get_connect_attr_string")
|
|
|
|
(import-lambda-definition odbc-sql-get-connect-attr-int
|
|
(conn-handle attribute)
|
|
"odbc_sql_get_connect_attr_int")
|
|
|
|
(import-lambda-definition odbc-sql-set-env-attr-int
|
|
(env-handle attribute value)
|
|
"odbc_sql_set_env_attr_int")
|
|
|
|
(import-lambda-definition odbc-sql-get-env-attr-int
|
|
(env-handle attribute value)
|
|
"odbc_sql_get_env_attr_int")
|
|
|
|
(import-lambda-definition odbc-sql-set-stmt-attr-int
|
|
(stmt-handle attribute value)
|
|
"odbc_sql_set_stmt_attr_int")
|
|
|
|
(import-lambda-definition odbc-sql-set-stmt-attr-string
|
|
(stmt-handle attribute value)
|
|
"odbc_sql_set_stmt_attr_string")
|
|
|
|
(import-lambda-definition odbc-sql-get-stmt-attr-int
|
|
(stmt-handle attribute)
|
|
"odbc_sql_get_stmt_attr_int")
|
|
|
|
(import-lambda-definition odbc-sql-get-stmt-attr-string
|
|
(stmt-handle attribute)
|
|
"odbc_sql_get_stmt_attr_string")
|
|
|
|
;;; PART 4
|
|
|
|
;;; PART 5
|
|
|
|
(import-lambda-definition odbc-sql-prepare
|
|
(stmt-handle stmt-txt)
|
|
"odbc_sql_prepare")
|
|
|
|
(import-lambda-definition odbc-sql-bind-parameter-exec-out
|
|
(stmt-handle param-vals)
|
|
"odbc_sql_bind_parameter_exec_out")
|
|
|
|
;;; PART 6
|
|
(import-lambda-definition odbc-sql-execute
|
|
(stmt-handle)
|
|
"odbc_sql_execute")
|
|
|
|
(import-lambda-definition odbc-sql-execute-direct
|
|
(stmt-handle stmt-txt)
|
|
"odbc_sql_execute_direct")
|
|
|
|
|
|
;;; PART 7
|
|
(import-lambda-definition odbc-sql-get-data
|
|
(stmt-handle column-number target-type)
|
|
"odbc_sql_get_data")
|
|
|
|
(import-lambda-definition odbc-sql-fetch
|
|
(stmt-handle)
|
|
"odbc_sql_fetch")
|
|
|
|
;;; PART 8
|
|
|
|
;;; PART 9
|
|
|
|
(import-lambda-definition odbc-sql-free-statement
|
|
(stmt-handle option)
|
|
"odbc_sql_free_statement")
|
|
|
|
(import-lambda-definition odbc-sql-close-cursor
|
|
(stmt-handle)
|
|
"odbc_sql_close_cursor")
|
|
|
|
(import-lambda-definition odbc-sql-cancel
|
|
(stmt-handle)
|
|
"odbc_sql_cancel")
|
|
|
|
(import-lambda-definition odbc-sql-num-result-cols
|
|
(stmt-handle)
|
|
"odbc_sql_num_result_cols")
|
|
|
|
(import-lambda-definition odbc-sql-describe-col
|
|
(stmt-handle column-number)
|
|
"odbc_sql_describe_col")
|
|
|
|
;;; PART 10
|
|
|
|
(import-lambda-definition odbc-sql-disconnect
|
|
(conn-handle)
|
|
"odbc_sql_disconnect")
|
|
|
|
(import-lambda-definition odbc-sql-free-handle
|
|
(handle-type handle)
|
|
"odbc_sql_free_handle")
|
|
|