Windows.ODBC.Mod 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002
  1. (* OBERON System 3, Release 2.3.
  2. Copyright 1999 ETH Zürich Institute for Computer Systems,
  3. ETH Center, CH-8092 Zürich. e-mail: oberon@inf.ethz.ch.
  4. This module may be used under the conditions of the general Oberon
  5. System 3 license contract. The full text can be downloaded from
  6. "ftp://ftp.inf.ethz.ch/pub/software/Oberon/System3/license.txt;A"
  7. Under the license terms stated it is in particular (a) prohibited to modify
  8. the interface of this module in any way that disagrees with the style
  9. or content of the system and (b) requested to provide all conversions
  10. of the source code to another platform with the name OBERON. *)
  11. MODULE ODBC; (** non-portable / source: Windows.ODBC.Mod *)
  12. IMPORT S:= SYSTEM, Kernel32, Modules;
  13. CONST
  14. MAXMESSAGELENGTH = 512;
  15. NTS = -3;
  16. TYPE
  17. HENV = POINTER TO HENVDesc;
  18. HENVDesc = RECORD
  19. henv: Kernel32.HANDLE;
  20. END;
  21. HDBC* = POINTER TO HDBCDesc;
  22. HDBCDesc* = RECORD
  23. hdbc: Kernel32.HANDLE;
  24. END;
  25. HSTMT* = POINTER TO HSTMTDesc;
  26. HSTMTDesc* = RECORD
  27. hstmt: Kernel32.HANDLE;
  28. END;
  29. (*
  30. type conversion C to Oberon:
  31. UWORD / SWORD -> INTEGER
  32. UDWORD / SDWORD -> LONGINT
  33. *)
  34. VAR
  35. lib: ADDRESS;
  36. env: HENV;
  37. res1*: INTEGER;
  38. nullString-: ARRAY 1 OF CHAR;
  39. (* Core Functions Prototypes *)
  40. SQLAllocConnect: PROCEDURE {WINAPI} (
  41. henv: Kernel32.HANDLE;
  42. hdbc: ADDRESS): INTEGER;
  43. SQLAllocEnv: PROCEDURE {WINAPI} (
  44. henv: Kernel32.HANDLE): INTEGER;
  45. SQLAllocStmt: PROCEDURE {WINAPI} (
  46. hdbc: ADDRESS;
  47. hstmt: Kernel32.HANDLE): INTEGER;
  48. SQLBindCol: PROCEDURE {WINAPI} (
  49. hstmt: ADDRESS;
  50. icol: INTEGER;
  51. fcType: INTEGER;
  52. rgbValue: ADDRESS;
  53. cbValueMax: LONGINT;
  54. pcbValue: ADDRESS): INTEGER;
  55. SQLCancel: PROCEDURE {WINAPI} (
  56. hstmt: ADDRESS): INTEGER;
  57. SQLColAttributes: PROCEDURE {WINAPI} (
  58. hstmt: ADDRESS;
  59. icol: INTEGER;
  60. fDescType: INTEGER;
  61. rgbDesc: ADDRESS;
  62. cbDescMax: INTEGER;
  63. pcbDesc: ADDRESS;
  64. pfDesc: ADDRESS): INTEGER;
  65. SQLConnect: PROCEDURE {WINAPI} (
  66. hdbc: ADDRESS;
  67. DSN: ADDRESS;
  68. DSNMax: INTEGER;
  69. UID: ADDRESS;
  70. UIDMax: INTEGER;
  71. AuthStr: ADDRESS;
  72. AuthStrMax: INTEGER): INTEGER;
  73. SQLDescribeCol: PROCEDURE {WINAPI} (
  74. hstmt: ADDRESS;
  75. icol: INTEGER;
  76. szColName: ADDRESS;
  77. cbColNameMax: INTEGER;
  78. pcbColName: ADDRESS;
  79. pfSqlType: ADDRESS;
  80. pcbColDef: ADDRESS;
  81. pibScale: ADDRESS;
  82. pfNullable: ADDRESS): INTEGER;
  83. SQLDisconnect: PROCEDURE {WINAPI} (
  84. hdbc: Kernel32.HANDLE): INTEGER;
  85. SQLError: PROCEDURE {WINAPI} (
  86. henv: ADDRESS;
  87. hdbc: Kernel32.HANDLE;
  88. hstmt: Kernel32.HANDLE;
  89. szSqlState: ADDRESS;
  90. pfNativeError: ADDRESS;
  91. szErrorMessage: ADDRESS;
  92. cbErrorMessage: INTEGER;
  93. pcbErrorMessage: ADDRESS): INTEGER;
  94. SQLExecDirect: PROCEDURE {WINAPI} (
  95. hstmt: Kernel32.HANDLE;
  96. szSqlStr: ADDRESS;
  97. cbSqlStr: INTEGER): INTEGER;
  98. SQLExecute: PROCEDURE {WINAPI} (
  99. hstmt: Kernel32.HANDLE): INTEGER;
  100. SQLFetch: PROCEDURE {WINAPI} (
  101. hstmt: Kernel32.HANDLE): INTEGER;
  102. SQLFreeConnect: PROCEDURE {WINAPI} (
  103. hdbc: Kernel32.HANDLE): INTEGER;
  104. SQLFreeEnv: PROCEDURE {WINAPI} (
  105. henv: ADDRESS): INTEGER;
  106. SQLFreeStmt: PROCEDURE {WINAPI} (
  107. hstmt: Kernel32.HANDLE;
  108. fOption: INTEGER): INTEGER;
  109. SQLGetCursorName: PROCEDURE {WINAPI} (
  110. hstmt: Kernel32.HANDLE;
  111. szCursor: ADDRESS;
  112. cbCursorMax: INTEGER;
  113. pcbCursor: ADDRESS): INTEGER;
  114. SQLNumResultCols: PROCEDURE {WINAPI} (
  115. hstmt: Kernel32.HANDLE;
  116. pccol: ADDRESS): INTEGER;
  117. SQLPrepare: PROCEDURE {WINAPI} (
  118. hstmt: Kernel32.HANDLE;
  119. szSqlStr: ADDRESS;
  120. cbSqlStr: ADDRESS): INTEGER;
  121. SQLRowCount: PROCEDURE {WINAPI} (
  122. hstmt: Kernel32.HANDLE;
  123. pcrow: ADDRESS): INTEGER;
  124. SQLSetCursorName: PROCEDURE {WINAPI} (
  125. hstmt: Kernel32.HANDLE;
  126. szCursor: ADDRESS;
  127. cbCursor: INTEGER): INTEGER;
  128. SQLTransact: PROCEDURE {WINAPI} (
  129. henv: ADDRESS;
  130. hdbc: Kernel32.HANDLE;
  131. fType: INTEGER): INTEGER;
  132. (* Level 1 Functions *)
  133. SQLColumns: PROCEDURE {WINAPI} (
  134. hstmt: Kernel32.HANDLE;
  135. tableQualifier: ADDRESS;
  136. qualLen: INTEGER;
  137. tableOwner: ADDRESS;
  138. ownerLen: INTEGER;
  139. tableName: ADDRESS;
  140. nameLen: INTEGER;
  141. columnName: ADDRESS;
  142. colNameLen: INTEGER): INTEGER;
  143. SQLDriverConnect: PROCEDURE {WINAPI} (
  144. hdbc: Kernel32.HANDLE;
  145. hwnd: ADDRESS;
  146. connStrIn: ADDRESS;
  147. connStrInLen: INTEGER;
  148. connStrOut: ADDRESS;
  149. connStrOutMaxSize: INTEGER;
  150. connStrOutActSize: ADDRESS; (* address of integer containig result len *)
  151. driverCompletion: INTEGER): INTEGER;
  152. SQLGetConnectOption: PROCEDURE {WINAPI} (
  153. hdbc: Kernel32.HANDLE;
  154. whatOption: INTEGER;
  155. option: ADDRESS): INTEGER;
  156. SQLGetData: PROCEDURE {WINAPI} (
  157. hstmt: Kernel32.HANDLE;
  158. col: INTEGER;
  159. resType: INTEGER;
  160. resValue: ADDRESS;
  161. resMaxSize: LONGINT;
  162. resActSize: ADDRESS): INTEGER; (* address of longint containing result len *)
  163. SQLGetFunctions: PROCEDURE {WINAPI} (
  164. hdbc: Kernel32.HANDLE;
  165. whichFunction: INTEGER;
  166. functExists: ADDRESS): INTEGER;
  167. SQLGetInfo: PROCEDURE {WINAPI} (
  168. hdbc: Kernel32.HANDLE;
  169. infoType: INTEGER;
  170. resInfo: ADDRESS;
  171. resInfoMaxSize: INTEGER;
  172. resInfoActSize: ADDRESS): INTEGER; (* address of integer containing result len *)
  173. SQLGetStmtOption: PROCEDURE {WINAPI} (
  174. hstmt: Kernel32.HANDLE;
  175. whichOption: INTEGER;
  176. option: ADDRESS): INTEGER;
  177. SQLGetTypeInfo: PROCEDURE {WINAPI} (
  178. hstmt: Kernel32.HANDLE;
  179. whichType: INTEGER): INTEGER;
  180. SQLParamData: PROCEDURE {WINAPI} (
  181. hstmt: Kernel32.HANDLE;
  182. dataAdr: ADDRESS): INTEGER;
  183. SQLPutData: PROCEDURE {WINAPI} (
  184. hstmt: Kernel32.HANDLE;
  185. dataAdr: ADDRESS;
  186. dataSize: LONGINT): INTEGER;
  187. SQLSetConnectOption: PROCEDURE {WINAPI} (
  188. hdbc: Kernel32.HANDLE;
  189. whichOption: INTEGER;
  190. option: ADDRESS): INTEGER;
  191. SQLSetStmtOption: PROCEDURE {WINAPI} (
  192. hstmt: Kernel32.HANDLE;
  193. whichOption: INTEGER;
  194. option: ADDRESS): INTEGER;
  195. SQLSpecialColumns: PROCEDURE {WINAPI} (
  196. hstmt: Kernel32.HANDLE;
  197. whichColType: INTEGER;
  198. tableQualifier: ADDRESS;
  199. tabelQualifierLen: INTEGER;
  200. tableOwner: ADDRESS;
  201. tableOwnerLen: INTEGER;
  202. tableName: ADDRESS;
  203. tableNameLen: INTEGER;
  204. scope: INTEGER;
  205. nullableCols: INTEGER): INTEGER;
  206. SQLStatistics: PROCEDURE {WINAPI} (
  207. hstmt: Kernel32.HANDLE;
  208. tableQualifier: ADDRESS;
  209. tableQualifierLen: INTEGER;
  210. tableOwner: ADDRESS;
  211. tableOwnerLen: INTEGER;
  212. tableName: ADDRESS;
  213. tableNameLen: INTEGER;
  214. indexType: INTEGER;
  215. accuracy: INTEGER): INTEGER;
  216. SQLTables: PROCEDURE {WINAPI} (
  217. hstmt: Kernel32.HANDLE;
  218. tableQualifier: ADDRESS;
  219. tableQualifierLen: INTEGER;
  220. tableOwner: ADDRESS;
  221. tableOwnerLen: INTEGER;
  222. tableName: ADDRESS;
  223. tableNameLen: INTEGER;
  224. tableType: ADDRESS;
  225. tableTypeLen: INTEGER): INTEGER;
  226. (* Level 2 Functions *)
  227. SQLBrowseConnect: PROCEDURE {WINAPI} (
  228. hdbc: ADDRESS;
  229. connStrIn: ADDRESS;
  230. connStrInLen: INTEGER;
  231. connStrOut: ADDRESS;
  232. connStrOutMaxLen: INTEGER;
  233. connStrOutActLen: ADDRESS): INTEGER; (* address of integer *)
  234. SQLColumnPrivileges: PROCEDURE {WINAPI} (
  235. hstmt: ADDRESS;
  236. tableQualifier: ADDRESS;
  237. tableQualifierLen: INTEGER;
  238. tableOwner: ADDRESS;
  239. tableOwnerLen: INTEGER;
  240. tableName: ADDRESS;
  241. tableNameLen: INTEGER;
  242. columnName: ADDRESS;
  243. columnNameLen: INTEGER): INTEGER;
  244. SQLDataSources: PROCEDURE {WINAPI} (
  245. henv: ADDRESS;
  246. direction: INTEGER;
  247. dataSourceName: ADDRESS;
  248. dataSourceNameMaxLen: INTEGER;
  249. dataSourceNameActLen: ADDRESS; (* address of integer *)
  250. description: ADDRESS;
  251. descriptionMaxLen: INTEGER;
  252. descriptionActLen: ADDRESS): INTEGER; (* address of integer *)
  253. SQLDescribeParam: PROCEDURE {WINAPI} (
  254. hstmt: Kernel32.HANDLE;
  255. par: INTEGER;
  256. sqlType: ADDRESS; (* address of integer *)
  257. colPrecision: ADDRESS; (* address of longint *)
  258. colScale: ADDRESS; (* address of integer *)
  259. colNullable: ADDRESS): INTEGER; (* address of integer *)
  260. SQLExtendedFetch: PROCEDURE {WINAPI} (
  261. hstmt: Kernel32.HANDLE;
  262. fetchType: INTEGER;
  263. rowToFetch: LONGINT;
  264. numFetchedRows: ADDRESS; (* address of longint *)
  265. rowStatus: ADDRESS): INTEGER; (* address of array of integer *)
  266. SQLForeignKeys: PROCEDURE {WINAPI} (
  267. hstmt: Kernel32.HANDLE;
  268. primKeyTabQualifier: ADDRESS;
  269. primKeyTabQualifierLen: INTEGER;
  270. primKeyTabOwner: ADDRESS;
  271. primKeyTabOwnerLen: INTEGER;
  272. primKeyTabName: ADDRESS;
  273. primKeyTabNameLen: INTEGER;
  274. forKeyTabQualifier: ADDRESS;
  275. forKeyTabQualifierLen: INTEGER;
  276. forKeyTabOwner: ADDRESS;
  277. forKeyTabOwnerLen: INTEGER;
  278. forKeyTabName: ADDRESS;
  279. forKeyTabNameLen: INTEGER): INTEGER;
  280. SQLMoreResults: PROCEDURE {WINAPI} (
  281. hstmt: Kernel32.HANDLE): INTEGER;
  282. SQLNativeSql: PROCEDURE {WINAPI} (
  283. hdbc: Kernel32.HANDLE;
  284. sqlStrIn: ADDRESS;
  285. sqlStrInLen: LONGINT;
  286. sqlStrOut: ADDRESS;
  287. sqlStrOutMaxLen: LONGINT;
  288. sqlStrOutActLen: ADDRESS): INTEGER; (* address of longint *)
  289. SQLNumParams: PROCEDURE {WINAPI} (
  290. hstmt: Kernel32.HANDLE;
  291. numParams: ADDRESS): INTEGER; (* address of integer *)
  292. SQLParamOptions: PROCEDURE {WINAPI} (
  293. hstmt: Kernel32.HANDLE;
  294. numRows: LONGINT;
  295. curRow: ADDRESS): INTEGER; (* address of longint *)
  296. SQLPrimaryKeys: PROCEDURE {WINAPI} (
  297. hstmt: Kernel32.HANDLE;
  298. tableQualifier: ADDRESS;
  299. tableQualifierLen: INTEGER;
  300. tableOwner: ADDRESS;
  301. tableOwnerLen: INTEGER;
  302. tableName: ADDRESS;
  303. tableNameLen: INTEGER): INTEGER;
  304. SQLProcedureColumns: PROCEDURE {WINAPI} (
  305. hstmt: Kernel32.HANDLE;
  306. procQualifier: ADDRESS;
  307. procQualifierLen: INTEGER;
  308. procOwner: ADDRESS;
  309. procOwnerLen: INTEGER;
  310. procName: ADDRESS;
  311. procNameLen: INTEGER;
  312. columnName: ADDRESS;
  313. columnNameLen: INTEGER): INTEGER;
  314. SQLProcedures: PROCEDURE {WINAPI} (
  315. hstmt: Kernel32.HANDLE;
  316. procQualifier: ADDRESS;
  317. procQualifierLen: INTEGER;
  318. procOwner: ADDRESS;
  319. procOwnerLen: INTEGER;
  320. procName: ADDRESS;
  321. procNameLen: INTEGER): INTEGER;
  322. SQLSetPos: PROCEDURE {WINAPI} (
  323. hstmt: Kernel32.HANDLE;
  324. row: INTEGER;
  325. op: INTEGER;
  326. lock: INTEGER): INTEGER;
  327. SQLTablePrivileges: PROCEDURE {WINAPI} (
  328. hstmt: Kernel32.HANDLE;
  329. tableQualifier: ADDRESS;
  330. tableQualifierLen: INTEGER;
  331. tableOwner: ADDRESS;
  332. tableOwnerLen: INTEGER;
  333. tableName: ADDRESS;
  334. tableNameLen: INTEGER): INTEGER;
  335. SQLDrivers: PROCEDURE {WINAPI} (
  336. henv: ADDRESS;
  337. direction: INTEGER;
  338. driverDesc: ADDRESS;
  339. driverDescMaxLen: INTEGER;
  340. driverDescActLen: ADDRESS; (* address of integer *)
  341. driverAttributes: ADDRESS;
  342. driverAttributesMaxLen: INTEGER;
  343. driverAttributesActLen: ADDRESS): INTEGER; (* address of integer *)
  344. SQLBindParameter: PROCEDURE {WINAPI} (
  345. hstmt: ADDRESS;
  346. parNum: INTEGER;
  347. paramType: INTEGER;
  348. cType: INTEGER;
  349. sqlType: INTEGER;
  350. colPrec: LONGINT;
  351. colScale: INTEGER;
  352. inOutBuff: ADDRESS;
  353. inOutBuffMaxLen: LONGINT;
  354. inOutBuffActLen: ADDRESS): INTEGER; (* address of longint *)
  355. (* Level 3 functions *)
  356. SQLFetchScroll: PROCEDURE {WINAPI} (
  357. hstmt: ADDRESS;
  358. fetchorientation: INTEGER;
  359. fetchoffset: LONGINT): INTEGER;
  360. SQLSetStmtAttr: PROCEDURE {WINAPI} (
  361. hstmt: ADDRESS;
  362. attribute: LONGINT;
  363. value: LONGINT;
  364. stringlength: LONGINT): INTEGER;
  365. SQLSetConnectAttr: PROCEDURE {WINAPI} (
  366. hdbc: ADDRESS;
  367. attribute: LONGINT;
  368. valuePtr: LONGINT;
  369. stringLength: LONGINT): INTEGER;
  370. (* -------------------------- interface to core functions -------------------------- *)
  371. PROCEDURE AllocConnect*(hdbc: HDBC; VAR res: INTEGER);
  372. BEGIN
  373. res:= SQLAllocConnect(env.henv, ADDRESSOF(hdbc.hdbc));
  374. END AllocConnect;
  375. (* don't export AllocEnv as it's called in module initialization *)
  376. PROCEDURE AllocEnv(henv: HENV; VAR res: INTEGER);
  377. BEGIN
  378. res:= SQLAllocEnv(ADDRESSOF(henv.henv));
  379. END AllocEnv;
  380. PROCEDURE AllocStmt*(hdbc: HDBC; hstmt: HSTMT; VAR res: INTEGER);
  381. BEGIN
  382. res:= SQLAllocStmt(hdbc.hdbc, ADDRESSOF(hstmt.hstmt));
  383. END AllocStmt;
  384. PROCEDURE BindCol*(hstmt: HSTMT; col, retType: INTEGER; VAR buf: ARRAY OF S.BYTE; VAR resSize: LONGINT;
  385. VAR res: INTEGER);
  386. BEGIN
  387. res:= SQLBindCol(hstmt.hstmt, col, retType, ADDRESSOF(buf), LEN(buf), ADDRESSOF(resSize));
  388. END BindCol;
  389. PROCEDURE Cancel*(hstmt: HSTMT; VAR res: INTEGER);
  390. BEGIN
  391. res:= SQLCancel(hstmt.hstmt);
  392. END Cancel;
  393. PROCEDURE ColAttributes*(hstmt: HSTMT; col, fDescType: INTEGER; VAR rgbDesc: ARRAY OF CHAR; VAR pfDesc: ADDRESS;
  394. VAR res: INTEGER);
  395. VAR DescLen: INTEGER;
  396. BEGIN
  397. res:= SQLColAttributes(hstmt.hstmt, col, fDescType, ADDRESSOF(rgbDesc), SHORT(LEN(rgbDesc)),
  398. ADDRESSOF(DescLen), ADDRESSOF(pfDesc));
  399. END ColAttributes;
  400. PROCEDURE Connect*(hdbc: HDBC; DSN, UID, PW: ARRAY OF CHAR; VAR res: INTEGER);
  401. BEGIN
  402. res:= SQLConnect(hdbc.hdbc, ADDRESSOF(DSN), NTS, ADDRESSOF(UID), NTS, ADDRESSOF(PW), NTS);
  403. END Connect;
  404. PROCEDURE DescribeCol*(hstmt: HSTMT; icol: INTEGER; VAR ColName: ARRAY OF CHAR;VAR SqlType: INTEGER;
  405. VAR ColDef: LONGINT; VAR Scale: INTEGER; VAR Nullable: BOOLEAN; VAR res: INTEGER);
  406. VAR colLen, null: INTEGER;
  407. BEGIN
  408. res:= SQLDescribeCol(hstmt.hstmt, icol, ADDRESSOF(ColName), SHORT(LEN(ColName)), ADDRESSOF(colLen),
  409. ADDRESSOF(SqlType), ADDRESSOF(ColDef), ADDRESSOF(Scale), ADDRESSOF(null));
  410. Nullable:= (null # 0);
  411. END DescribeCol;
  412. PROCEDURE Disconnect*(hdbc: HDBC; VAR res: INTEGER);
  413. BEGIN
  414. res:= SQLDisconnect(hdbc.hdbc);
  415. END Disconnect;
  416. PROCEDURE StatementError*(hstmt: HSTMT; VAR SqlState: ARRAY OF CHAR; VAR NativeError: LONGINT;
  417. VAR ErrorMsg: ARRAY OF CHAR; VAR res: INTEGER);
  418. VAR state: ARRAY 6 OF CHAR; len, msgSize: INTEGER;
  419. BEGIN
  420. len:= SHORT(MIN(MAXMESSAGELENGTH-1, LEN(ErrorMsg)));
  421. res:= SQLError(0, 0, hstmt.hstmt, ADDRESSOF(state), ADDRESSOF(NativeError), ADDRESSOF(ErrorMsg), len,
  422. ADDRESSOF(msgSize));
  423. COPY (state, SqlState);
  424. END StatementError;
  425. PROCEDURE ConnectionError*(hdbc: HDBC; VAR SqlState: ARRAY OF CHAR; VAR NativeError: LONGINT;
  426. ErrorMsg: ARRAY OF CHAR; VAR res: INTEGER);
  427. VAR state: ARRAY 6 OF CHAR; len, msgSize: INTEGER;
  428. BEGIN
  429. len:= SHORT(MIN(MAXMESSAGELENGTH-1, LEN(ErrorMsg)));
  430. IF hdbc # NIL THEN
  431. res:= SQLError(0, hdbc.hdbc, 0, ADDRESSOF(state), ADDRESSOF(NativeError), ADDRESSOF(ErrorMsg), len, ADDRESSOF(msgSize))
  432. ELSE
  433. res:= SQLError(env.henv, 0, 0, ADDRESSOF(state), ADDRESSOF(NativeError), ADDRESSOF(ErrorMsg), len, ADDRESSOF(msgSize))
  434. END;
  435. COPY (state, SqlState)
  436. END ConnectionError;
  437. PROCEDURE ExecDirect*(hstmt: HSTMT; SqlStr: ARRAY OF CHAR; VAR res: INTEGER);
  438. BEGIN
  439. res:= SQLExecDirect(hstmt.hstmt, ADDRESSOF(SqlStr), NTS)
  440. END ExecDirect;
  441. PROCEDURE Execute*(hstmt: HSTMT; VAR res: INTEGER);
  442. BEGIN
  443. res:= SQLExecute(hstmt.hstmt)
  444. END Execute;
  445. PROCEDURE Fetch*(hstmt: HSTMT; VAR res: INTEGER);
  446. BEGIN
  447. res:= SQLFetch(hstmt.hstmt)
  448. END Fetch;
  449. PROCEDURE FreeConnect*(hdbc: HDBC; VAR res: INTEGER);
  450. BEGIN
  451. res:= SQLFreeConnect(hdbc.hdbc)
  452. END FreeConnect;
  453. (* don't expor FreeEnv as it's called in the teminate procedure *)
  454. PROCEDURE FreeEnv(henv: HENV; VAR res: INTEGER);
  455. BEGIN
  456. res:= SQLFreeEnv(henv.henv)
  457. END FreeEnv;
  458. PROCEDURE FreeStmt*(hstmt: HSTMT; opt: INTEGER; VAR res: INTEGER);
  459. BEGIN
  460. res:= SQLFreeStmt(hstmt.hstmt, opt)
  461. END FreeStmt;
  462. PROCEDURE GetCursorName*(hstmt: HSTMT; VAR Cursor: ARRAY OF CHAR; VAR res: INTEGER);
  463. VAR size: INTEGER;
  464. BEGIN
  465. res:= SQLGetCursorName(hstmt.hstmt, ADDRESSOF(Cursor), SHORT(LEN(Cursor)), ADDRESSOF(size))
  466. END GetCursorName;
  467. PROCEDURE NumResultCols*(hstmt: HSTMT; VAR cols: INTEGER; VAR res: INTEGER);
  468. BEGIN
  469. res:= SQLNumResultCols(hstmt.hstmt, ADDRESSOF(cols))
  470. END NumResultCols;
  471. PROCEDURE Prepare*(hstmt: HSTMT; SqlStr: ARRAY OF CHAR; VAR res: INTEGER);
  472. BEGIN
  473. res:= SQLPrepare(hstmt.hstmt, ADDRESSOF(SqlStr), NTS)
  474. END Prepare;
  475. PROCEDURE RowCount*(hstmt: HSTMT; VAR rows: LONGINT; VAR res: INTEGER);
  476. BEGIN
  477. res:= SQLRowCount(hstmt.hstmt, ADDRESSOF(rows))
  478. END RowCount;
  479. PROCEDURE SetCursorName*(hstmt: HSTMT; Cursor: ARRAY OF CHAR; VAR res: INTEGER);
  480. BEGIN
  481. res:= SQLSetCursorName(hstmt.hstmt, ADDRESSOF(Cursor), NTS)
  482. END SetCursorName;
  483. PROCEDURE Commit*(hdbc: HDBC; VAR res: INTEGER);
  484. BEGIN
  485. res:= SQLTransact(0, hdbc.hdbc, 0)
  486. END Commit;
  487. PROCEDURE Rollback*(hdbc: HDBC; VAR res: INTEGER);
  488. BEGIN
  489. res:= SQLTransact(0, hdbc.hdbc, 1)
  490. END Rollback;
  491. (* -------------------------- interface to level 1 functions -------------------------- *)
  492. PROCEDURE Columns*(hstmt: HSTMT; tabQualifier, tabOwner, tabName, colName: ARRAY OF CHAR; VAR res: INTEGER): INTEGER;
  493. VAR qualAdr, ownAdr, nameAdr, colAdr: ADDRESS; qualLen, ownLen, nameLen, colLen: INTEGER;
  494. BEGIN
  495. (* should be possible to pass NIL for the 4 arrays *)
  496. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  497. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  498. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  499. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  500. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  501. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  502. IF (LEN(colName) = 1) & (colName[0] = 1X) THEN colAdr:= 0; colLen:= 0
  503. ELSE colAdr:= ADDRESSOF(colName); colLen:= NTS END;
  504. res:= SQLColumns(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen, colAdr, colLen)
  505. END Columns;
  506. PROCEDURE DriverConnect*(hdbc: HDBC; VAR connStrIn, connStrOut: ARRAY OF CHAR; VAR res: INTEGER);
  507. VAR connOutSize: INTEGER;
  508. BEGIN
  509. res:= SQLDriverConnect(hdbc.hdbc, 0, ADDRESSOF(connStrIn), NTS, ADDRESSOF(connStrOut), SHORT(LEN(connStrOut)),
  510. ADDRESSOF(connOutSize), 0) (* don't show a dialog box *)
  511. END DriverConnect;
  512. PROCEDURE GetConnectOption*(hdbc: HDBC; whichOption: INTEGER; VAR optValue: ARRAY OF S.BYTE; VAR res: INTEGER);
  513. BEGIN
  514. res:= SQLGetConnectOption(hdbc.hdbc, whichOption, ADDRESSOF(optValue))
  515. END GetConnectOption;
  516. PROCEDURE GetData*(hstmt: HSTMT; col, resType: INTEGER; VAR resValue: ARRAY OF S.BYTE; VAR resSize: LONGINT;
  517. VAR res: INTEGER);
  518. BEGIN
  519. res:= SQLGetData(hstmt.hstmt, col, resType, ADDRESSOF(resValue), LEN(resValue), ADDRESSOF(resSize))
  520. END GetData;
  521. PROCEDURE GetFunctions*(hdbc: HDBC; whichFunct: INTEGER; VAR exists: BOOLEAN; VAR res: INTEGER);
  522. VAR ex: INTEGER;
  523. BEGIN
  524. res:= SQLGetFunctions(hdbc.hdbc, whichFunct, ADDRESSOF(ex)); exists:= ex # 0
  525. END GetFunctions;
  526. PROCEDURE GetInfo*(hdbc: HDBC; infoType: INTEGER; VAR info: ARRAY OF S.BYTE; VAR res: INTEGER);
  527. VAR actSize: INTEGER;
  528. BEGIN
  529. (* should check that the size of info is at least 4 bytes if infoType not of character type *)
  530. res:= SQLGetInfo(hdbc.hdbc, infoType, ADDRESSOF(info), SHORT(LEN(info)), ADDRESSOF(actSize))
  531. END GetInfo;
  532. PROCEDURE GetStmtOption*(hstmt: HSTMT; whichOption: INTEGER; VAR optValue: ARRAY OF S.BYTE; VAR res: INTEGER);
  533. BEGIN
  534. (* size of optValue should be at least 4 bytes *)
  535. res:= SQLGetStmtOption(hstmt.hstmt, whichOption, ADDRESSOF(optValue))
  536. END GetStmtOption;
  537. PROCEDURE GetTypeInfo*(hstmt: HSTMT; whichSQLType: INTEGER; VAR res: INTEGER);
  538. BEGIN
  539. res:= SQLGetTypeInfo(hstmt.hstmt, whichSQLType)
  540. END GetTypeInfo;
  541. PROCEDURE ParamData*(hstmt: HSTMT; VAR data:ARRAY OF S.BYTE; VAR res: INTEGER);
  542. BEGIN
  543. res:= SQLParamData(hstmt.hstmt, ADDRESSOF(data))
  544. END ParamData;
  545. PROCEDURE PutData*(hstmt: HSTMT; VAR data: ARRAY OF S.BYTE; len: LONGINT; VAR res: INTEGER);
  546. BEGIN
  547. res:= SQLPutData(hstmt.hstmt, ADDRESSOF(data), len)
  548. END PutData;
  549. PROCEDURE SetConnectOption*(hdbc: HDBC; whichOpt: INTEGER; VAR option: ARRAY OF S.BYTE; VAR res: INTEGER);
  550. BEGIN
  551. res:= SQLSetConnectOption(hdbc.hdbc, whichOpt, ADDRESSOF(option))
  552. END SetConnectOption;
  553. PROCEDURE SetStmtOption*(hstmt: HSTMT; whichOpt: INTEGER; VAR option: ARRAY OF S.BYTE; VAR res: INTEGER);
  554. BEGIN
  555. res:= SQLSetStmtOption(hstmt.hstmt, whichOpt, ADDRESSOF(option))
  556. END SetStmtOption;
  557. PROCEDURE SpecialColumns*(hstmt: HSTMT; colType: INTEGER; tabQualifier, tabOwner, tabName: ARRAY OF CHAR;
  558. scope: INTEGER; nullables: BOOLEAN; VAR res: INTEGER);
  559. VAR nulls: INTEGER; qualAdr, ownAdr, nameAdr: ADDRESS; qualLen, ownLen, nameLen: INTEGER;
  560. BEGIN
  561. IF nullables THEN nulls:= 1 ELSE nulls:= 0 END;
  562. (* should be possible to pass NIL for the 3 arrays *)
  563. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  564. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  565. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  566. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  567. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  568. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  569. res:= SQLSpecialColumns(hstmt.hstmt, colType, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen, scope, nulls)
  570. END SpecialColumns;
  571. PROCEDURE Statistics*(hstmt: HSTMT; tabQualifier, tabOwner, tabName: ARRAY OF CHAR; uniqueIndexes,
  572. accurate: BOOLEAN; VAR res: INTEGER);
  573. VAR indexType, accuracy: INTEGER; qualAdr, ownAdr, nameAdr: ADDRESS; qualLen, ownLen, nameLen: INTEGER;
  574. BEGIN
  575. IF uniqueIndexes THEN indexType:= 0 ELSE indexType:= 1 END;
  576. IF accurate THEN accuracy:= 1 ELSE accuracy:= 0 END;
  577. (* should be possible to pass NIL for the 3 arrays *)
  578. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  579. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  580. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  581. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  582. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  583. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  584. res:= SQLStatistics(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen, indexType, accuracy)
  585. END Statistics;
  586. PROCEDURE Tables*(hstmt: HSTMT; tabQualifier, tabOwner, tabName, tabType: ARRAY OF CHAR; VAR res: INTEGER);
  587. VAR qualAdr, ownAdr, nameAdr, typeAdr: ADDRESS; qualLen, ownLen, nameLen, typeLen: INTEGER;
  588. BEGIN
  589. (* should be possible to pass NIL for the 4 tab... arrays *)
  590. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  591. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  592. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  593. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  594. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  595. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  596. IF (LEN(tabType) = 1) & (tabType[0] = 1X) THEN typeAdr:= 0; typeLen:= 0
  597. ELSE typeAdr:= ADDRESSOF(tabType); typeLen:= NTS END;
  598. res:= SQLTables(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen, typeAdr, typeLen)
  599. END Tables;
  600. (* -------------------------- interface to level 2 functions -------------------------- *)
  601. PROCEDURE BrowseConnect*(hdbc: HDBC; connStrIn: ARRAY OF CHAR; VAR connStrOut: ARRAY OF CHAR; VAR res: INTEGER);
  602. VAR outLen: INTEGER;
  603. BEGIN
  604. res:= SQLBrowseConnect(hdbc.hdbc, ADDRESSOF(connStrIn), NTS, ADDRESSOF(connStrOut), SHORT(LEN(connStrOut)),
  605. ADDRESSOF(outLen))
  606. END BrowseConnect;
  607. PROCEDURE ColumnPrivileges*(hstmt: HSTMT; tabQualifier, tabOwner, tabName, colName: ARRAY OF CHAR; VAR res: INTEGER);
  608. VAR qualAdr, ownAdr, nameAdr, colAdr: ADDRESS; qualLen, ownLen, nameLen, colLen: INTEGER;
  609. BEGIN
  610. (* should be possible to pass NIL for the 4 arrays *)
  611. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  612. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  613. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  614. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  615. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  616. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  617. IF (LEN(colName) = 1) & (colName[0] = 1X) THEN colAdr:= 0; colLen:= 0
  618. ELSE colAdr:= ADDRESSOF(colName); colLen:= NTS END;
  619. res:= SQLColumnPrivileges(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen, colAdr, colLen)
  620. END ColumnPrivileges;
  621. PROCEDURE DataSources*(direction: INTEGER; VAR dataSourceName, dataSourceDesc: ARRAY OF CHAR; VAR res: INTEGER);
  622. VAR nameLen, descLen: INTEGER;
  623. BEGIN
  624. (* could implement it with enumerate procedure *)
  625. res:= SQLDataSources(env.henv, direction, ADDRESSOF(dataSourceName), SHORT(LEN(dataSourceName)),
  626. ADDRESSOF(nameLen), ADDRESSOF(dataSourceDesc), SHORT(LEN(dataSourceDesc)), ADDRESSOF(descLen))
  627. END DataSources;
  628. PROCEDURE DescribeParam*(hstmt: HSTMT; par: INTEGER; VAR sqlType: INTEGER; VAR prec: LONGINT; VAR scale,
  629. nullable: INTEGER; VAR res: INTEGER);
  630. BEGIN
  631. res:= SQLDescribeParam(hstmt.hstmt, par, ADDRESSOF(sqlType), ADDRESSOF(prec), ADDRESSOF(scale),
  632. ADDRESSOF(nullable))
  633. END DescribeParam;
  634. PROCEDURE ExtendedFetch*(hstmt: HSTMT; fetchType: INTEGER; rowToFetch: LONGINT; VAR numFetchedRows: LONGINT;
  635. VAR rowStatus: INTEGER; VAR res: INTEGER);
  636. BEGIN
  637. res:= SQLExtendedFetch(hstmt.hstmt, fetchType, rowToFetch, ADDRESSOF(numFetchedRows), ADDRESSOF(rowStatus))
  638. END ExtendedFetch;
  639. PROCEDURE SetStmtAttr*(hstmt: HSTMT; attribute: LONGINT; valuePtr: LONGINT; stringLength: LONGINT; VAR res: INTEGER);
  640. BEGIN
  641. res:= SQLSetStmtAttr(hstmt.hstmt, attribute, valuePtr, stringLength)
  642. END SetStmtAttr;
  643. PROCEDURE ForeignKeys*(hstmt: HSTMT; primKeyTabQualifier, primKeyTabOwner, primKeyTabName, forKeyTabQualifier,
  644. forKeyTabOwner, forKeyTabName: ARRAY OF CHAR; VAR res: INTEGER);
  645. VAR pQualAdr, pOwnAdr, pNameAdr: ADDRESS; pQualLen, pOwnLen, pNameLen: INTEGER;
  646. fQualAdr, fOwnAdr, fNameAdr: ADDRESS; fQualLen, fOwnLen, fNameLen: INTEGER;
  647. BEGIN
  648. (* should be possible to pass NIL for the 6 arrays *)
  649. IF (LEN(primKeyTabQualifier) = 1) & (primKeyTabQualifier[0] = 1X) THEN pQualAdr:= 0; pQualLen:= 0
  650. ELSE pQualAdr:= ADDRESSOF(primKeyTabQualifier); pQualLen:= NTS END;
  651. IF (LEN(primKeyTabOwner) = 1) & (primKeyTabOwner[0] = 1X) THEN pOwnAdr:= 0; pOwnLen:= 0
  652. ELSE pOwnAdr:= ADDRESSOF(primKeyTabOwner); pOwnLen:= NTS END;
  653. IF (LEN(primKeyTabName) = 1) & (primKeyTabName[0] = 1X) THEN pNameAdr:= 0; pNameLen:= 0
  654. ELSE pNameAdr:= ADDRESSOF(primKeyTabName); pNameLen:= NTS END;
  655. IF (LEN(forKeyTabQualifier) = 1) & (forKeyTabQualifier[0] = 1X) THEN fQualAdr:= 0; fQualLen:= 0
  656. ELSE fQualAdr:= ADDRESSOF(forKeyTabQualifier); fQualLen:= NTS END;
  657. IF (LEN(forKeyTabOwner) = 1) & (forKeyTabOwner[0] = 1X) THEN fOwnAdr:= 0; fOwnLen:= 0
  658. ELSE fOwnAdr:= ADDRESSOF(forKeyTabOwner); fOwnLen:= NTS END;
  659. IF (LEN(forKeyTabName) = 1) & (forKeyTabName[0] = 1X) THEN fNameAdr:= 0; fNameLen:= 0
  660. ELSE fNameAdr:= ADDRESSOF(forKeyTabName); fNameLen:= NTS END;
  661. res:= SQLForeignKeys(hstmt.hstmt, pQualAdr, pQualLen, pOwnAdr, pOwnLen, pNameAdr, pNameLen, fQualAdr,
  662. fQualLen, fOwnAdr, fOwnLen, fNameAdr, fNameLen)
  663. END ForeignKeys;
  664. PROCEDURE MoreResults*(hstmt: HSTMT): BOOLEAN;
  665. VAR more: INTEGER;
  666. BEGIN
  667. more:= SQLMoreResults(hstmt.hstmt);
  668. IF more = 0 THEN RETURN TRUE ELSE RETURN FALSE END
  669. END MoreResults;
  670. PROCEDURE NativeSql*(hdbc: HDBC; origSql: ARRAY OF CHAR; VAR nativeSql: ARRAY OF CHAR; VAR res: INTEGER);
  671. VAR len: LONGINT;
  672. BEGIN
  673. res:= SQLNativeSql(hdbc.hdbc, ADDRESSOF(origSql), NTS, ADDRESSOF(nativeSql), LEN(nativeSql), ADDRESSOF(len))
  674. END NativeSql;
  675. PROCEDURE NumParams*(hstmt: HSTMT; VAR res: INTEGER): INTEGER;
  676. VAR num: INTEGER;
  677. BEGIN
  678. res:= SQLNumParams(hstmt.hstmt, ADDRESSOF(num));
  679. RETURN num
  680. END NumParams;
  681. PROCEDURE ParamOptions*(hstmt: HSTMT; numRows: LONGINT; VAR curRow: LONGINT; VAR res: INTEGER);
  682. BEGIN
  683. res:= SQLParamOptions(hstmt.hstmt, numRows, ADDRESSOF(curRow))
  684. END ParamOptions;
  685. PROCEDURE PrimaryKeys*(hstmt: HSTMT; tabQualifier, tabOwner, tabName: ARRAY OF CHAR; VAR res: INTEGER);
  686. VAR qualAdr, ownAdr, nameAdr: ADDRESS; qualLen, ownLen, nameLen: INTEGER;
  687. BEGIN
  688. (* should be possible to pass NIL for the 3 arrays *)
  689. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  690. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  691. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  692. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  693. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  694. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  695. res:= SQLPrimaryKeys(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen)
  696. END PrimaryKeys;
  697. PROCEDURE ProcedureColumns*(hstmt: HSTMT; procQualifier, procOwner, procName, colName: ARRAY OF CHAR; VAR res: INTEGER);
  698. VAR qualAdr, ownAdr, nameAdr, colAdr: ADDRESS; qualLen, ownLen, nameLen, colLen: INTEGER;
  699. BEGIN
  700. (* should be possible to pass NIL for the 4 arrays *)
  701. IF (LEN(procQualifier) = 1) & (procQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  702. ELSE qualAdr:= ADDRESSOF(procQualifier); qualLen:= NTS END;
  703. IF (LEN(procOwner) = 1) & (procOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  704. ELSE ownAdr:= ADDRESSOF(procOwner); ownLen:= NTS END;
  705. IF (LEN(procName) = 1) & (procName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  706. ELSE nameAdr:= ADDRESSOF(procName); nameLen:= NTS END;
  707. IF (LEN(colName) = 1) & (colName[0] = 1X) THEN colAdr:= 0; colLen:= 0
  708. ELSE colAdr:= ADDRESSOF(colName); colLen:= NTS END;
  709. res:= SQLProcedureColumns(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen, colAdr, colLen)
  710. END ProcedureColumns;
  711. PROCEDURE Procedures*(hstmt: HSTMT; procQualifier, procOwner, procName: ARRAY OF CHAR; VAR res: INTEGER);
  712. VAR qualAdr, ownAdr, nameAdr: ADDRESS; qualLen, ownLen, nameLen: INTEGER;
  713. BEGIN
  714. (* should be possible to pass NIL for the 3 arrays *)
  715. IF (LEN(procQualifier) = 1) & (procQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  716. ELSE qualAdr:= ADDRESSOF(procQualifier); qualLen:= NTS END;
  717. IF (LEN(procOwner) = 1) & (procOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  718. ELSE ownAdr:= ADDRESSOF(procOwner); ownLen:= NTS END;
  719. IF (LEN(procName) = 1) & (procName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  720. ELSE nameAdr:= ADDRESSOF(procName); nameLen:= NTS END;
  721. res:= SQLProcedures(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen)
  722. END Procedures;
  723. PROCEDURE SetPos*(hstmt: HSTMT; row, op, lock: INTEGER; VAR res: INTEGER);
  724. BEGIN
  725. res:= SQLSetPos(hstmt.hstmt, row, op, lock)
  726. END SetPos;
  727. PROCEDURE TablePrivileges*(hstmt: HSTMT; tabQualifier, tabOwner, tabName: ARRAY OF CHAR; VAR res: INTEGER);
  728. VAR qualAdr, ownAdr, nameAdr: ADDRESS; qualLen, ownLen, nameLen: INTEGER;
  729. BEGIN
  730. (* should be possible to pass NIL for the 3 arrays *)
  731. IF (LEN(tabQualifier) = 1) & (tabQualifier[0] = 1X) THEN qualAdr:= 0; qualLen:= 0
  732. ELSE qualAdr:= ADDRESSOF(tabQualifier); qualLen:= NTS END;
  733. IF (LEN(tabOwner) = 1) & (tabOwner[0] = 1X) THEN ownAdr:= 0; ownLen:= 0
  734. ELSE ownAdr:= ADDRESSOF(tabOwner); ownLen:= NTS END;
  735. IF (LEN(tabName) = 1) & (tabName[0] = 1X) THEN nameAdr:= 0; nameLen:= 0
  736. ELSE nameAdr:= ADDRESSOF(tabName); nameLen:= NTS END;
  737. res:= SQLTablePrivileges(hstmt.hstmt, qualAdr, qualLen, ownAdr, ownLen, nameAdr, nameLen)
  738. END TablePrivileges;
  739. PROCEDURE Drivers*(dir: INTEGER; VAR driverDesc, driverAttr: ARRAY OF CHAR; VAR res: INTEGER);
  740. VAR descLen, attrLen: INTEGER;
  741. BEGIN
  742. res:= SQLDrivers(env.henv, dir, ADDRESSOF(driverDesc), SHORT(LEN(driverDesc)), ADDRESSOF(descLen),
  743. ADDRESSOF(driverAttr), SHORT(LEN(driverAttr)), ADDRESSOF(attrLen))
  744. END Drivers;
  745. PROCEDURE BindParameter*(hstmt: HSTMT; par, parType, cType, sqlType: INTEGER; prec: LONGINT; scale: INTEGER;
  746. VAR parBuff: ARRAY OF S.BYTE; VAR parBuffActLen: LONGINT; VAR res: INTEGER);
  747. BEGIN
  748. res:= SQLBindParameter(hstmt.hstmt, par, parType, cType, sqlType, prec, scale, ADDRESSOF(parBuff), LEN(parBuff),
  749. ADDRESSOF(parBuffActLen))
  750. END BindParameter;
  751. (* Interface to Level 3 fucntions *)
  752. PROCEDURE FetchScroll*(hstmt: HSTMT; fetchOrientation: INTEGER; fetchOffset: LONGINT; VAR res: INTEGER);
  753. BEGIN
  754. res := SQLFetchScroll(hstmt.hstmt, fetchOrientation, fetchOffset)
  755. END FetchScroll;
  756. PROCEDURE SetConnectAttr*(hdbc: HDBC; attribute: LONGINT; valuePtr: LONGINT; stringLength: LONGINT; VAR res: INTEGER);
  757. BEGIN
  758. res := SQLSetConnectAttr(hdbc.hdbc, attribute, valuePtr, stringLength)
  759. END SetConnectAttr;
  760. (* -------------------------- internal procedures -------------------------- *)
  761. PROCEDURE Init;
  762. VAR str: ARRAY 64 OF CHAR;
  763. BEGIN
  764. str := "ODBC32.DLL";
  765. lib:= Kernel32.LoadLibrary(str); (* Was just ODBC32.DLL *)
  766. IF lib = 0 THEN HALT(99) END;
  767. (* binding core functions *)
  768. Kernel32.GetProcAddress(lib, "SQLAllocConnect", S.VAL(ADDRESS, SQLAllocConnect));
  769. Kernel32.GetProcAddress(lib, "SQLAllocEnv", S.VAL(ADDRESS, SQLAllocEnv));
  770. Kernel32.GetProcAddress(lib, "SQLAllocStmt", S.VAL(ADDRESS, SQLAllocStmt));
  771. Kernel32.GetProcAddress(lib, "SQLBindCol", S.VAL(ADDRESS, SQLBindCol));
  772. Kernel32.GetProcAddress(lib, "SQLCancel", S.VAL(ADDRESS, SQLCancel));
  773. Kernel32.GetProcAddress(lib, "SQLColAttributes", S.VAL(ADDRESS, SQLColAttributes));
  774. Kernel32.GetProcAddress(lib, "SQLConnect", S.VAL(ADDRESS, SQLConnect));
  775. Kernel32.GetProcAddress(lib, "SQLDescribeCol", S.VAL(ADDRESS, SQLDescribeCol));
  776. Kernel32.GetProcAddress(lib, "SQLDisconnect", S.VAL(ADDRESS, SQLDisconnect));
  777. Kernel32.GetProcAddress(lib, "SQLError", S.VAL(ADDRESS, SQLError));
  778. Kernel32.GetProcAddress(lib, "SQLExecDirect", S.VAL(ADDRESS, SQLExecDirect));
  779. Kernel32.GetProcAddress(lib, "SQLExecute", S.VAL(ADDRESS, SQLExecute));
  780. Kernel32.GetProcAddress(lib, "SQLFetch", S.VAL(ADDRESS, SQLFetch));
  781. Kernel32.GetProcAddress(lib, "SQLFreeConnect", S.VAL(ADDRESS, SQLFreeConnect));
  782. Kernel32.GetProcAddress(lib, "SQLFreeEnv", S.VAL(ADDRESS, SQLFreeEnv));
  783. Kernel32.GetProcAddress(lib, "SQLFreeStmt", S.VAL(ADDRESS, SQLFreeStmt));
  784. Kernel32.GetProcAddress(lib, "SQLGetCursorName", S.VAL(ADDRESS, SQLGetCursorName));
  785. Kernel32.GetProcAddress(lib, "SQLNumResultCols", S.VAL(ADDRESS, SQLNumResultCols));
  786. Kernel32.GetProcAddress(lib, "SQLPrepare", S.VAL(ADDRESS, SQLPrepare));
  787. Kernel32.GetProcAddress(lib, "SQLRowCount", S.VAL(ADDRESS, SQLRowCount));
  788. Kernel32.GetProcAddress(lib, "SQLSetCursorName", S.VAL(ADDRESS, SQLSetCursorName));
  789. Kernel32.GetProcAddress(lib, "SQLTransact", S.VAL(ADDRESS, SQLTransact));
  790. (* binding level 1 functions *)
  791. Kernel32.GetProcAddress(lib, "SQLColumns", S.VAL(ADDRESS, SQLColumns));
  792. Kernel32.GetProcAddress(lib, "SQLDriverConnect", S.VAL(ADDRESS, SQLDriverConnect));
  793. Kernel32.GetProcAddress(lib, "SQLGetConnectOption", S.VAL(ADDRESS, SQLGetConnectOption));
  794. Kernel32.GetProcAddress(lib, "SQLGetData", S.VAL(ADDRESS, SQLGetData));
  795. Kernel32.GetProcAddress(lib, "SQLGetFunctions", S.VAL(ADDRESS, SQLGetFunctions));
  796. Kernel32.GetProcAddress(lib, "SQLGetInfo", S.VAL(ADDRESS, SQLGetInfo));
  797. Kernel32.GetProcAddress(lib, "SQLGetStmtOption", S.VAL(ADDRESS, SQLGetStmtOption));
  798. Kernel32.GetProcAddress(lib, "SQLGetTypeInfo", S.VAL(ADDRESS, SQLGetTypeInfo));
  799. Kernel32.GetProcAddress(lib, "SQLParamData", S.VAL(ADDRESS, SQLParamData));
  800. Kernel32.GetProcAddress(lib, "SQLPutData", S.VAL(ADDRESS, SQLPutData));
  801. Kernel32.GetProcAddress(lib, "SQLSetConnectOption", S.VAL(ADDRESS, SQLSetConnectOption));
  802. Kernel32.GetProcAddress(lib, "SQLSetStmtOption", S.VAL(ADDRESS, SQLSetStmtOption));
  803. Kernel32.GetProcAddress(lib, "SQLSpecialColumns", S.VAL(ADDRESS, SQLSpecialColumns));
  804. Kernel32.GetProcAddress(lib, "SQLStatistics", S.VAL(ADDRESS, SQLStatistics));
  805. Kernel32.GetProcAddress(lib, "SQLTables", S.VAL(ADDRESS, SQLTables));
  806. (* binding level 2 functions *)
  807. Kernel32.GetProcAddress(lib, "SQLBrowseConnect", S.VAL(ADDRESS, SQLBrowseConnect));
  808. Kernel32.GetProcAddress(lib, "SQLColumnPrivileges", S.VAL(ADDRESS, SQLColumnPrivileges));
  809. Kernel32.GetProcAddress(lib, "SQLDataSources", S.VAL(ADDRESS, SQLDataSources));
  810. Kernel32.GetProcAddress(lib, "SQLExtendedFetch", S.VAL(ADDRESS, SQLExtendedFetch));
  811. Kernel32.GetProcAddress(lib, "SQLForeignKeys", S.VAL(ADDRESS, SQLForeignKeys));
  812. Kernel32.GetProcAddress(lib, "SQLMoreResults", S.VAL(ADDRESS, SQLMoreResults));
  813. Kernel32.GetProcAddress(lib, "SQLNativeSql", S.VAL(ADDRESS, SQLNativeSql));
  814. Kernel32.GetProcAddress(lib, "SQLNumParams", S.VAL(ADDRESS, SQLNumParams));
  815. Kernel32.GetProcAddress(lib, "SQLParamOptions", S.VAL(ADDRESS, SQLParamOptions));
  816. Kernel32.GetProcAddress(lib, "SQLPrimaryKeys", S.VAL(ADDRESS, SQLPrimaryKeys));
  817. Kernel32.GetProcAddress(lib, "SQLProcedureColumns", S.VAL(ADDRESS, SQLProcedureColumns));
  818. Kernel32.GetProcAddress(lib, "SQLProcedures", S.VAL(ADDRESS, SQLProcedures));
  819. Kernel32.GetProcAddress(lib, "SQLSetPos", S.VAL(ADDRESS, SQLSetPos));
  820. Kernel32.GetProcAddress(lib, "SQLTablePrivileges", S.VAL(ADDRESS, SQLTablePrivileges));
  821. Kernel32.GetProcAddress(lib, "SQLDrivers", S.VAL(ADDRESS, SQLDrivers));
  822. Kernel32.GetProcAddress(lib, "SQLBindParameter", S.VAL(ADDRESS, SQLBindParameter));
  823. (* binding level 3 functions *)
  824. Kernel32.GetProcAddress(lib, "SQLFetchScroll", S.VAL(ADDRESS, SQLFetchScroll));
  825. Kernel32.GetProcAddress(lib, "SQLSetStmtAttr", S.VAL(ADDRESS, SQLSetStmtAttr));
  826. Kernel32.GetProcAddress(lib, "SQLSetConnectAttr", S.VAL(ADDRESS, SQLSetConnectAttr))
  827. END Init;
  828. PROCEDURE Term;
  829. BEGIN
  830. FreeEnv(env, res1);
  831. (* Kernel32.FreeLibrary(lib) *)
  832. END Term;
  833. BEGIN
  834. Init;
  835. nullString[0]:= 1X;
  836. Modules.InstallTermHandler(Term);
  837. NEW(env); AllocEnv(env, res1)
  838. END ODBC.
  839. System.Free SQL ODBC ~