MODULE SqlOdbc3;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT SYSTEM, WinApi, WinSql, Services, Dates, Dialog, Log, SqlDrivers, HostWindows;
(* ODBC functions used:
core:
SQLConnect
SQLDescribeCol
SQLDisconnect
SQLExecute
SQLNumResultCols
SQLPrepare
SQLRowCount
level 1:
SQLBindParameter (* for blobs *)
SQLGetData
SQLGetInfo
level 2:
-
level 3:
SQLAllocHandle
SQLEndTran
SQLFetchScroll
SQLFreeHandle
SQLGetDiagRec
SQLGetStmtAttr
SQLSetConnectAttr
SQLSetEnvAttr
SQLSetStmtAttr
*)
(* The major problem with ODBC is that many of its functions, or many uses of them, are optional.
This means that one can never rely on a function to be really implemented by the current ODBC driver.
As a result, one often has to try the best approach first, then back off if necessary to the next best, etc.
This is cumbersome and difficult to test exhaustively. *)
CONST
outOfTables = 5;
notExecutable = 6;
cannotOpenDB = 7;
wrongIdentification = 8;
tooManyBlobs = 9;
(* not public *)
invalidTransaction = 10;
truncated = 2;
overflow = 3;
incompatible = 4;
noData = 5;
connecting = 1;
connected = 2;
preparing = 3;
executing = 4;
executed = 5;
closed = 6;
TYPE
Driver = POINTER TO RECORD (SqlDrivers.Driver)
state: INTEGER; (* IN {connecting, connected, executing, closed} *)
showErr: BOOLEAN;
actStmt: WinSql.HSTMT;
actRes: INTEGER; (* result of async operation *)
dbc: WinSql.HDBC;
directions: SET (* supported Fetch directions *)
END;
Table = POINTER TO RECORD (SqlDrivers.Table)
rows, columns: INTEGER;
actRow, actCol: INTEGER;
stmt: WinSql.HSTMT;
driver: Driver
END;
VAR
debug*: BOOLEAN; (* if TRUE, show more information about what's happening *)
autoCommit*: BOOLEAN; (* by default, automatic commit is disabled *)
rowcount*: INTEGER; (* jt: number of rows affected in last update, insert, delete *)
environment: WinSql.HENV; (* ODBC environment, in which everything happens *)
numConnections: INTEGER; (* free the environment, if the number of connections goes to zero *)
(* miscellaneous *)
PROCEDURE Check (ret: INTEGER; d: Driver; stmt: WinSql.HSTMT; OUT res: INTEGER);
VAR err: INTEGER; len: SHORTINT; state, msg: ARRAY 256 OF CHAR;
BEGIN
CASE ret OF
| WinSql.SQL_SUCCESS:
res := 0
| WinSql.SQL_SUCCESS_WITH_INFO:
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_STMT, stmt, 1, state, err, msg, LEN(msg), len);
IF (res = WinSql.SQL_NO_DATA) OR (res = WinSql.SQL_INVALID_HANDLE) OR (msg = "") THEN
IF d # NIL THEN
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_DBC, d.dbc, 1, state, err, msg, LEN(msg), len);
IF (res = WinSql.SQL_NO_DATA) OR (msg = "") THEN
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_ENV, environment,
1, state, err, msg, LEN(msg), len)
END
ELSE
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_ENV, environment,
1, state, err, msg, LEN(msg), len)
END;
END;
IF debug THEN Log.String(msg$); Log.Ln END;
IF state = "01004" THEN res := truncated ELSE res := 0 END
| WinSql.SQL_ERROR:
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_STMT, stmt, 1, state, err, msg, LEN(msg), len);
IF (res = WinSql.SQL_NO_DATA) OR (res = WinSql.SQL_INVALID_HANDLE) OR (msg = "") THEN
IF d # NIL THEN
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_DBC, d.dbc, 1, state, err, msg, LEN(msg), len);
IF (res = WinSql.SQL_NO_DATA) OR (msg = "") THEN
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_ENV, environment,
1, state, err, msg, LEN(msg), len)
END
ELSE
res := WinSql.SQLGetDiagRecW(WinSql.SQL_HANDLE_ENV, environment,
1, state, err, msg, LEN(msg), len)
END;
END;
IF (d # NIL) & d.showErr THEN
res := WinApi.MessageBoxW(0, msg, "ODBC Error", {})
ELSIF debug THEN Log.String(msg$); Log.Ln
END;
IF state = "01004" THEN res := truncated
ELSIF state = "28000" THEN res := wrongIdentification
ELSIF state = "07006" THEN res := incompatible
ELSIF state = "22003" THEN res := overflow
ELSIF state = "22005" THEN res := overflow
ELSIF state = "22008" THEN res := overflow
ELSIF state = "25000" THEN res := invalidTransaction
ELSE res := noData (* default error *)
END
| WinSql.SQL_NO_DATA:
res := noData
| WinSql.SQL_INVALID_HANDLE:
HALT(100)
| WinSql.SQL_STILL_EXECUTING:
HALT(101)
| WinSql.SQL_NEED_DATA:
HALT(102)
END
END Check;
PROCEDURE GetTableSize (t: Table; VAR n: INTEGER);
VAR res: INTEGER;
BEGIN
res := -1;
IF t.driver.directions * (WinSql.SQL_FD_FETCH_LAST + WinSql.SQL_FD_FETCH_ABSOLUTE) # {} THEN
IF t.driver.directions * WinSql.SQL_FD_FETCH_LAST # {} THEN
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_LAST, 0), NIL, t.stmt, res);
ELSE
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_ABSOLUTE, -1), NIL, t.stmt, res);
END;
IF res = noData THEN
n := 0; res := 0;
ELSIF res = 0 THEN
Check(WinSql.SQLGetStmtAttr(t.stmt, WinSql.SQL_ROW_NUMBER, SYSTEM.ADR(n),
WinSql.SQL_IS_INTEGER, NIL), NIL, t.stmt, res) ;
(* Double check the rowcount if it is said to be zero or one.*)
IF (n = 0) OR (n = 1) THEN
n := 0;
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_FIRST, 0), NIL, t.stmt, res);
WHILE res = 0 DO
INC(n);
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_NEXT, 0), NIL, t.stmt, res);
END
END;
res := 0;
END;
t.actRow := -2 (* undefined *)
END;
IF (res # 0) & (t.driver.directions * WinSql.SQL_FD_FETCH_FIRST # {}) THEN
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_FIRST, 0), NIL, t.stmt, res);
n := 0;
WHILE res = 0 DO
INC(n);
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_NEXT, 0), NIL, t.stmt, res)
END;
IF res = noData THEN res := 0 END;
t.actRow := -2 (* undefined *)
END;
IF res # 0 THEN
Check(WinSql.SQLRowCount(t.stmt, n), NIL, t.stmt, res);
IF (res # 0) OR (n < 0) THEN n := MAX(INTEGER) END (* row count is not known *)
END
END GetTableSize;
PROCEDURE SetPos (t: Table; row, col: INTEGER; OUT res: INTEGER);
BEGIN
res := 0;
IF (row # t.actRow) OR (col <= t.actCol) THEN
IF row = t.actRow + 1 THEN
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_NEXT, 0), NIL, t.stmt, res);
IF res = 0 THEN INC(t.actRow) END
ELSIF (row = 0) & (t.driver.directions * WinSql.SQL_FD_FETCH_FIRST # {}) THEN
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_FIRST, 0), NIL, t.stmt, res);
IF res = 0 THEN t.actRow := 0 END
ELSIF t.driver.directions * WinSql.SQL_FD_FETCH_ABSOLUTE # {} THEN
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_ABSOLUTE, row + 1), NIL, t.stmt, res);
IF res = 0 THEN t.actRow := row END
ELSIF t.driver.directions * WinSql.SQL_FD_FETCH_RELATIVE # {} THEN
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_RELATIVE, row - t.actRow),
NIL, t.stmt, res);
IF res = 0 THEN t.actRow := row END
ELSIF row <= t.actRow THEN
IF (row > t.actRow DIV 2) & (t.driver.directions * WinSql.SQL_FD_FETCH_PRIOR # {}) THEN
REPEAT
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_PRIOR, 0), NIL, t.stmt, res);
IF res = 0 THEN DEC(t.actRow) END
UNTIL (t.actRow <= row) OR (res # 0)
ELSE
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_FIRST, 0), NIL, t.stmt, res);
IF res = 0 THEN t.actRow := 0 END
END
END;
WHILE (t.actRow < row) & (res = 0) DO
Check(WinSql.SQLFetchScroll(t.stmt, WinSql.SQL_FETCH_NEXT, 0), NIL, t.stmt, res);
IF res = 0 THEN INC(t.actRow) END
END
END;
IF res = 0 THEN t.actCol := col ELSE res := noData END
END SetPos;
(* Driver *)
PROCEDURE (d: Driver) Ready (): BOOLEAN;
VAR res: INTEGER;
BEGIN
IF d.state = preparing THEN
d.actRes := WinSql.SQLPrepareW(d.actStmt, "", WinSql.SQL_NTS);
IF d.actRes = WinSql.SQL_SUCCESS THEN
d.actRes := WinSql.SQLExecute(d.actStmt); d.state := executing
ELSIF d.actRes = WinSql.SQL_SUCCESS_WITH_INFO THEN
Check(d.actRes, d, d.actStmt, res);
d.actRes := WinSql.SQLExecute(d.actStmt); d.state := executing
END;
IF d.actRes # WinSql.SQL_STILL_EXECUTING THEN d.state := executed END
ELSIF d.state = executing THEN
d.actRes := WinSql.SQLExecute(d.actStmt);
IF d.actRes # WinSql.SQL_STILL_EXECUTING THEN d.state := executed END
END;
RETURN d.state IN {connecting, connected, executed}
END Ready;
PROCEDURE (d: Driver) EndOpen (OUT res: INTEGER);
BEGIN
d.state := connected; res := 0
END EndOpen;
PROCEDURE (d: Driver) BeginExec (IN statement: ARRAY OF CHAR; data: SqlDrivers.Blob;
async, showErr: BOOLEAN; OUT res: INTEGER);
(* Pre: statement # "" 20 *)
(* Post: res = 0 <=> execution has started and should be completed later with EndExec *)
VAR stmt: WinSql.HSTMT; r: INTEGER; p: SHORTINT;
BEGIN
IF debug THEN Log.String(statement); Log.Ln END;
ASSERT(statement # "", 20); ASSERT(d.state = connected, 21);
d.showErr := showErr;
res := WinSql.SQLAllocHandle(WinSql.SQL_HANDLE_STMT, d.dbc, stmt);
IF res # WinSql.SQL_SUCCESS THEN
Services.Collect; res := WinSql.SQLAllocHandle(WinSql.SQL_HANDLE_STMT, d.dbc, stmt)
END;
Check(res, d, 0, res);
IF res = 0 THEN
Check(WinSql.SQLSetStmtAttr(stmt, WinSql.SQL_CURSOR_TYPE, WinSql.SQL_CURSOR_STATIC, 0),
NIL, stmt, res);
p :=1;
WHILE data # NIL DO (* handle blobs *)
Check(WinSql.SQLBindParameter(stmt, SHORT(p), WinSql.SQL_PARAM_INPUT, WinSql.SQL_C_BINARY,
WinSql.SQL_LONGVARBINARY, 0, 0, SYSTEM.ADR(data.data^), data.len, data.len), d, stmt, res);
IF res # 0 THEN
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_STMT, stmt), NIL, stmt, r);
res := tooManyBlobs; RETURN
END;
data := data.next; INC(p)
END;
(*Asynchronous mode does not work well. It has been disabled in this version: *)
(* IF async THEN
Check(WinSql.SQLSetStmtAttr(stmt, WinSql.SQL_ASYNC_ENABLE, WinSql.SQL_ASYNC_ENABLE_ON,
WinSql.SQL_IS_INTEGER), NIL, stmt, r)
END;*)
d.actStmt := stmt;
d.actRes := WinSql.SQLPrepareW(stmt, statement, WinSql.SQL_NTS);
IF d.actRes = WinSql.SQL_STILL_EXECUTING THEN
d.state := preparing; res := 0
ELSE
Check(d.actRes, d, stmt, res);
IF res = 0 THEN
d.actRes := WinSql.SQLExecute(stmt);
IF d.actRes = WinSql.SQL_STILL_EXECUTING THEN
d.state := executing; res := 0
ELSE
Check(d.actRes, d, stmt, res);
IF res = 0 THEN d.state := executed END
END
END
END;
IF res # 0 THEN (* execution failed *)
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_STMT, stmt), NIL, stmt, r);
res := notExecutable
END
ELSE (* no workspace available *)
res := outOfTables
END
END BeginExec;
PROCEDURE (d: Driver) EndExec (VAR t: SqlDrivers.Table; OUT rows, columns, res: INTEGER);
(* Pre: execution must have been started successfully with BeginExec 20 *)
(* Post: res = 0<=>t # NIL & res = 0 *)
VAR h: Table; cols: SHORTINT;
BEGIN
ASSERT(d.state # connected, 20); ASSERT(d.state = executed, 21);
d.state := connected;
Check(d.actRes, d, d.actStmt, res);
IF res = 0 THEN
Check(WinSql.SQLNumResultCols(d.actStmt, cols), d, d.actStmt, res);
IF (res = 0) & (cols > 0) THEN (* legal statement returning a result set *)
NEW(h); h.Init(d); h.driver := d;
h.columns := cols; h.actRow := -1;
(* Asynchronous mode does not work well. It has been disabled in this version: *)
(* Check(WinSql.SQLSetStmtAttr(d.actStmt, WinSql.SQL_ASYNC_ENABLE, WinSql.SQL_ASYNC_ENABLE_OFF, 0),
NIL, d.actStmt, res);*)
h.stmt := d.actStmt;
GetTableSize(h, h.rows);
t := h; columns := h.columns; rows := h.rows; res := 0
ELSE
Check(WinSql.SQLRowCount(d.actStmt, rowcount), NIL, d.actStmt, res);
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_STMT, d.actStmt), NIL, d.actStmt, res);
t := NIL; columns := 0; rows := 0; res := 0
END
ELSE
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_STMT, d.actStmt), NIL, d.actStmt, res);
t := NIL; columns := 0; rows := 0; res := notExecutable
END
END EndExec;
PROCEDURE (d: Driver) Commit (accept: BOOLEAN; OUT res: INTEGER);
VAR op: SHORTINT;
BEGIN
IF accept THEN op := WinSql.SQL_COMMIT ELSE op := WinSql.SQL_ROLLBACK END;
Check(WinSql.SQLEndTran(WinSql.SQL_HANDLE_DBC,d.dbc, op), d, 0, res);
IF res # 0 THEN res := notExecutable END
END Commit;
PROCEDURE (d: Driver) Cleanup;
VAR res: INTEGER;
BEGIN
d.showErr := FALSE;
res := WinSql.SQLDisconnect(d.dbc);
IF res # WinSql.SQL_SUCCESS THEN
Check(WinSql.SQLEndTran(WinSql.SQL_HANDLE_DBC, d.dbc, WinSql.SQL_ROLLBACK), d, 0, res);
Check(WinSql.SQLDisconnect(d.dbc), d, 0, res);
END;
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_DBC, d.dbc), d, 0, res);
d.dbc := 0; DEC(numConnections);
IF numConnections = 0 THEN
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_ENV, environment), NIL, 0, res);
END;
d.state := closed
END Cleanup;
(* Table *)
PROCEDURE (t: Table) ReadInteger (row, column: INTEGER; OUT val: INTEGER);
VAR res, len: INTEGER;
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_LONG,
SYSTEM.ADR(val), 0, len), NIL, t.stmt, res);
IF len = WinSql.SQL_NULL_DATA THEN val := 0 END
END;
t.res := res
END ReadInteger;
PROCEDURE (t: Table) ReadReal (row, column: INTEGER; OUT val: REAL);
VAR res, len: INTEGER;
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_DOUBLE,
SYSTEM.ADR(val), 0, len), NIL, t.stmt, res);
IF len = WinSql.SQL_NULL_DATA THEN val := 0 END
END;
t.res := res
END ReadReal;
PROCEDURE (t: Table) ReadDate (row, column: INTEGER; OUT val: Dates.Date);
VAR res, len: INTEGER; date: RECORD y, m, d: SHORTINT END;
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_DATE,
SYSTEM.ADR(date), 0, len), NIL, t.stmt, res);
IF len = WinSql.SQL_NULL_DATA THEN val.day := 0; val.month := 0; val.year := 0
ELSE val.day := date.d; val.month := date.m; val.year := date.y
END
END;
t.res := res
END ReadDate;
PROCEDURE (t: Table) ReadTime (row, column: INTEGER; OUT val: Dates.Time);
VAR res, len: INTEGER; time: RECORD h, m, s: SHORTINT END;
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_TIME,
SYSTEM.ADR(time), 0, len), NIL, t.stmt, res);
IF len = WinSql.SQL_NULL_DATA THEN val.second := 0; val.minute := 0; val.hour := 0
ELSE val.second := time.s; val.minute := time.m; val.hour := time.h
END
END;
t.res := res
END ReadTime;
PROCEDURE (t: Table) ReadCurrency (row, column: INTEGER; OUT val: Dialog.Currency);
VAR res, len, i, j: INTEGER; str: ARRAY 32 OF CHAR; a, b, c, scale: SHORTINT; x: LONGINT;
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLDescribeColW(t.stmt, SHORT(column + 1), str, LEN(str), a, b, i, scale, c), NIL, t.stmt, res);
IF scale < 0 THEN scale := 0 END;
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_WCHAR,
SYSTEM.ADR(str), LEN(str), len), NIL, t.stmt, res);
IF len # WinSql.SQL_NULL_DATA THEN
x := 0; i := 0;
IF str[0] < "." THEN INC(i) END;
WHILE (i < len) & (str[i] # ".") DO
x := x * 10 + ORD(str[i]) - ORD("0"); INC(i)
END;
INC(i); j := 0;
WHILE j < scale DO
x := x * 10;
IF i < len THEN x := x + ORD(str[i]) - ORD("0"); INC(i) END;
INC(j)
END;
IF str[0] = "-" THEN x := -x END;
val.val := x; val.scale := scale
ELSE
val.val := 0; val.scale := 0
END
END;
t.res := res
END ReadCurrency;
PROCEDURE (t: Table) ReadString (row, column: INTEGER; OUT str: ARRAY OF CHAR);
VAR res, len: INTEGER;
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_WCHAR,
SYSTEM.ADR(str), LEN(str), len),
NIL, t.stmt, res);
IF (len = 0) OR (len = WinSql.SQL_NULL_DATA) THEN str := "" END
END;
t.res := res
END ReadString;
PROCEDURE (t: Table) ReadVarString (row, column: INTEGER; OUT str: SqlDrivers.String);
VAR res, len: INTEGER; s: ARRAY 257 OF CHAR; (* odd for correct conversion of binary data *)
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_WCHAR,
SYSTEM.ADR(s), LEN(s), len),
NIL, t.stmt, res);
IF res # noData THEN
IF (len = 0) OR (len = WinSql.SQL_NULL_DATA) THEN
IF str = NIL THEN NEW(str, 1) END; (* allow recycling of string by making parameter a VAR again? *)
str^ := ""
ELSIF len = WinSql.SQL_NO_TOTAL THEN
(* how to improve handling of strings with undefined length? *)
IF (str = NIL) OR (LEN(str^) < LEN(s)) THEN NEW(str, LEN(s)) END;
str^ := s$
ELSE
IF (str = NIL) OR (LEN(str^) < len + 1) THEN NEW(str, len + 1) END;
IF len >= LEN(s) THEN
str^ := s$;
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_WCHAR,
SYSTEM.ADR(str^) + (LEN(s) - 1), LEN(str^) - (LEN(s) - 1), len), NIL, t.stmt, res);
ELSE
str^ := s$
END
END
END
END;
t.res := res
END ReadVarString;
PROCEDURE (t: Table) ReadBlob (row, column: INTEGER; OUT len: INTEGER;
OUT data: POINTER TO ARRAY OF BYTE);
VAR res, x: INTEGER; s: ARRAY 128000 OF BYTE;
(* This version fails for some large blobs for an unknown reason. Buffer is so large that error happens rarely *)
BEGIN
ASSERT(row >= 0, 20); ASSERT(row < t.rows, 21);
ASSERT(column >= 0, 22); ASSERT(column < t.columns, 23);
ASSERT(t.stmt # 0, 24);
SetPos(t, row, column, res);
IF res = 0 THEN
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_BINARY,
SYSTEM.ADR(s), LEN(s), len),
NIL, t.stmt, res);
IF res # noData THEN
IF len = WinSql.SQL_NULL_DATA THEN len := 0
ELSIF len = WinSql.SQL_NO_TOTAL THEN len := 256
END;
IF len > 0 THEN
IF len > LEN(s) THEN
IF (data = NIL) OR (LEN(data^) < len) THEN
(* brute force unblock the connection for the following NEW, which may invoke finalizers that access
the connection: *)
IF row = 0 THEN SetPos(t, row+1, column, res) ELSE SetPos(t, row-1, column, res) END ;
(* TODO: what happens if the table has only one row?*)
SetPos(t, row, column, res);
NEW(data, len);
(* read all data at once *)
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_BINARY,
SYSTEM.ADR(data^), len, x), NIL, t.stmt, res)
ELSE
SYSTEM.MOVE(SYSTEM.ADR(s), SYSTEM.ADR(data^), LEN(s));
Check(WinSql.SQLGetData(t.stmt, SHORT(column + 1), WinSql.SQL_C_BINARY,
SYSTEM.ADR(data^) + LEN(s), len - LEN(s), x), NIL, t.stmt, res)
END
ELSE
IF (data = NIL) OR (LEN(data^) < len) THEN NEW(data, len) END;
SYSTEM.MOVE(SYSTEM.ADR(s), SYSTEM.ADR(data^), len);
END
END
END
END;
t.res := res
END ReadBlob;
PROCEDURE (t: Table) ReadName (column: INTEGER; OUT str: SqlDrivers.String);
VAR res, len: INTEGER; nlen, sqlType, scale, null: SHORTINT; name: ARRAY 64 OF CHAR;
BEGIN
ASSERT(column >= 0, 20); ASSERT(column < t.columns, 21);
ASSERT(t.stmt # 0, 22);
Check(WinSql.SQLDescribeColW(t.stmt, SHORT(column + 1), name, LEN(name), nlen,
sqlType, len, scale, null), NIL, t.stmt, res);
IF (nlen = 0) OR (res = noData) THEN nlen := 0; name := "" END;
IF (str = NIL) OR (LEN(str^) < nlen + 1) THEN NEW(str, nlen + 1) END;
IF nlen >= LEN(name) THEN
Check(WinSql.SQLDescribeColW(t.stmt, SHORT(column + 1), str^, SHORT(LEN(str^)),
nlen, sqlType, len, scale, null),
NIL, t.stmt, res);
ELSE str^ := name$
END;
t.res := res
END ReadName;
PROCEDURE (t: Table) ReadType (column: INTEGER; OUT str: SqlDrivers.String);
VAR res, len: INTEGER; nlen, sqlType, scale, null: SHORTINT;
BEGIN
ASSERT(column >= 0, 20); ASSERT(column < t.columns, 21);
ASSERT(t.stmt # 0, 22);
IF (str = NIL) OR (LEN(str^) < 10) THEN NEW(str, 10) END;
Check(WinSql.SQLDescribeColW(t.stmt, SHORT(column + 1), NIL, 0, nlen, sqlType, len, scale, null),
NIL, t.stmt, res);
IF res # noData THEN
CASE sqlType OF
| WinSql.SQL_BIT: str^ := "BOOLEAN"
| WinSql.SQL_TINYINT: str^ := "BYTE"
| WinSql.SQL_SMALLINT: str^ := "SHORTINT"
| WinSql.SQL_INTEGER: str^ := "INTEGER"
| WinSql.SQL_BIGINT: str^ := "String"
| WinSql.SQL_DATE: str^ := "Date"
| WinSql.SQL_TIME: str^ := "Time"
| WinSql.SQL_TIMESTAMP: str^ := "Time&Date"
| WinSql.SQL_REAL: str^ := "SHORTREAL"
| WinSql.SQL_DOUBLE, WinSql.SQL_FLOAT: str^ := "REAL"
| WinSql.SQL_DECIMAL, WinSql.SQL_NUMERIC: str^ := "Currency"
| WinSql.SQL_CHAR, WinSql.SQL_VARCHAR, WinSql.SQL_LONGVARCHAR,
WinSql.SQL_WCHAR, WinSql.SQL_WVARCHAR, WinSql.SQL_WLONGVARCHAR: str^ := "String"
| WinSql.SQL_BINARY, WinSql.SQL_VARBINARY, WinSql.SQL_LONGVARBINARY: str^ := "Binary"
ELSE str^ := "unknown"
END
ELSE str^ := "unknown"
END
END ReadType;
PROCEDURE (t: Table) Cleanup;
VAR res: INTEGER;
BEGIN
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_STMT, t.stmt), NIL, t.stmt, res)
END Cleanup;
PROCEDURE Open* (id, password, datasource: ARRAY OF CHAR; async, showErr: BOOLEAN;
OUT d: SqlDrivers.Driver; OUT res: INTEGER);
VAR h: Driver; r: INTEGER; len: SHORTINT; str: ARRAY 26 OF CHAR;
BEGIN
NEW(h); d := NIL; h.showErr := showErr;
res := WinSql.SQL_SUCCESS;
IF numConnections = 0 THEN
res := WinSql.SQLAllocHandle(WinSql.SQL_HANDLE_ENV, WinSql.SQL_NULL_HANDLE, environment);
(* Set ODBC version to ODBC3 *)
IF res = WinSql.SQL_SUCCESS THEN
Check(WinSql.SQLSetEnvAttr(environment, WinSql.SQL_ATTR_ODBC_VERSION,
WinSql.SQL_OV_ODBC3, 0),
h, 0, res)
END;
END;
IF res = WinSql.SQL_SUCCESS THEN
Check(WinSql.SQLAllocHandle(WinSql.SQL_HANDLE_DBC, environment, h.dbc), h, 0, res);
IF res = 0 THEN
Check(WinSql.SQLConnectW(h.dbc, datasource, WinSql.SQL_NTS,
id, WinSql.SQL_NTS,
password, WinSql.SQL_NTS), h, 0, res);
IF res = 0 THEN
IF showErr THEN
Check(WinSql.SQLSetConnectAttr(h.dbc, WinSql.SQL_QUIET_MODE, HostWindows.main, 0), h, 0, r)
ELSE
r := WinSql.SQLSetConnectAttr(h.dbc, WinSql.SQL_QUIET_MODE, WinApi.NULL, 0)
END;
h.Init("?");
Check(WinSql.SQLGetInfoW(h.dbc,
WinSql.SQL_FETCH_DIRECTION, SYSTEM.ADR(h.directions), 4, len),
h, 0, r);
(* ODBC default is SQL_AUTOCOMMIT_ON *)
IF ~autoCommit THEN
Check(WinSql.SQLSetConnectAttr(h.dbc, WinSql.SQL_AUTOCOMMIT,
WinSql.SQL_AUTOCOMMIT_OFF, 0), h, 0, r)
END;
Check(WinSql.SQLGetInfoW(h.dbc, WinSql.SQL_DBMS_NAME, SYSTEM.ADR(str), 255, len), h, 0, r);
IF str = "Microsoft SQL Server" THEN
(* If SQLServer is used Preserve Cursors must be set to ON.
Other drivers probably don't support this. *)
Check(WinSql.SQLSetConnectAttr(h.dbc, WinSql.SQL_PRESERVE_CURSORS,
WinSql.SQL_PC_ON,0), h, 0,r);
END;
h.showErr := showErr; h.state := connecting; d := h; INC(numConnections)
ELSE
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_DBC, h.dbc), h, 0, r);
IF numConnections = 0 THEN
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_ENV, environment), NIL, 0, r)
END;
IF res # wrongIdentification THEN res := cannotOpenDB END
END
ELSE
IF numConnections = 0 THEN
Check(WinSql.SQLFreeHandle(WinSql.SQL_HANDLE_ENV, environment), NIL, 0, r);
END;
res := cannotOpenDB
END
ELSE res := cannotOpenDB
END;
END Open;
PROCEDURE SetMode* (d: SqlDrivers.Driver; autocommit: BOOLEAN; OUT res: INTEGER);
(* implicit COMMIT *)
VAR h: Driver;
BEGIN
h := d(Driver);
IF autocommit THEN
Check(WinSql.SQLSetConnectAttr(h.dbc, WinSql.SQL_AUTOCOMMIT, WinSql.SQL_AUTOCOMMIT_ON, 0),
h, 0, res)
ELSE
Check(WinSql.SQLSetConnectAttr(h.dbc, WinSql.SQL_AUTOCOMMIT, WinSql.SQL_AUTOCOMMIT_OFF, 0),
h, 0, res)
END
END SetMode;
END SqlOdbc3.