Module sql.pkg
1//*****************************************************************************
2//*** SQL.pkg ***
3//*** ***
4//*** Author: Ben Weijers ***
5//*** Data Access Wordwide ***
6//*** 14 February 2000 ***
7//*** ***
8//*** Purpose: ***
9//*** Embedded SQL manager. ***
10//*** ***
11//*** Changes: ***
12//*** ***
13//*** March 14, 2001. CLI Connectivity Kits 2.0.0.13 ***
14//*** Allocate memory before call_driver command with spaces instead ***
15//*** of binary zeroes. ***
16//*** ***
17//*** June 18, 2010. CLI Connectivity Kits 5.1.0.76 ***
18//*** Made a change to reserve space for a decimal point when getting ***
19//*** decimal date through embeded SQL. ***
20//*** ***
21//*****************************************************************************
22
23Use CLI.pkg
24Use Case.mac
25
26//*** Global object handle for the manager
27Integer _embsqlghoSQLHandleMngr
28
29//*** Global stroage for results
30Integer SQLResult
31
32//*** Embedded SQL function constants
33Define FUNC_SQLCONNECT For 1000000
34Define FUNC_SQLFILECONNECT For 1000001
35Define FUNC_SQLDISCONNECT For 1000002
36Define FUNC_SQLOPEN For 1000003
37Define FUNC_SQLCLOSE For 1000004
38Define FUNC_SQLPREPARE For 1000005
39Define FUNC_SQLEXECUTE For 1000006
40Define FUNC_SQLEXECDIRECT For 1000007
41Define FUNC_SQLFETCH For 1000008
42Define FUNC_SQLCOLUMNINFO For 1000009
43Define FUNC_SQLCOLUMNVALUE For 1000010
44Define FUNC_SQLBINDFILE For 1000011
45Define FUNC_SQLGETDATA For 1000012
46Define FUNC_SQLCOLSTRINGATTRIBLEN For 1000013
47Define FUNC_SQLCOLSTRINGATTRIB For 1000014
48Define FUNC_SQLCOLINTATTRIB For 1000015
49Define FUNC_SQLSTMTINTATTRIB For 1000016
50Define FUNC_SQLSETPROCNAME For 1000017
51DEfine FUNC_SQLSETPROCARG For 1000018
52Define FUNC_SQLCALL For 1000019
53Define FUNC_SQLGETPROCARGLEN For 1000020
54Define FUNC_SQLGETPROCARG For 1000021
55Define FUNC_SQLGETPROCRETVALLEN For 1000022
56Define FUNC_SQLGETPROCRETVAL For 1000023
57Define FUNC_SQLNEXTRESULTSET For 1000024
58Define FUNC_SQLBUFFERSTATUS For 1000025
59Define FUNC_SQLSETPROCSCHEMA For 1000026
60Define FUNC_SQLGETMESSAGE For 1000027
61
62//*** Embedded SQL statement attribute constants
63Define SQLSTMTATTRIB_COLUMNCOUNT For 1
64Define SQLSTMTATTRIB_ROWCOUNT For 2
65Define SQLSTMTATTRIB_ROWCOUNT_TYPE For 3
66Define SQLSTMTATTRIB_NUMMESSAGES For 4
67
68//*** Embedded SQL column attribute constants
69Define SQLCOLATTRIB_SIZE For 1
70Define SQLCOLATTRIB_LENGTH For 1
71Define SQLCOLATTRIB_PRECISION For 2
72Define SQLCOLATTRIB_LABEL For 3
73Define SQLCOLATTRIB_BASECOLUMNNAME For 4
74Define SQLCOLATTRIB_BASETABLENAME For 5
75Define SQLCOLATTRIB_SQLTYPE For 6
76Define SQLCOLATTRIB_NULLABLE For 7
77Define SQLCOLATTRIB_DFTYPE For 8
78
79
80
81//*****************************************************************************
82//*** Class : cSQLStatement ***
83//*** Purpose: Statement object for embedded sql ***
84//*** ***
85//*** Description: ***
86//*** An object is created for each statement. These will be children ***
87//*** of cSQLConnection objects which manage the create and destruction ***
88//*** of these. ***
89//*****************************************************************************
90
91Class cSQLStatement is an Array
92
93 Procedure Construct_object Integer Image
94 Forward Send Construct_object Image
95
96 Property Integer phCLIHandle public 0
97 Property String psDriverID Public ""
98 Property Integer phStmtConnection Public 0
99 Property Integer piLastColumn Public 0
100 Property Integer piLastArgument Public 0
101 Property Integer piBindFile Public 0
102
103 Set Delegation_mode To NO_Delegation
104 End_procedure // Construct_object
105
106
107
108 //***
109 //*** Procedure: StoreHandleInfo
110 //*** Purpose : Store basic information about the statement handle.
111 //***
112
113 Procedure StoreHandleInfo Integer iCLIHandle String sDrvrId Integer iParentHandle
114 Set phCLIHandle To iCLIHandle
115 Set psDriverID To sDrvrId
116 Set phStmtConnection To iParentHandle
117 End_Procedure // StoreHandleInfo
118
119
120
121 //***
122 //*** Procedure: FreeHandle
123 //*** Purpose : Free a handle. Since a handle is stored in an
124 //*** cSQLStatement object, we destroy the object.
125 //***
126
127 Procedure FreeHandle
128 Send Destroy_Object
129 End_Procedure // FreeHandle
130
131
132
133 //***
134 //*** Procedure: HandleError
135 //*** Puprose : Handle an error that has occured while checking properties.
136 //***
137
138 Procedure HandleError Integer ihstmt Integer ihdbc String sDrvrId String sOriginMsg
139 Local Integer iErrHandle
140 Local Integer iErrNum
141 Local String sLocationInfo
142
143 //*** Get the DataFlex statement identifier
144 Move Current_object To iErrHandle
145
146 //*** Determine error number
147 If (ihstmt = 0) ;
148 Move CLIERR_SQLINVALID_CLI_STMT_HANDLE To iErrNum
149 Else If (ihdbc = 0) ;
150 Move CLIERR_SQLINVALID_CLI_CONN_HANDLE To iErrNum
151 Else If (sDrvrId = "") ;
152 Move CLIERR_SQLINVALID_DRIVER_ID To iErrNum
153 Else ;
154 Move CLIERR_SQL_ERROR To iErrNum
155
156 //*** Create location ifnormation
157 Move "[" To sLocationInfo
158 If (sOriginMsg <> "") Begin
159 Move (Append(sLocationInfo, sOriginMsg)) To sLocationInfo
160 Move (Append(sLocationInfo, ", ")) To sLocationInfo
161 End
162 Move (Append(sLocationInfo, "DataFlex hstmt = ")) To sLocationInfo
163 Move (Append(sLocationInfo, iErrHandle)) To sLocationInfo
164 Move (Append(sLocationInfo, "]")) To sLocationInfo
165
166 //*** Generate the error
167 Error iErrNum sLocationInfo
168 End_Procedure // HandleError
169
170
171
172 //***
173 //*** Procedure: StmtError
174 //*** Purpose : Handle general error not related to the properties
175 //***
176
177 Procedure StmtError Integer iErrNum String sErrText String sOriginMsg
178 Local Integer iErrHandle
179 Local String sLocationInfo
180
181 //*** Get the DataFlex statement identifier
182 Move Current_object To iErrHandle
183
184
185 //*** Create location information
186 Move "[" To sLocationInfo
187 If (sOriginMsg <> "") Begin
188 Move (Append(sLocationInfo, sOriginMsg)) To sLocationInfo
189 Move (Append(sLocationInfo, ", ")) To sLocationInfo
190 End
191 If (sErrtext <> "") Begin
192 Move (Append(sLocationInfo, sErrtext)) To sLocationInfo
193 Move (Append(sLocationInfo, ", ")) To sLocationInfo
194 End
195 Move (Append(sLocationInfo, "DataFlex hstmt = ")) To sLocationInfo
196 Move (Append(sLocationInfo, iErrHandle)) To sLocationInfo
197 Move (Append(sLocationInfo, "]")) To sLocationInfo
198
199 //*** Generate the error
200 Error iErrNum sLocationInfo
201 End_Procedure // StmtError
202
203
204
205 //***
206 //*** Procedure: SQLIllegalAttribute
207 //*** Purpose : Handle an illegal attribute error
208 //***
209
210 Procedure SQLIllegalAttribute String sErrText String sOriginMsg
211 Local Integer bReport
212
213 Get_attribute DF_REPORT_UNSUPPORTED_ATTRIBUTES To bReport
214 If (bReport) ;
215 Send StmtError CLIERR_SQLINVALID_ATTRIBUTE sErrtext sOriginMsg
216 End_Procedure // SQLIllegalAttribute
217
218
219
220 //***
221 //*** Function: SQLPrivateColumnIsLegal
222 //*** Purpose : Check if a column number is legal
223 //***
224
225 Function SQLPrivateColumnIsLegal Integer ihdbc String sDrvrId Integer ihstmt Integer iCol Returns Integer
226 Local Integer bLegal
227 Local Integer iNumColumns
228
229 Get SQLPrivateStmtAttribute SQLSTMTATTRIB_COLUMNCOUNT ihdbc sDrvrId ihstmt To iNumColumns
230 If (iCol > 0 And iCol <= iNumColumns) ;
231 Move DFTRUE To bLegal
232 Else ;
233 Move DFFALSE To bLegal
234
235 Function_Return bLegal
236 End_Function // SQLPrivateColumnIsLegal
237
238
239
240 //***
241 //*** Procedure: SQLClose
242 //*** Purpose : Close a statement and free all alllocated resources
243 //***
244
245 Procedure SQLClose
246 Local Integer ihdbc
247 Local Integer ihstmt
248 Local Integer iVoid
249 Local String sDrvrId
250 Local String sEmpty
251
252 //*** Initialize
253 Move "" To sEmpty
254
255 //*** Get the cli handle to the connection
256 Get phCLIHandle To ihstmt
257 Get psDriverId To sDrvrId
258 Get phStmtConnection To ihdbc
259
260 //*** Free the CLI handle
261 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
262 //*** Call the driver function to close
263 Call_driver 0 sDrvrId Function FUNC_SQLCLOSE ;
264 Callback Current_Object ;
265 Passing ihdbc sEmpty ihstmt ;
266 Result iVoid
267
268 //*** Free the DataFlex handle
269 Send FreeHandle
270 End
271 Else ;
272 Send HandleError ihstmt ihdbc sDrvrId "SQLClose"
273 End_procedure // SQLClose
274
275
276
277 //***
278 //*** Procedure: SQLPrepare
279 //*** Purpose : Prepare a statement for execution
280 //***
281
282 Procedure SQLPrepare String sStatement
283 Local Integer ihdbc
284 Local Integer ihstmt
285 Local Integer iVoid
286 Local String sDrvrId
287
288 //*** Get the cli handle to the connection
289 Get phCLIHandle To ihstmt
290 Get psDriverId To sDrvrId
291 Get phStmtConnection To ihdbc
292
293 //*** Prepare
294 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
295 //*** Call the driver function to prepare
296 Call_driver 0 sDrvrId Function FUNC_SQLPREPARE ;
297 Callback Current_Object ;
298 Passing ihdbc sStatement ihstmt ;
299 Result iVoid
300 End
301 Else ;
302 Send HandleError ihstmt ihdbc sDrvrId "SQLPrepare"
303 End_procedure // SQLPrepare
304
305
306
307 //***
308 //*** Procedure: SQLExecute
309 //*** Purpose : Execute a prepared statement
310 //***
311
312 Procedure SQLExecute
313 Local Integer ihdbc
314 Local Integer ihstmt
315 Local Integer iVoid
316 Local String sDrvrId
317 Local String sEmpty
318
319 //*** Initialize
320 Move "" To sEmpty
321
322 //*** Get the cli handle to the connection
323 Get phCLIHandle To ihstmt
324 Get psDriverId To sDrvrId
325 Get phStmtConnection To ihdbc
326
327 //*** Execute
328 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
329 //*** Call the driver function to execute
330 Call_driver 0 sDrvrId Function FUNC_SQLEXECUTE ;
331 Callback Current_Object ;
332 Passing ihdbc sEmpty ihstmt ;
333 Result iVoid
334 End
335 Else ;
336 Send HandleError ihstmt ihdbc sDrvrId "SQLExecute"
337 End_Procedure // SQLExecute
338
339
340
341 //***
342 //*** Procedure: SQLExecDirect
343 //*** Purpose : Prepare and execute a statement
344 //***
345
346 Procedure SQLExecDirect String sStatement
347 Local Integer ihdbc
348 Local Integer ihstmt
349 Local Integer iVoid
350 Local String sDrvrId
351
352 //*** Get the cli handle to the connection
353 Get phCLIHandle To ihstmt
354 Get psDriverId To sDrvrId
355 Get phStmtConnection To ihdbc
356
357 //*** ExecDirect
358 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
359 //*** Call the driver function to execdirect
360 Call_driver 0 sDrvrId Function FUNC_SQLEXECDIRECT ;
361 Callback Current_Object ;
362 Passing ihdbc sStatement ihstmt ;
363 Result iVoid
364 End
365 Else ;
366 Send HandleError ihstmt ihdbc sDrvrId "SQLExecDirect"
367 End_procedure // SQLExecDirect
368
369
370
371 //***
372 //*** Procedure: SQLFetch
373 //*** Purpose : Fetch the next row
374 //*** Returns : 0 = No more data
375 //*** <>0 = Success
376 //***
377
378 Function SQLFetch Returns Integer
379 Local Integer ihdbc
380 Local Integer ihstmt
381 Local Integer iResult
382 Local String sDrvrId
383 Local String sEmpty
384
385 //*** Initialize
386 Move "" To sEmpty
387 Move 0 To iResult
388
389 //*** Get the cli handle to the connection
390 Get phCLIHandle To ihstmt
391 Get psDriverId To sDrvrId
392 Get phStmtConnection To ihdbc
393
394 //*** Fetch
395 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
396 Indicate Err False
397
398 //*** Call the driver function to fetch
399 Call_driver 0 sDrvrId Function FUNC_SQLFETCH ;
400 Callback Current_Object ;
401 Passing ihdbc sEmpty ihstmt ;
402 Result iResult
403
404 //*** If something went wrong, adjust the result
405 If (Err) ;
406 Move 0 To iResult
407
408 Set piLastcolumn To 0
409 End
410 Else ;
411 Send HandleError ihstmt ihdbc sDrvrId "SQLFetch"
412
413 Function_return iResult
414 End_Function // SQLFetch
415
416
417
418 //***
419 //*** Function: SQLNextColumn
420 //*** Purpose : Get the next column
421 //***
422
423 Function SQLNextColumn Returns String
424 Local Integer iCol
425 Local String sResult
426
427 Get piLastColumn To iCol
428 Increment iCol
429 Get SQLColumnValue iCol To sResult
430 Set piLastColumn To iCol
431
432 Function_return sResult
433 End_Function // SQLNextColumn
434
435
436
437 //***
438 //*** Function: SQLColumnValue
439 //*** Purpose : Return the value of a column in a fetched row of a given
440 //*** statement.
441 //***
442
443 Function SQLColumnValue Integer iCol Returns String
444 Local Integer ihdbc
445 Local Integer ihstmt
446 Local String sDrvrId
447 Local String sResult
448
449 //*** Initialize
450 Move "" To sResult
451
452 //*** Get the cli handle to the connection
453 Get phCLIHandle To ihstmt
454 Get psDriverId To sDrvrId
455 Get phStmtConnection To ihdbc
456
457 //*** Get the value
458 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") ;
459 Get SQLPrivateColumnValue iCol ihdbc sDRvrId ihstmt To sResult
460 Else ;
461 Send HandleError ihstmt ihdbc sDrvrId "SQLColumnValue"
462
463 Function_return sResult
464 End_Function // SQLColumnValue
465
466 Function SQLPrivateColumnValue Integer iCol Integer ihdbc String sDrvrId Integer ihstmt Returns String
467 Local Integer iVoid
468 Local Integer iColSize
469 Local Integer iColPrecision
470 Local String sResult
471 Local String sEmpty
472 Local Integer bLegalColumn
473
474 //*** Initialize
475 Move "" To sEmpty
476
477 //*** Get the value
478 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
479 //*** Check if the column exists
480 Get SQLPrivateColumnIsLegal ihdbc sDrvrId ihstmt iCol To bLegalColumn
481 If (bLegalColumn) Begin
482 //*** Determine the column size
483 Get SQLPrivateColAttribute iCol SQLCOLATTRIB_SIZE ihdbc sDrvrId ihstmt to iColSize
484 Get SQLPrivateColAttribute iCol SQLCOLATTRIB_PRECISION ihdbc sDrvrId ihstmt to iColPrecision
485 If (iColSize > 0) Begin
486
487 // Account for positions for a decimal point and a sign
488 Move (iColSize + 1 + If(iColPrecision, iColPrecision + 1, 0)) to iColSize
489
490 //*** Setup function arguments
491 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNINFO ;
492 Callback Current_Object ;
493 Passing ihdbc iCol ihstmt ;
494 Result iVoid
495
496 //*** Allocate
497 Move (Repeat(' ', iColSize)) To sResult
498
499 //*** Call the driver function to get the value
500 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNVALUE ;
501 Callback Current_Object ;
502 Passing sResult sEmpty 0 ;
503 Result iVoid
504 End
505 End
506 Else ;
507 Send StmtError CLIERR_SQLINVALID_COLUMN ("(Column number = " + String(iCol) + ")") "SQLPrivateColumnValue"
508 End
509 Else ;
510 Send HandleError ihstmt ihdbc sDrvrId "SQLPrivateColumnValue"
511
512 Function_return sResult
513 End_Function // SQLColumnValue
514
515
516
517 //***
518 //*** Procedure: SQLBindFile
519 //*** Purpose : Add a file to the files used to place the statement result in.
520 //***
521
522 Procedure SQLBindFile Integer iFileNum
523 Local Integer ihdbc
524 Local Integer ihstmt
525 Local Integer iVoid
526 Local String sDrvrId
527 Local String sFileType
528 Local Integer bIsOpen
529
530 //*** Get the cli handle to the connection
531 Get phCLIHandle To ihstmt
532 Get psDriverId To sDrvrId
533 Get phStmtConnection To ihdbc
534
535 //*** If a file number is not passed see if we can use the statement's
536 //*** default file number which is usually set with SetFileConnection
537 If (iFileNum = 0) Begin
538 Get piBindFile To iFileNum
539 If (iFileNum = 0) Begin
540 //*** Logic error, if 0 is passed as filenumber, piBindFile should be set.
541 Send StmtError CLIERR_SQLINVALID_BIND_FILE "piBindFile should be set" "SQLBindFile"
542
543 Move 0 to SQLResult
544 Procedure_Return
545 End
546 End
547
548 //*** Bind the file
549 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
550 //*** Chek if the file is open
551 Get_attribute DF_FILE_OPENED Of iFileNum To bIsOpen
552 If (bIsOpen) Begin
553 //*** Check if the file has the correct type
554 Get_attribute DF_FILE_DRIVER Of iFileNum To sFileType
555 If (sFileType = sDrvrId) Begin
556 //*** Call the driver function to add a file to a statement
557 Call_driver 0 sDrvrId Function FUNC_SQLBINDFILE ;
558 Callback Current_Object ;
559 Passing ihdbc iFileNum ihstmt ;
560 Result iVoid
561 End
562 Else ;
563 Send StmtError CLIERR_SQLINVALID_BIND_FILE ("File" * String(iFileNum) * "type incompatible with statement (" + sFileType + ")") "SQLBindFile"
564 End
565 Else ;
566 Send StmtError CLIERR_SQLINVALID_BIND_FILE ("File not open (number =" * String(iFileNum) + ")") "SQLBindFile"
567 End
568 Else ;
569 Send HandleError ihstmt ihdbc sDrvrId "SQLBindFile"
570 End_Procedure // SQLBindFile
571
572
573
574 //*************************************************************************
575 //*** Function: SQLGetData ***
576 //*** Purpose : Get data of a column. ***
577 //*************************************************************************
578
579 Function SQLGetData Integer iCol Integer iLen Returns String
580 Local Integer ihdbc
581 Local Integer ihstmt
582 Local Integer iVoid
583 Local Integer iColSize
584 Local Integer iResult
585 Local String sDrvrId
586 Local String sResult
587 Local String sEmpty
588 Local Integer bLegalColumn
589
590 //*** Initialize
591 Move "" To sEmpty
592 Move 0 To iResult
593
594 //*** Get the cli handle to the connection
595 Get phCLIHandle To ihstmt
596 Get psDriverId To sDrvrId
597 Get phStmtConnection To ihdbc
598
599 //*** Get the data
600 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
601 //*** Check if the column exists
602 Get SQLPrivateColumnIsLegal ihdbc sDrvrId ihstmt iCol To bLegalColumn
603 If (bLegalColumn) Begin
604 If (iLen = 0) ;
605 Get SQLPrivateColumnValue iCol ihdbc sDrvrId ihstmt To sResult
606 Else Begin
607 //*** Setup function arguments
608 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNINFO ;
609 Callback Current_Object ;
610 Passing ihdbc iCol ihstmt ;
611 Result iVoid
612
613 //*** Allocate
614 Move (Repeat(' ', iLen)) To sResult
615
616 Indicate Err False
617
618 //*** Call the driver function to get the data
619 Call_driver 0 sDrvrId Function FUNC_SQLGETDATA ;
620 Callback Current_Object ;
621 Passing sResult sEmpty iLen ;
622 Result iResult
623
624 //*** If something went wrong, adjust the result
625 If (Err) ;
626 Move 0 To iResult
627 End
628 End
629 Else ;
630 Send StmtError CLIERR_SQLINVALID_COLUMN ("(Column number = " + String(iCol) + ")") "SQLGetData"
631 End
632 Else ;
633 Send HandleError ihstmt ihdbc sDrvrId "SQLGetData"
634
635 //*** Fill global result
636 Move iResult To SQLResult
637
638 Function_Return sResult
639 End_Function // SQLGetData
640
641
642
643 //***
644 //*** Function: SQLColumnMap
645 //*** Purpose : Map a column name to a number, if the name id not found no
646 //*** error is generated the returned number will be 0 (zero) in
647 //*** that case
648 //***
649
650 Function SQLColumnMap String sColname Returns Integer
651 Local Integer ihdbc
652 Local Integer ihstmt
653 Local Integer iNumColumns
654 Local Integer iColCount
655 Local Integer iColNum
656 Local String sDrvrId
657 Local String sCurColName
658
659 //*** Get the cli handle to the connection
660 Get phCLIHandle To ihstmt
661 Get psDriverId To sDrvrId
662 Get phStmtConnection To ihdbc
663
664 //*** Get the number by looping through the column names
665 Move 0 To iColNum
666 Get SQLPrivateStmtAttribute SQLSTMTATTRIB_COLUMNCOUNT ihdbc sDrvrId ihstmt To iNumColumns
667 For iColCount From 1 To iNumColumns
668 Get SQLPrivateColAttribute iColCount SQLCOLATTRIB_LABEL ihdbc sDrvrId ihstmt To sCurColName
669 If (Uppercase(Trim(sColName)) = Uppercase(Trim(sCurColName))) ;
670 Move iColCount To iColNum
671
672 If (iColNum) ;
673 Break
674 Loop
675
676 Function_return iColNum
677 End_Function // SQLColumnMap
678
679
680
681 //***
682 //*** Function: SQLStmtAttribute
683 //*** Purpose : Get a statement attribute
684 //***
685
686 Function SQLStmtAttribute Integer iAttribId Returns String
687 Local Integer ihdbc
688 Local Integer ihstmt
689 Local String sResult
690 Local String sDrvrId
691
692 //*** Initialize
693 Move "" To sResult
694
695 //*** Get the cli handle to the connection
696 Get phCLIHandle To ihstmt
697 Get psDriverId To sDrvrId
698 Get phStmtConnection To ihdbc
699
700 //*** Get the attribute
701 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") ;
702 Get SQLPrivateStmtAttribute iAttribId ihdbc sDrvrId ihstmt To sResult
703 Else ;
704 Send HandleError ihstmt ihdbc sDrvrId "SQLStmtAttribute"
705
706 Function_Return sResult
707 End_Function // SQLStmtAttibute
708
709 Function SQLPrivateStmtAttribute Integer iAttribId Integer ihdbc String sDrvrId Integer ihstmt Returns String
710 Local String sResult
711 Local Integer iLen
712 Local Integer bLegalAttrib
713
714 //*** Initialize
715 Move "" To sResult
716
717 //*** Get the attribute
718 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
719 Case Begin
720 Case (iAttribId = SQLSTMTATTRIB_COLUMNCOUNT)
721 Case (iAttribId = SQLSTMTATTRIB_ROWCOUNT)
722 Case (iAttribId = SQLSTMTATTRIB_ROWCOUNT_TYPE)
723 Case (iAttribId = SQLSTMTATTRIB_NUMMESSAGES)
724 Move DFTRUE To bLegalAttrib
725 Break
726
727 Case Else
728 Move DFFALSE To bLegalAttrib
729 Send SQLIllegalAttribute ("Attribute is = " + String(iAttribId) + ")") "SQLPrivateStmtAttribute"
730 Case End
731
732 If (bLegalAttrib) Begin
733 //*** Setup function arguments
734 Call_driver 0 sDrvrId Function FUNC_SQLSTMTINTATTRIB ;
735 Callback Current_Object ;
736 Passing ihdbc iAttribId ihstmt ;
737 Result sResult
738 End
739 End
740 Else ;
741 Send HandleError ihstmt ihdbc sDrvrId "SQLPrivateStmtAttribute"
742
743 Function_Return sResult
744 End_Function // SQLPrivateStmtAttribute
745
746
747
748 //***
749 //*** Function: SQLColAttribute
750 //*** Purpose : Get a column's attribute
751 //***
752
753 Function SQLColAttribute Integer iCol Integer iAttribId Returns String
754 Local Integer ihdbc
755 Local Integer ihstmt
756 Local String sResult
757 Local String sDrvrId
758
759 //*** Initialize
760 Move "" To sResult
761
762 //*** Get the cli handle to the connection
763 Get phCLIHandle To ihstmt
764 Get psDriverId To sDrvrId
765 Get phStmtConnection To ihdbc
766
767 //*** Get the attribute
768 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") ;
769 Get SQLPrivateColAttribute iCol iAttribId ihdbc sDrvrId ihstmt To sResult
770 Else ;
771 Send HandleError ihstmt ihdbc sDrvrId "SQLColAttribute"
772
773 Function_Return sResult
774 End_Function // SQLColAttribute
775
776 Function SQLPrivateColAttribute Integer iCol Integer iAttribId Integer ihdbc String sDrvrId Integer ihstmt Returns String
777 Local String sResult
778 Local String sEmpty
779 Local Integer bIsStringAttribute
780 Local Integer iLen
781 Local Integer iVoid
782 Local Integer bLegalAttrib
783 Local Integer bLegalColumn
784
785 //*** Initialize
786 Move "" To sResult
787 Move "" To sEmpty
788 MOve 0 To iLen
789
790 //*** Get the attribute
791 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
792 Get SQLPrivateColumnIsLegal ihdbc sDrvrId ihstmt iCol To bLegalColumn
793 If (bLegalColumn) Begin
794 //*** Determine the atributes type
795 Case Begin
796 Case (iAttribId = SQLCOLATTRIB_SIZE)
797 Case (iAttribId = SQLCOLATTRIB_LENGTH)
798 Case (iAttribId = SQLCOLATTRIB_PRECISION)
799 Case (iAttribId = SQLCOLATTRIB_SQLTYPE)
800 Case (iAttribId = SQLCOLATTRIB_NULLABLE)
801 Case (iAttribId = SQLCOLATTRIB_DFTYPE)
802 Move DFFALSE To bIsStringAttribute
803 Move DFTRUE To bLegalAttrib
804 Break
805
806 Case (iAttribId = SQLCOLATTRIB_LABEL)
807 Case (iAttribId = SQLCOLATTRIB_BASECOLUMNNAME)
808 Case (iAttribId = SQLCOLATTRIB_BASETABLENAME)
809 Move DFTRUE To bIsStringAttribute
810 Move DFTRUE To bLegalAttrib
811 Break
812
813 Case Else
814 Move DFFALSE To bLegalAttrib
815 Send SQLIllegalAttribute ("Attribute is = " + String(iAttribId) + ")") "SQLPrivateColAttribute"
816 Case End
817
818 If (bLegalAttrib) Begin
819 //*** Setup function arguments
820 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNINFO ;
821 Callback Current_Object ;
822 Passing ihdbc iCol ihstmt ;
823 Result iVoid
824
825 If (bIsStringAttribute) Begin
826 //*** Call the driver function to get the data length
827 Call_driver 0 sDrvrId Function FUNC_SQLCOLSTRINGATTRIBLEN ;
828 Callback Current_Object ;
829 Passing sEmpty sEmpty iAttribId ;
830 Result iLen
831
832 If (iLen) Begin
833 //*** Allocate
834 Move (Repeat(' ', iLen)) To sResult
835
836 //*** Call the driver function to get the name
837 Call_driver 0 sDrvrId Function FUNC_SQLCOLSTRINGATTRIB ;
838 Callback Current_Object ;
839 Passing sResult sEmpty iAttribId ;
840 Result iVoid
841 End
842 End
843 Else Begin
844 //*** get the attribute
845 Call_driver 0 sDrvrId Function FUNC_SQLCOLINTATTRIB ;
846 Callback Current_Object ;
847 Passing sEmpty sEmpty iAttribId ;
848 Result sResult
849 End
850 End
851 End
852 Else ;
853 Send StmtError CLIERR_SQLINVALID_COLUMN ("(Column number = " + String(iCol) + ")") "SQLPrivateColAttribute"
854 End
855 Else ;
856 Send HandleError ihstmt ihdbc sDrvrId "SQLPrivateColAttribute"
857
858 Function_Return sResult
859 End_Function // SQLPrivateColAttribute
860
861
862
863 //***
864 //*** Procedure: SQLSetProcedureName
865 //*** Purpsoe : Preapre for calling a stored procedure, pass the procedure name.
866 //***
867
868 Procedure SQLSetProcedureName String sProcName String sSchemaArg
869 Local Integer ihdbc
870 Local Integer ihstmt
871 Local String sDrvrId
872 Local Integer iVoid
873 Local String sSchema
874 Local String sEmpty
875
876 //*** Initialize
877 Move "" To sEmpty
878
879 //*** Get the cli handle to the connection
880 Get phCLIHandle To ihstmt
881 Get psDriverId To sDrvrId
882 Get phStmtConnection To ihdbc
883
884 //*** Call the procedure
885 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
886 If (Num_Arguments >= 2) ;
887 Move sSchemaArg To sSchema
888 Else ;
889 Move "" To sSchema
890
891 If (sSchema <> "") Begin
892 Call_driver 0 sDrvrId Function FUNC_SQLSETPROCSCHEMA ;
893 Callback Current_Object ;
894 Passing ihdbc sSchema ihstmt ;
895 Result iVoid
896 End
897
898 //*** Call the procedure
899 Call_driver 0 sDrvrId Function FUNC_SQLSETPROCNAME ;
900 Callback Current_Object ;
901 Passing ihdbc sProcName ihstmt ;
902 Result iVoid
903
904 Set piLastArgument To 0
905 End
906 Else ;
907 Send HandleError ihstmt ihdbc sDrvrId "SQLSetProcedurename"
908 End_Procedure // SQLSetProcedureName
909
910
911
912 //***
913 //*** Function: SQLSetNextArgument
914 //*** Purpose : Pass the next argument
915 //***
916
917 Procedure SQLSetNextArgument String sArgument
918 Local Integer iArgnum
919
920 Get piLastArgument To iArgnum
921 Increment iArgnum
922 Send SQLSetArgument iArgnum sArgument
923 Set piLastArgument To iArgnum
924 End_Procedure // SQLSetNextArgument
925
926
927
928 //***
929 //*** Procedure: SQLSetArgument
930 //*** Purpose : Set the next argument
931 //***
932
933 Procedure SQLSetArgument Integer iArgnum String sArgument
934 Local Integer ihdbc
935 Local Integer ihstmt
936 Local String sDrvrId
937 Local Integer iVoid
938 Local String sEmpty
939
940 //*** Initialize
941 Move "" To sEmpty
942
943 //*** Get the cli handle to the connection
944 Get phCLIHandle To ihstmt
945 Get psDriverId To sDrvrId
946 Get phStmtConnection To ihdbc
947
948 //*** Call the procedure
949 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
950 //*** Pass the information
951 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNINFO ;
952 Callback Current_Object ;
953 Passing ihdbc iArgnum ihstmt ;
954 Result iVoid
955
956 //*** Pass the argument
957 Call_driver 0 sDrvrId Function FUNC_SQLSETPROCARG ;
958 Callback Current_Object ;
959 Passing sArgument sEmpty 0 ;
960 Result iVoid
961 End
962 Else ;
963 Send HandleError ihstmt ihdbc sDrvrId "SQLSetArgument"
964 End_Procedure // SQLSetArgument
965
966
967
968 //***
969 //*** Procedure: SQLCall
970 //*** Purpose : Call a stored procedure
971 //***
972
973 Procedure SQLCall
974 Local Integer ihdbc
975 Local Integer ihstmt
976 Local String sDrvrId
977 Local Integer iVoid
978 Local String sEmpty
979
980 //*** Initialize
981 Move "" To sEmpty
982
983 //*** Get the cli handle to the connection
984 Get phCLIHandle To ihstmt
985 Get psDriverId To sDrvrId
986 Get phStmtConnection To ihdbc
987
988 //*** Call the procedure
989 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
990 //*** Call the procedure
991 Call_driver 0 sDrvrId Function FUNC_SQLCALL ;
992 Callback Current_Object ;
993 Passing ihdbc sEmpty ihstmt ;
994 Result iVoid
995
996 Set piLastArgument To 0
997 End
998 Else ;
999 Send HandleError ihstmt ihdbc sDrvrId "SQLCall"
1000 End_Procedure // SQLCall
1001
1002
1003
1004 //***
1005 //*** Function: SQLGetNextArgument
1006 //*** Purpose : Get the next argument
1007 //***
1008
1009 Function SQLGetNextArgument Returns String
1010 Local Integer iArgnum
1011 Local String sResult
1012
1013 Get piLastArgument To iArgnum
1014 Increment iArgnum
1015 Get SQLGetArgument iArgnum To sResult
1016 Set piLastArgument To iArgnum
1017
1018 Function_return sResult
1019 End_Function // SQLGetNextArgument
1020
1021
1022
1023 //***
1024 //*** Function: SQLGetArgument
1025 //*** Purpose : Get the specified argument from a procedure
1026 //***
1027
1028 Function SQLGetArgument Integer iArgnum Returns String
1029 Local Integer ihdbc
1030 Local Integer ihstmt
1031 Local String sDrvrId
1032 Local Integer iVoid
1033 Local String sEmpty
1034 Local String sArgument
1035 Local Integer iLen
1036
1037 //*** Initialize
1038 Move "" To sEmpty
1039 Move "" To sArgument
1040
1041 //*** Get the cli handle to the connection
1042 Get phCLIHandle To ihstmt
1043 Get psDriverId To sDrvrId
1044 Get phStmtConnection To ihdbc
1045
1046 //*** Call the procedure
1047 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
1048 //*** Pass the information
1049 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNINFO ;
1050 Callback Current_Object ;
1051 Passing ihdbc iArgnum ihstmt ;
1052 Result iVoid
1053
1054 //*** Get the length
1055 Call_driver 0 sDrvrId Function FUNC_SQLGETPROCARGLEN ;
1056 Callback Current_Object ;
1057 Passing sEmpty sEmpty 0 ;
1058 Result iLen
1059
1060 If (iLen) Begin
1061 //*** Allocate
1062 Move (Repeat(' ', iLen)) To sArgument
1063
1064 //*** Pass the argument
1065 Call_driver 0 sDrvrId Function FUNC_SQLGETPROCARG ;
1066 Callback Current_Object ;
1067 Passing sArgument sEmpty 0 ;
1068 Result iVoid
1069 End
1070 End
1071 Else ;
1072 Send HandleError ihstmt ihdbc sDrvrId "SQLGetArgument"
1073
1074 Function_Return sArgument
1075 End_Function // SQLGetArgument
1076
1077
1078
1079 //***
1080 //*** Function: SQLReturnValue
1081 //*** Purpose : Get the reutn value of a stored function
1082 //***
1083
1084 Function SQLReturnValue Returns String
1085 Local Integer ihdbc
1086 Local Integer ihstmt
1087 Local String sDrvrId
1088 Local Integer iVoid
1089 Local String sEmpty
1090 Local String sRetval
1091 Local Integer iLen
1092
1093 //*** Initialize
1094 Move "" To sEmpty
1095 Move "" To sRetval
1096
1097 //*** Get the cli handle to the connection
1098 Get phCLIHandle To ihstmt
1099 Get psDriverId To sDrvrId
1100 Get phStmtConnection To ihdbc
1101
1102 //*** Call the procedure
1103 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
1104 //*** Get the length
1105 Call_driver 0 sDrvrId Function FUNC_SQLGETPROCRETVALLEN ;
1106 Callback Current_Object ;
1107 Passing ihdbc sEmpty ihstmt ;
1108 Result iLen
1109
1110 If (iLen) Begin
1111 //*** Allocate
1112 Move (Repeat(' ', iLen)) To sRetval
1113
1114 //*** Pass the argument
1115 Call_driver 0 sDrvrId Function FUNC_SQLGETPROCRETVAL ;
1116 Callback Current_Object ;
1117 Passing ihdbc sRetval ihstmt ;
1118 Result iVoid
1119 End
1120 End
1121 Else ;
1122 Send HandleError ihstmt ihdbc sDrvrId "SQLReturnValue"
1123
1124 Function_Return sRetval
1125 End_Function // SQLReturnValue
1126
1127
1128
1129 //***
1130 //*** Function: SQLNextResultSet
1131 //*** Purpose : Switch to the next set
1132 //*** Returns : 0 = No more result sets
1133 //*** <>0 = Switched to next set
1134 //***
1135
1136 Function SQLNextResultSet Returns Integer
1137 Local Integer ihdbc
1138 Local Integer ihstmt
1139 Local String sDrvrId
1140 Local Integer iResult
1141 Local String sEmpty
1142
1143 //*** Initialize
1144 Move "" To sEmpty
1145 Move 0 To iResult
1146
1147 //*** Get the cli handle to the connection
1148 Get phCLIHandle To ihstmt
1149 Get psDriverId To sDrvrId
1150 Get phStmtConnection To ihdbc
1151
1152 //*** Call the procedure
1153 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
1154 //*** Get the length
1155 Call_driver 0 sDrvrId Function FUNC_SQLNEXTRESULTSET ;
1156 Callback Current_Object ;
1157 Passing ihdbc sEmpty ihstmt ;
1158 Result iResult
1159
1160 Set piLastArgument To 0
1161 End
1162 Else ;
1163 Send HandleError ihstmt ihdbc sDrvrId "SQLNextResultSet"
1164
1165 Function_Return iResult
1166 End_Function // SQLNextResultSet
1167
1168
1169
1170 //***
1171 //*** Procedure: SQLFetchActivatesBuffer
1172 //*** Purpose : Setup a file that will be acivated after a succesfull
1173 //*** fetch on the statement
1174 //***
1175
1176 Procedure SQLFetchActivatesBuffer Integer iFileNum Integer bState
1177 Local Integer ihdbc
1178 Local Integer ihstmt
1179 Local String sDrvrId
1180 Local Integer iResult
1181 Local Integer bIsOpen
1182 Local Integer iVoid
1183 Local String sFileType
1184
1185 //*** Check if file is open
1186 Get_attribute DF_FILE_OPENED Of iFileNum To bIsOpen
1187 If (bIsOpen) Begin
1188 //*** Get the cli handle to the connection
1189 Get phCLIHandle To ihstmt
1190 Get psDriverId To sDrvrId
1191 Get phStmtConnection To ihdbc
1192
1193 //*** Call the procedure
1194 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
1195 //*** Check if the file has the correct type
1196 Get_attribute DF_FILE_DRIVER Of iFileNum To sFileType
1197 If (sFileType = sDrvrId) Begin
1198 //*** Setup the buffer
1199 Call_driver iFileNum sDrvrId Function FUNC_SQLBUFFERSTATUS ;
1200 Callback Current_Object ;
1201 Passing ihdbc bState ihstmt ;
1202 Result iVoid
1203 End
1204 Else ;
1205 Send StmtError CLIERR_SQLINVALID_BIND_FILE ("File" * String(iFileNum) * "type incompatible with statement (" + sFileType + ")") "SQLBindFile"
1206 End
1207 Else ;
1208 Send HandleError ihstmt ihdbc sDrvrId "SQLFetchActivatesBuffer"
1209 End
1210 Else ;
1211 Send StmtError CLIERR_SQLINVALID_BUFFER ("File not open (number =" * String(iFileNum) + ")") "SQLFetchActivatesBuffer"
1212 End_Procedure // SQLFetchActivatesBuffer
1213
1214
1215
1216 Function SQLGetMessage Integer iMessageNum Returns String
1217 Local Integer ihdbc
1218 Local Integer ihstmt
1219 Local String sDrvrId
1220 Local String sMessage
1221 Local Integer iVoid
1222
1223 //*** Initialize
1224 Move "" To sMessage
1225
1226 //*** Get the cli handle to the connection
1227 Get phCLIHandle To ihstmt
1228 Get psDriverId To sDrvrId
1229 Get phStmtConnection To ihdbc
1230
1231 //*** Call the procedure
1232 If (ihstmt <> 0 And ihdbc <> 0 And sDrvrId <> "") Begin
1233 //*** Setup function arguments
1234 Call_driver 0 sDrvrId Function FUNC_SQLCOLUMNINFO ;
1235 Callback Current_Object ;
1236 Passing ihdbc iMessageNum ihstmt ;
1237 Result iVoid
1238
1239 Move (Repeat(' ', 1024)) To sMessage
1240 //*** Get the length
1241 Call_driver 0 sDrvrId Function FUNC_SQLGETMESSAGE ;
1242 Callback Current_Object ;
1243 Passing iVoid sMessage iVoid ;
1244 Result iVoid
1245 End
1246 Else ;
1247 Send HandleError ihstmt ihdbc sDrvrId "SQLGetDiagRec"
1248
1249 Function_Return sMessage
1250 End_Function // SQLGetMessage
1251
1252
1253
1254 //***
1255 //*** Function: RemoveComponentIdentifier
1256 //*** Purpose : Remove the component identifier from a diagnostic message
1257 //***
1258
1259 Function RemoveComponentIdentifier String sDiagMessage Returns String
1260 While (Left(sDiagMessage, 1) = "[")
1261 Move (Right(sDiagMessage, Length(sDiagMessage) - Pos("]", sDiagMessage))) To sDiagMessage
1262 End
1263
1264 Function_Return sDiagMessage
1265 End_Function
1266
1267
1268
1269 //***
1270 //*** Function: DFDateToSQLDate
1271 //*** Purpose : Convert a DataFlex date to a SQL Date. Use dummy zero dates.
1272 //***
1273
1274 Function DFDateToSQLDate Date dDFDate Returns String
1275 Local Integer hoCLIHandler
1276 Local String sSQLDate
1277
1278 //*** Create a CLI handler object
1279 Object oDFSQLCLIHandler Is A cCLIHandler
1280 Move Current_Object To hoCLIHandler
1281 End_object // oCLIHandler
1282
1283 //*** Convert the date
1284 Get CLIDFDateToSQLDate Of hoCLIHandler (psDRiverID(Current_Object)) dDFDate To sSQLDate
1285
1286 //*** Destroy the object
1287 Send Destroy_Object To hoCLIHandler
1288
1289 Function_Return sSQLDate
1290 End_Function // DFDateToSQLDate
1291
1292
1293
1294 //***
1295 //*** Function: SQLDateToDFDate
1296 //*** Purpose : Convert a SQL date to a DataFlex Date. Use dummy zero dates.
1297 //***
1298
1299 // { Visibility=Private }
1300 Function SQLDateToDFDate String sSQLDate Returns String
1301 Local Integer hoCLIHandler
1302 Local Date dDFDate
1303
1304 //*** Create a CLI handler object
1305 Object oSQLDFCLIHandler Is A cCLIHandler
1306 Move Current_Object To hoCLIHandler
1307 End_object // oCLIHandler
1308
1309 //*** Convert the date
1310 Get CLISQLDateToDFDate Of hoCLIHandler (psDRiverID(Current_Object)) sSQLDate To dDFDate
1311
1312 //*** Destroy the object
1313 Send Destroy_Object To hoCLIHandler
1314
1315 Function_Return dDFDate
1316 End_Function // SQLDateToDFDate
1317
1318End_Class // cSQLStatement
1319
1320
1321//*****************************************************************************
1322//*** Class : cSQLConnection ***
1323//*** Purpose: Connection object for embedded SQL ***
1324//*** ***
1325//*** Description: ***
1326//*** This provides the ability to create a connection for a driver. ***
1327//*** It will contain child statement objects ***
1328//*****************************************************************************
1329
1330Class cSQLConnection is an Array
1331
1332 Procedure Construct_object Integer Image
1333 Forward Send Construct_object Image
1334
1335 Property Integer phCLIHandle Public 0
1336 Property String psDriverID Public ""
1337 Property Integer piBindFile Public 0
1338
1339 Set Delegation_mode to NO_Delegation
1340 End_procedure // COnstruct_object
1341
1342
1343
1344 //***
1345 //*** Procedure: StoreHandleInfo
1346 //*** Purpose : Store basic information about the statement handle.
1347 //***
1348
1349 Procedure StoreHandleInfo Integer iCLIHandle String sDrvrId Integer iParentHandle
1350 Set phCLIHandle To iCLIHandle
1351 Set psDriverID To sDrvrId
1352 End_Procedure // StoreHandleInfo
1353
1354
1355
1356 //***
1357 //*** Procedure: FreeHandle
1358 //*** Purpose : Destroys handle object and all child statement objects
1359 //***
1360
1361 Procedure FreeHandle
1362 Send Destroy_Object
1363 End_Procedure // FreeHandle
1364
1365
1366
1367 //***
1368 //*** Function: SQLConnect
1369 //*** Purpose : Make a connectin to an embedded SQL server
1370 //*** Returns : The DataFlex handle to the connection
1371 //***
1372
1373 Function SQLConnect string sDrvrID String sConnect Returns Integer
1374 Local Integer ihdbc
1375 Local String sEmpty
1376
1377 //*** Initialize
1378 Move "" To sEmpty
1379 Move 0 To ihdbc
1380
1381 Indicate Err False
1382
1383 //*** Call the driver function to connect
1384 Call_driver 0 sDrvrId Function FUNC_SQLCONNECT ;
1385 Callback current_object ;
1386 Passing sConnect sEmpty Current_object ;
1387 Result ihdbc
1388
1389 //*** If there was an error, make result invalid
1390 If (Err) ;
1391 Move 0 To ihdbc
1392
1393 //*** Check result and store it
1394 If (ihdbc <> 0) ;
1395 Send StoreHandleInfo ihdbc sDrvrId 0
1396
1397 //*** Return success status
1398 Function_Return (ihdbc <> 0)
1399 End_function // SQLConnect
1400
1401
1402
1403 //***
1404 //*** Function: SQLFileConnect
1405 //*** Purpose : Use a connection of an already open file
1406 //***
1407
1408 Function SQLFileConnect Integer iFileNum Returns Integer
1409 Local Integer ihdbc
1410 Local Integer bIsOpen
1411 Local String sDrvrId
1412 Local String sEmpty
1413
1414 //*** Initialize
1415 Move "" To sEmpty
1416 Move 0 To ihdbc
1417
1418 //*** Check if file is open
1419 Get_attribute DF_FILE_OPENED Of iFileNum To bIsOpen
1420 If (bIsOpen) Begin
1421 //*** Fill the driver id, assume longest is 255 characters
1422 Move (Repeat(' ', 255)) To sDrvrId
1423 Get_attribute DF_FILE_DRIVER Of iFileNum To sDrvrId
1424
1425 Indicate Err False
1426
1427 //*** Call the driver function to connect
1428 Call_driver iFileNum sDrvrId Function FUNC_SQLFILECONNECT ;
1429 Callback current_object ;
1430 Passing sEmpty sEmpty 0 ;
1431 Result ihdbc
1432
1433 //*** If there was an error, make result invalid
1434 If (Err) ;
1435 Move 0 To ihdbc
1436
1437 //*** Check result and store it
1438 If (ihdbc <> 0) Begin
1439 //*** Somehow Call_driver overwrites the sDrvrId variable, restore it here
1440 Get_attribute DF_FILE_DRIVER Of iFileNum To sDrvrId
1441 Send StoreHandleInfo ihdbc sDrvrId 0
1442
1443 //*** Set filenum so it can be used for fetching
1444 Set piBindFile To iFileNum
1445 End
1446 End
1447
1448 //*** Return success status
1449 Function_Return (ihdbc <> 0)
1450 End_Function // SQLFileConnect
1451
1452
1453
1454 //***
1455 //*** Procedure: SQLDisconnect
1456 //*** Purpose : Disconnect from an embedded SQL server and free allocated
1457 //*** resources
1458 //***
1459
1460 Procedure SQLDisconnect
1461 Local Integer ihdbc
1462 Local Integer iVoid
1463 Local String sDrvrId
1464 Local String sEmpty
1465
1466 //*** Initialize
1467 Move "" To sEmpty
1468
1469 //*** Get the cli handle
1470 Get phCLIHandle To ihdbc
1471 Get psDriverId To sDrvrId
1472
1473 //*** Free the CLI handle
1474 If (ihdbc <> 0) Begin
1475 //*** Call the driver function to disconnect
1476 Call_driver 0 sDrvrId Function FUNC_SQLDISCONNECT ;
1477 Callback Current_object ;
1478 Passing sEmpty sEmpty ihdbc ;
1479 Result iVoid
1480
1481 //*** Free the DataFlex handle
1482 Send FreeHandle
1483 End
1484 End_Procedure // SQLDisconnect
1485
1486
1487
1488 //***
1489 //*** Function: CreateHandle
1490 //*** Purpose : Creates a child statement handle
1491 //***
1492
1493 Function CreateHandle Returns Integer
1494 Local Integer hSQL
1495
1496 Object oSQLStatement Is A cSQLStatement
1497 Move current_object To hSQL
1498 End_Object // oSQLStatement
1499
1500 //*** If the connection has a default Bind File, assign it to the
1501 //*** statement object. The default is set when you open a file with a
1502 //*** SetFileConnection command.
1503 Set piBindFile Of hSQL To (piBindFile(Current_object))
1504
1505 Function_Return hSQL
1506 End_Function // CreateHandle
1507
1508
1509
1510 //***
1511 //*** Function: SQLOpen
1512 //*** Prupose : Open a statement for use
1513 //***
1514
1515 Function SQLOpen Returns Integer
1516 Local Integer hDFHandle
1517 Local Integer ihdbc
1518 Local Integer ihstmt
1519 Local Integer iVoid
1520 Local String sDrvrId
1521 Local String sEmpty
1522
1523 //*** Initialize
1524 Move "" To sEmpty
1525
1526 //*** Get the cli handle to the connection
1527 Get phCLIHandle To ihdbc
1528 Get psDriverId To sDrvrId
1529
1530 //*** Allocate a new handle and populate it
1531 If (ihdbc <> 0) Begin
1532 //**** Create a new DataFlex handle
1533 Get CreateHandle To hDFHandle
1534
1535 //*** Call the driver function to allocate a statement handle
1536 Call_driver 0 sDrvrId Function FUNC_SQLOPEN ;
1537 Callback Current_object ;
1538 Passing hDFHandle sEmpty ihdbc ;
1539 Result ihstmt
1540
1541 //*** If unsuccessful destroy DF side info
1542 If (ihstmt = 0) Begin
1543 Send FreeHandle to hDFHandle
1544 Move 0 to hDFHandle
1545 End
1546 Else ;
1547 Send StoreHandleInfo to hDFHandle ihstmt sDrvrId ihdbc
1548 End
1549
1550 Function_return hDFHandle
1551 End_function // SQLOpen
1552
1553End_Class // cSQLConnection
1554
1555
1556
1557//*****************************************************************************
1558//*** Class : cSQLHandlemanager ***
1559//*** Purpose: Manager for embedded SQL handles. ***
1560//*** ***
1561//*** Description: ***
1562//*** We want to be able to use multiple drivers and multiple ***
1563//*** connections within a driver and multiple statements within a ***
1564//*** connection. To allow this we have palced our own handle logic on ***
1565//*** top of the driver handle logic. This way we can handle the ***
1566//*** situation where two driver handles may be equal. ***
1567//*****************************************************************************
1568
1569Class cSQLHandleManager Is A Array
1570
1571 Procedure Construct_object Integer Image
1572 Forward Send Construct_object Image
1573
1574 Property String psDefaultDriver Public ""
1575 Property String psDefaultConnection Public ""
1576
1577 Set Delegation_mode to NO_Delegation
1578 End_procedure // COnstruct_object
1579
1580
1581
1582 //***
1583 //*** Function: CreateHandle
1584 //*** Purpose : Allocate memory for the desired type of handle
1585 //***
1586
1587 Function CreateHandle Returns Integer
1588 Local Integer hSQL
1589
1590 //*** Create a connection object
1591 Object oSQLConnection Is A cSQLConnection
1592 Move current_object To hSQL
1593 End_Object // oSQLConnection
1594
1595 Function_Return hSQL
1596 End_Function // CreateHandle
1597
1598
1599
1600 //***
1601 //*** Procedure: SQLSetConnect
1602 //*** Purpose : Store default connection information
1603 //***
1604
1605 Procedure SQLSetConnect String sDriver String sConnect
1606 Set psDefaultDriver To sDriver
1607 Set psDefaultConnection To sConnect
1608 End_Procedure // SQLSetConnect
1609
1610
1611
1612 //***
1613 //*** Function: SQLConnect
1614 //*** Purpose : Make a connectin to an embedded SQL server
1615 //*** Returns : The DataFlex handle to the connection
1616 //***
1617
1618 Function SQLConnect String sDrvrID String sConnect Returns integer
1619 Local Integer hDFHandle
1620 Local Integer bOK
1621
1622 //*** Check arguments
1623 If (sDrvrID = "" And sConnect = "") Begin
1624 Get psDefaultDriver To sDrvrId
1625 Get psDefaultConnection To sConnect
1626 End
1627
1628 //*** Allocate a new handle
1629 Get CreateHandle To hDFHandle
1630 Get SQLConnect of hDFHandle sDrvrID sConnect To bOK
1631
1632 //*** If failure, kill the handle and return a 0 handle
1633 If (Not(bOK)) Begin
1634 Send FreeHandle to hDFHandle
1635 Move 0 to hDFHandle
1636 End
1637
1638 Function_return hDFHandle
1639 End_function // SQLConnect
1640
1641
1642
1643 //***
1644 //*** Function: SQLFileConnect
1645 //*** Purpose : Make an existing connection available for use with Embedded
1646 //*** SQL. The connection is identified by the number opf a file
1647 //*** that is open for that connection.
1648 //***
1649
1650 Function SQLFileConnect Integer iFileNum Returns Integer
1651 Local Integer hDFHandle
1652 Local Integer bOK
1653
1654 //*** Allocate a new handle
1655 Get CreateHandle To hDFHandle
1656 Get SQLFileConnect of hDFHandle iFileNum To bOK
1657
1658 //*** If failure, kill the handle and return a 0 handle
1659 If (Not(bOK)) Begin
1660 Send FreeHandle to hDFHandle
1661 Move 0 to hDFHandle
1662 End
1663
1664 Function_return hDFHandle
1665 End_Function // SQLFileConnect
1666
1667End_Class // cSQLHandleManager
1668
1669//***
1670//*** Function: CreateSQLManager
1671//*** Purpose : Create the embedded SQL manager, this is an internal function!
1672//***
1673
1674
1675#IFDEF IS$WINDOWS
1676
1677Function CreateSQLmanager For cDesktop Returns Integer
1678 Local Integer hoSQlMngr
1679
1680 Object oSQLHandleManager Is A cSQLHandleManager
1681 MOve Current_object To hoSQLMngr
1682 End_Object // oSQLHandleManager
1683
1684 Function_Return hoSQLMngr
1685End_Function // CreateSQLMngr
1686
1687#ELSE
1688
1689// if windows, the method is added to the real desktop class (i.e., the desktop object). If
1690// not windows, the method is added to UI_Object so all objects understand it (this is not desirable
1691// but it is the choice we have in character mode).
1692
1693Function CreateSQLmanager For Desktop Returns Integer
1694 Local Integer hoSQlMngr
1695
1696 Object oSQLHandleManager Is A cSQLHandleManager
1697 MOve Current_object To hoSQLMngr
1698 End_Object // oSQLHandleManager
1699
1700 Function_Return hoSQLMngr
1701End_Function // CreateSQLMngr
1702
1703#ENDIF
1704
1705//*** Make sure the object is global by creating it under DESKTOP
1706Get CreateSQLManager Of Desktop To _embsqlghoSQLHandleMngr
1707
1708//*****************************************************************************
1709//*** Command: SQLSetConnect ***
1710//*** Purpose: Setup default connection information for embedded SQL. ***
1711//*** ***
1712//*** Syntax : SQLSetConnect sSDriverId sConnectString ***
1713//*****************************************************************************
1714
1715#COMMAND SQLSetConnect R R .
1716 Send SQLSetConnect To _embsqlghoSQLHandleMngr !1 !2
1717#ENDCOMMAND
1718
1719
1720
1721//*****************************************************************************
1722//*** Command: SQLConnect ***
1723//*** Purpose: Connect to a server for embedded SQL usage. ***
1724//*** ***
1725//*** Syntax : SQLConnect To hdbc ***
1726//*** SQLConnect [sDriverId sConnectString] To hdbc ***
1727//*****************************************************************************
1728
1729#COMMAND SQLConnect
1730 //*** Check form command is used in
1731 #IFSAME !1 TO
1732 SQLConnect "" "" to !2
1733 #ELSE
1734 Get SQLConnect Of _embsqlghoSQLHandleMngr !1 !2 To !4
1735 #ENDIF
1736#ENDCOMMAND
1737
1738
1739
1740//*****************************************************************************
1741//*** Command: SQLFileConnect ***
1742//*** Purpsoe: Return the handle to a connection of an open file. This ***
1743//*** connection is (obviously) already opened. We are just using ***
1744//*** the same connection for Embedded SQL. This allows the ***
1745//*** programmer not to know connection details. ***
1746//*** ***
1747//*** Syntax : SQLFileConnect Filex To hdbc ***
1748//*****************************************************************************
1749
1750#COMMAND SQLFileConnect R "TO" R .
1751 #IFDEF !1
1752 Get SQLFileConnect Of _embsqlghoSQLHandleMngr !1 To !3
1753 #ELSE
1754 Get SQLFileConnect Of _embsqlghoSQLHandleMngr !1.File_number To !3
1755 #ENDIF
1756#ENDCOMMAND
1757
1758
1759
1760//*****************************************************************************
1761//*** Command: SQLDisconnect ***
1762//*** Purpose: Connect to a server for embedded SQL usage. ***
1763//*** ***
1764//*** Syntax : SQLDisConnect hdbc ***
1765//*****************************************************************************
1766
1767#COMMAND SQLDisconnect R .
1768 If (!1) Send SQLDisconnect to !1
1769#ENDCOMMAND
1770
1771
1772
1773//*****************************************************************************
1774//*** Command: SQLOpen ***
1775//*** Purpose: Allocate the memory to stroe statement information. ***
1776//*** ***
1777//*** Syntax : SQLOpen hdbc To hstmt ***
1778//*****************************************************************************
1779
1780#COMMAND SQLOpen R "TO" R .
1781 If (!1) Get SQLOpen Of !1 To !3
1782#ENDCOMMAND
1783
1784
1785
1786//*****************************************************************************
1787//*** Command: SQLClose ***
1788//*** Purpose: Close a statement and free all associated memory. ***
1789//*** ***
1790//*** Syntax : SQLClose hstmt ***
1791//*****************************************************************************
1792
1793#COMMAND SQLClose R .
1794 If (!1) Send SQLClose to !1
1795#ENDCOMMAND
1796
1797
1798
1799//*****************************************************************************
1800//*** Command: SQLPrepare ***
1801//*** Purpose: Prepare a statement for execution. ***
1802//*** ***
1803//*** Syntax : SQLPrepare hstmt sStatement ***
1804//*****************************************************************************
1805
1806#COMMAND SQLPrepare R R .
1807 If (!1) Send SQLPrepare to !1 !2
1808#ENDCOMMAND
1809
1810
1811
1812//*****************************************************************************
1813//*** Command: SQLExecute ***
1814//*** Purpose: Execute a prepared statement ***
1815//*** ***
1816//*** Syntax : SQLExecute hstmt ***
1817//*****************************************************************************
1818
1819#COMMAND SQLExecute R .
1820 If (!1) Send SQLExecute to !1
1821#ENDCOMMAND
1822
1823
1824
1825//*****************************************************************************
1826//*** Command: SQLExecDirect ***
1827//*** Purpose: Prepare and execute a statement. ***
1828//*** ***
1829//*** Syntax : SQLExecDirect hstmt sStatement ***
1830//*****************************************************************************
1831
1832#COMMAND SQLExecDirect R R .
1833 If (!1) Send SQLEXECDirect to !1 !2
1834#ENDCOMMAND
1835
1836
1837
1838//*****************************************************************************
1839//*** Command: SQLFileFetch ***
1840//*** Purpose: Get a row from a statement result set. ***
1841//*** ***
1842//*** Syntax : SQLFileFetch hstmt [To File1 [File2 ...]] ***
1843//*****************************************************************************
1844
1845#COMMAND SQL$NextFile R R
1846 #IFDEF !2
1847 If (!1) Send SQLBindFile To !1 !2
1848 #ELSE
1849 If (!1) Send SQLBindFile To !1 !2.File_number
1850 #ENDIF
1851 #IF (!0>2)
1852 SQL$NextFile !1 !3 !4 !5 !6 !7 !8 !9
1853 #ENDIF
1854#ENDCOMMAND
1855
1856#COMMAND SQLFileFetch R
1857 If (!1) Get SQLFetch Of !1 To SQLResult
1858
1859 #IF (!0=1)
1860 //*** zero tells statement object to use file property
1861 If (SQLResult) ;
1862 Send SQLBindFile To !1 0
1863 #ENDIF
1864
1865 #IFSAME !2 TO
1866 If (SQLResult) Begin
1867 #IF (!0>2)
1868 SQL$NextFile !1 !3 !4 !5 !6 !7 !8 !9
1869 #ENDIF
1870 End
1871 #ENDIF
1872#ENDCOMMAND
1873
1874
1875
1876//*****************************************************************************
1877//*** Command: SQLBindFetchFile ***
1878//*** Purpose: Binds a file number to a statement so it can be used for ***
1879//*** fetching data. Only needed in non fileconnect. Note that ***
1880//*** can be assigned to the connection or the statement handle ***
1881//*** ***
1882//*** Syntax : SQLBindFileForFetch hstmt|hdbc FileName|FileNumber ***
1883//*****************************************************************************
1884
1885#COMMAND SQLBindFetchFile R R .
1886 #IFDEF !2
1887 If (!1) Set piBindFile Of !1 To !2
1888 #ELSE
1889 If (!1) Set piBindFile Of !1 To !2.File_Number
1890 #ENDIF
1891#ENDCOMMAND
1892
1893
1894
1895//*****************************************************************************
1896//*** Command: SQLFetch ***
1897//*** Purpose: Get a row from a statement result set. ***
1898//*** ***
1899//*** Syntax : SQLFetch hstmt [To Var1 [Var2 ...]] ***
1900//*****************************************************************************
1901
1902#COMMAND SQL$NextColumn R R
1903 If (!1) Get SQLNextColumn Of !1 To !2
1904 #IF (!0>2)
1905 SQL$NextColumn !1 !3 !4 !5 !6 !7 !8 !9
1906 #ENDIF
1907#ENDCOMMAND
1908
1909#COMMAND SQLFetch R
1910 If (!1) Get SQLFetch Of !1 To SQLResult
1911 #IFSAME !2 TO
1912 If (SQLResult) Begin
1913 #IF (!0>2)
1914 SQL$NextColumn !1 !3 !4 !5 !6 !7 !8 !9
1915 #ENDIF
1916 End
1917 #ENDIF
1918#ENDCOMMAND
1919
1920
1921
1922//*****************************************************************************
1923//*** Command: SQLGetData ***
1924//*** Purpose: Get a column's data. ***
1925//*** ***
1926//*** Syntax : SQLGetData hstmt iColumnNUmber [Length iLen] To Var ***
1927//*****************************************************************************
1928
1929#COMMAND SQLGetData R
1930 If (!1) Begin
1931 #IF (!0>2)
1932 #IF (!0=6)
1933 Get SQLGetData Of !1 !2 !4 To !6
1934 #ELSE
1935 Get SQLGetData Of !1 !2 0 To !4
1936 #ENDIF
1937 #ENDIF
1938 End
1939#ENDCOMMAND
1940
1941
1942
1943//*****************************************************************************
1944//*** Command: SQLColumnMap ***
1945//*** Purpose: Determine the column number based on the column name. ***
1946//*** ***
1947//*** Syntax : SQLColumnMap hstmt sColName To iColNumber ***
1948//*****************************************************************************
1949
1950#COMMAND SQLColumnMap R R "TO" R .
1951 Move 0 To !4
1952 If (!1) ;
1953 Get SQLColumnMap Of !1 !2 To !4
1954#ENDCOMMAND
1955
1956
1957
1958//*****************************************************************************
1959//*** Command: SQLColAttribute ***
1960//*** Purpose: Get an attribute of a column in a statements result set. ***
1961//*** ***
1962//*** Syntax : SQLColAttribute hstmt iCol iAttrId To sAttrib ***
1963//*****************************************************************************
1964
1965#COMMAND SQLColAttribute R R R "TO" R .
1966 Move "" To !5
1967 If (!1) ;
1968 Get SQLColAttribute Of !1 !2 !3 To !5
1969#ENDCOMMAND
1970
1971
1972
1973//*****************************************************************************
1974//*** Command: SQLStmtAttribute ***
1975//*** Purpose: Get an atribute of a statement. ***
1976//*** ***
1977//*** Syntax : SQLStmtAttribute hstmt iAttribId To sAttrib ***
1978//*****************************************************************************
1979
1980#COMMAND SQLStmtAttribute R R "TO" R .
1981 Move "" To !4
1982 If (!1) ;
1983 Get SQLStmtAttribute Of !1 !2 To !4
1984#ENDCOMMAND
1985
1986
1987
1988//*****************************************************************************
1989//*** Command: SQLCall ***
1990//*** Purpose: Call a stored procedure. ***
1991//*** ***
1992//*** Syntax : SQLCall hstmt ProcedureName SchemaName [Arg1 ...] [To Var] ***
1993//*** You can pass "" for SchemaName. ***
1994//*****************************************************************************
1995
1996#COMMAND SQL$SetNextArgument R R
1997 #IFSAME !2 TO
1998 //*** We do not need to set a return value before calling the procedure
1999 //*** afert all, return values are filled after it is called. Simply
2000 //*** stop when a TO is found.
2001 #ELSE
2002 If (!1) Send SQLSetNextArgument To !1 !2
2003 #IF (!0>2)
2004 SQL$SetNextArgument !1 !3 !4 !5 !6 !7 !8 !9
2005 #ENDIF
2006 #ENDIF
2007#ENDCOMMAND
2008
2009#COMMAND SQL$GetNextArgument R R
2010 #IFSAME !2 TO
2011 #IF (!0>2)
2012 Get SQLReturnValue Of !1 To !3
2013 #ENDIF
2014 #ELSE
2015 If (!1) Get SQLGetNextArgument Of !1 To !2
2016 #IF (!0>2)
2017 SQL$GetNextArgument !1 !3 !4 !5 !6 !7 !8 !9
2018 #ENDIF
2019 #ENDIF
2020#ENDCOMMAND
2021
2022#COMMAND SQLCall R R R
2023 If (!1) Begin
2024 #IF (!0>1)
2025 //*** Setup name, arguments and return value before actually calling
2026 Send SQLSetProcedureName To !1 !2 !3
2027 #IF (!0>2)
2028 SQL$SetNextArgument !1 !4 !5 !6 !7 !8 !9
2029 #ENDIF
2030
2031 //*** Call
2032 Send SQLCall To !1
2033
2034 //*** Get arguments and return value after the call
2035 #IF (!0>2)
2036 SQL$GetNextArgument !1 !4 !5 !6 !7 !8 !9
2037 #ENDIF
2038 #ENDIF
2039 End
2040#ENDCOMMAND
2041
2042
2043
2044//*****************************************************************************
2045//*** Command: SQLGetArguments ***
2046//*** Purpsoe: Get the arguments of a stored procedure. This command should ***
2047//*** be used when a procedure has multiple result sets. Some ***
2048//*** backends (SQL SErver for example) will return these as the ***
2049//*** last result set. This emans you first process all other ***
2050//*** result sets and then get the arguments and return value. ***
2051//*** ***
2052//*** Syntax : SQLGetArguments hstmt [Arg1...] [To Var] ***
2053//*****************************************************************************
2054
2055#COMMAND SQLGetArguments R
2056 SQL$GetNextArgument !1 !2 !3 !4 !5 !6 !7 !8 !9
2057#ENDCOMMAND
2058
2059
2060
2061//*****************************************************************************
2062//*** Command: SQLNextResultSet ***
2063//*** Purpose: Go the the next result set. This command should be used when ***
2064//*** a procedure call results in multiple result sets. Processing ***
2065//*** such procedures can be done by loping through the result ***
2066//*** sets. ***
2067//*** ***
2068//*** Syntax : SQLNextResultSet hstmt ***
2069//*****************************************************************************
2070
2071#COMMAND SQLNextResultSet R .
2072 If (!1) Get SQLNextResultSet Of !1 To SQLResult
2073#ENDCOMMAND
2074
2075
2076
2077//*****************************************************************************
2078//*** Command: SQLFetchActivatesBuffer ***
2079//*** Purpose: Setup fetch behavior for a file. When set to true a ***
2080//*** succesfull fetch of the statement resutl set will ***
2081//*** automatically set the status of the file's bufer to ***
2082//*** DF_FILE_ACTIVE. ***
2083//*** ***
2084//*** Syntax : SQLFetchActivatesBuffer hstmt FileNUmber|FileName sState ***
2085//*****************************************************************************
2086
2087#COMMAND SQLFetchActivatesBuffer R R R .
2088 #IFDEF !2
2089 If (!1) Send SQLFetchActivatesBuffer To !1 !2 !3
2090 #ELSE
2091 If (!1) Send SQLFetchActivatesBuffer To !1 !2.File_number !3
2092 #ENDIF
2093#ENDCOMMAND
2094
2095