zeoslib  UNKNOWN
 All Files
ZDbcInterbase6Statement.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Interbase Database Connectivity Classes }
5 { }
6 { Originally written by Sergey Merkuriev }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
20 { }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
39 { }
40 { }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZDbcInterbase6Statement;
53 
54 interface
55 
56 {$I ZDbc.inc}
57 
58 uses Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils, Types,
59  ZDbcIntfs, ZDbcStatement, ZDbcInterbase6, ZDbcInterbase6Utils,
60  ZDbcInterbase6ResultSet, ZPlainFirebirdInterbaseConstants, ZCompatibility,
61  ZDbcLogging, ZVariant, ZMessages;
62 
63 type
64 
65  {** Implements Generic Interbase6 Statement. }
66  TZInterbase6Statement = class(TZAbstractStatement)
67  private
68  FCachedBlob: boolean;
69  FStatusVector: TARRAY_ISC_STATUS;
70  FIBConnection: IZInterbase6Connection;
71  protected
72  function CheckInterbase6Error(const Sql: string = '') : Integer;
73  public
74  constructor Create(Connection: IZConnection; Info: TStrings);
75 
76  function ExecuteQuery(const SQL: RawByteString): IZResultSet; override;
77  function ExecuteUpdate(const SQL: RawByteString): Integer; override;
78  function Execute(const SQL: RawByteString): Boolean; override;
79  end;
80 
81  {** Implements Prepared SQL Statement. }
82 
83  { TZInterbase6PreparedStatement }
84 
85  TZInterbase6PreparedStatement = class(TZAbstractPreparedStatement)
86  private
87  FCachedBlob: boolean;
88  FParamSQLData: IZParamsSQLDA;
89  FStatusVector: TARRAY_ISC_STATUS;
90  FIBConnection: IZInterbase6Connection;
91 
92  Cursor: AnsiString;
93  SQLData: IZResultSQLDA;
94  StmtHandle: TISC_STMT_HANDLE;
95  StatementType: TZIbSqlStatementType;
96  protected
97  procedure PrepareInParameters; override;
98  procedure SetASQL(const Value: RawByteString); override;
99  procedure SetWSQL(const Value: ZWideString); override;
100  procedure BindInParameters; override;
101  procedure UnPrepareInParameters; override;
102  function CheckInterbase6Error(const Sql: string = '') : Integer;
103  public
104  constructor Create(Connection: IZConnection; const SQL: string; Info: TStrings);
105  destructor Destroy; override;
106 
107  procedure Prepare; override;
108  procedure Unprepare; override;
109 
110  function ExecuteQueryPrepared: IZResultSet; override;
111  function ExecuteUpdatePrepared: Integer; override;
112  function ExecutePrepared: Boolean; override;
113  end;
114 
115  TZInterbase6CallableStatement = class(TZAbstractPreparedCallableStatement)
116  private
117  FCachedBlob: boolean;
118  FParamSQLData: IZParamsSQLDA;
119  FResultSQLData: IZResultSQLDA;
120  FStmtHandle: TISC_STMT_HANDLE;
121  FStatementType: TZIbSqlStatementType;
122  FStatusVector: TARRAY_ISC_STATUS;
123  FIBConnection: IZInterbase6Connection;
124  protected
125  procedure CheckInterbase6Error(const Sql: string = '');
126  procedure FetchOutParams(Value: IZResultSQLDA);
127  function GetProcedureSql(SelectProc: boolean): string;
128 
129  procedure PrepareInParameters; override;
130  procedure BindInParameters; override;
131  procedure UnPrepareInParameters; override;
132  public
133  constructor Create(Connection: IZConnection; const SQL: string; Info: TStrings);
134  destructor Destroy; override;
135  procedure Unprepare; override;
136 
137  function ExecuteQueryPrepared: IZResultSet; override;
138  function ExecuteUpdatePrepared: Integer; override;
139  function ExecutePrepared: Boolean; override;
140  end;
141 
142 implementation
143 
144 uses ZSysUtils, ZDbcUtils;
145 
146 { TZInterbase6Statement }
147 
148 {**
149  Check interbase error status
150  @param Sql the used sql tring
151 
152  @return ErrorCode for possible Database Disconnect
153 }
154 function TZInterbase6Statement.CheckInterbase6Error(const Sql: string = '') : Integer;
155 begin
156  Result := ZDbcInterbase6Utils.CheckInterbase6Error(FIBConnection.GetPlainDriver,
157  FStatusVector, lcExecute, SQL);
158 end;
159 
160 
161 {**
162  Constructs this object and assignes the main properties.
163  @param Connection a database connection object.
164  @param Handle a connection handle pointer.
165  @param Dialect a dialect Interbase SQL must be 1 or 2 or 3.
166  @param Info a statement parameters.
167 }
168 constructor TZInterbase6Statement.Create(Connection: IZConnection;
169  Info: TStrings);
170 begin
171  inherited Create(Connection, Info);
172 
173  FIBConnection := Connection as IZInterbase6Connection;
174  ResultSetType := rtScrollInsensitive;
175  FCachedBlob := StrToBoolEx(DefineStatementParameter(Self, 'cashedblob', 'true'));
176 end;
177 
178 {**
179  Destroys this object and cleanups the memory.
180 }
181 {**
182  Executes an SQL statement that returns a single <code>ResultSet</code> object.
183  @param sql typically this is a static SQL <code>SELECT</code> statement
184  @return a <code>ResultSet</code> object that contains the data produced by the
185  given query; never <code>null</code>
186 }
187 {$HINTS OFF}
188 function TZInterbase6Statement.ExecuteQuery(const SQL: RawByteString): IZResultSet;
189 var
190  Cursor: AnsiString;
191  SQLData: IZResultSQLDA;
192  StmtHandle: TISC_STMT_HANDLE;
193  StatementType: TZIbSqlStatementType;
194  iError : Integer; //For closing the database //AVZ
195 begin
196  StmtHandle := 0;
197  iError := 0;
198  {$IFNDEF UNICODE}ASQL := SQL;{$ENDIF} //preprepares SQL and sets AnsiSQL(ASQL)
199  with FIBConnection do
200  begin
201  SQLData := TZResultSQLDA.Create(GetPlainDriver, GetDBHandle, GetTrHandle, ConSettings);
202  try
203  StatementType := ZDbcInterbase6Utils.PrepareStatement(GetPlainDriver,
204  GetDBHandle, GetTrHandle, GetDialect, ASQL, SSQL, StmtHandle);
205 
206  PrepareResultSqlData(GetPlainDriver, GetDBHandle, GetDialect,
207  SSQL, StmtHandle, SQLData);
208 
209  DriverManager.LogMessage(lcExecute, GetPlainDriver.GetProtocol, SSQL);
210 
211  GetPlainDriver.isc_dsql_execute(@FStatusVector, GetTrHandle,
212  @StmtHandle, GetDialect, SQLData.GetData);
213  iError := CheckInterbase6Error(SSQL);
214 
215  if (StatementType in [stSelect, stExecProc])
216  and (SQLData.GetFieldCount <> 0) then
217  begin
218  if CursorName <> '' then
219  begin
220  Cursor := CursorName;
221  GetPlainDriver.isc_dsql_set_cursor_name(@FStatusVector,
222  @StmtHandle, PAnsiChar(Cursor), 0);
223  CheckInterbase6Error(SSQL);
224  end;
225 
226  Result := CreateIBResultSet(SSQL, Self,
227  TZInterbase6ResultSet.Create(Self, LogSQL, StmtHandle, Cursor, SQLData, FCachedBlob));
228  end
229  else
230  if (iError <> DISCONNECT_ERROR) then
231  raise EZSQLException.Create(SCanNotRetrieveResultSetData);
232  except
233  on E: Exception do
234  begin
235  FreeStatement(GetPlainDriver, StmtHandle, DSQL_drop); //Free Stmt handle only if Execution fails. Otherwise the ResultSet will do this
236  raise;
237  end;
238  end;
239  end;
240 end;
241 {$HINTS OFF}
242 
243 {**
244  Executes an SQL <code>INSERT</code>, <code>UPDATE</code> or
245  <code>DELETE</code> statement. In addition,
246  SQL statements that return nothing, such as SQL DDL statements,
247  can be executed.
248 
249  @param sql an SQL <code>INSERT</code>, <code>UPDATE</code> or
250  <code>DELETE</code> statement or an SQL statement that returns nothing
251  @return either the row count for <code>INSERT</code>, <code>UPDATE</code>
252  or <code>DELETE</code> statements, or 0 for SQL statements that return nothing
253 }
254 {$HINTS OFF}
255 function TZInterbase6Statement.ExecuteUpdate(const SQL: RawByteString): Integer;
256 var
257  StmtHandle: TISC_STMT_HANDLE;
258  StatementType: TZIbSqlStatementType;
259 begin
260  Result := -1;
261  StmtHandle := 0;
262  with FIBConnection do
263  begin
264  try
265  {$IFNDEF UNICODE}ASQL := SQL;{$ENDIF} //preprepares SQL and sets AnsiSQL(ASQL)
266  StatementType := ZDbcInterbase6Utils.PrepareStatement(GetPlainDriver,
267  GetDBHandle, GetTrHandle, GetDialect, ASQL, SSQL, StmtHandle);
268 
269  DriverManager.LogMessage(lcExecute, GetPlainDriver.GetProtocol, SSQL);
270 
271  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle,
272  @StmtHandle, GetDialect, nil, nil);
273  CheckInterbase6Error(SSQL);
274 
275  case StatementType of
276  stCommit, stRollback, stUnknown: Result := -1;
277  else
278  begin
279  Result := GetAffectedRows(GetPlainDriver, StmtHandle, StatementType);
280  LastUpdateCount := Result;
281  end;
282  end;
283 
284  { Autocommit statement. }
285  if Connection.GetAutoCommit then
286  Connection.Commit;
287  { Logging SQL Command }
288  finally
289  FreeStatement(GetPlainDriver, StmtHandle, DSQL_drop); //Free Stmt handle because of single executions without a prepared state
290  end;
291  end;
292 end;
293 {$HINTS ON}
294 
295 {**
296  Executes an SQL statement that may return multiple results.
297  Under some (uncommon) situations a single SQL statement may return
298  multiple result sets and/or update counts. Normally you can ignore
299  this unless you are (1) executing a stored procedure that you know may
300  return multiple results or (2) you are dynamically executing an
301  unknown SQL string. The methods <code>execute</code>,
302  <code>getMoreResults</code>, <code>getResultSet</code>,
303  and <code>getUpdateCount</code> let you navigate through multiple results.
304 
305  The <code>execute</code> method executes an SQL statement and indicates the
306  form of the first result. You can then use the methods
307  <code>getResultSet</code> or <code>getUpdateCount</code>
308  to retrieve the result, and <code>getMoreResults</code> to
309  move to any subsequent result(s).
310 
311  @param sql any SQL statement
312  @return <code>true</code> if the next result is a <code>ResultSet</code> object;
313  <code>false</code> if it is an update count or there are no more results
314  @see #getResultSet
315  @see #getUpdateCount
316  @see #getMoreResults
317 }
318 {$HINTS OFF}
319 function TZInterbase6Statement.Execute(const SQL: RawByteString): Boolean;
320 var
321  Cursor: AnsiString;
322  SQLData: IZResultSQLDA;
323  StmtHandle: TISC_STMT_HANDLE;
324  StatementType: TZIbSqlStatementType;
325 begin
326  StmtHandle := 0;
327  with FIBConnection do
328  begin
329  try
330  Result := False;
331  {$IFNDEF UNICODE}ASQL := SQL;{$ENDIF} //preprepares SQL and sets AnsiSQL(ASQL)
332  StatementType := ZDbcInterbase6Utils.PrepareStatement(GetPlainDriver,
333  GetDBHandle, GetTrHandle, GetDialect, ASQL, LogSQL, StmtHandle);
334 
335  { Check statement type }
336 // if not (StatementType in [stExecProc]) then
337 // raise EZSQLException.Create(SStatementIsNotAllowed);
338 
339  { Create Result SQLData if statement returns result }
340  if StatementType in [stSelect, stExecProc] then
341  begin
342  SQLData := TZResultSQLDA.Create(GetPlainDriver, GetDBHandle, GetTrHandle, ConSettings);
343  PrepareResultSqlData(GetPlainDriver, GetDBHandle, GetDialect, LogSQL,
344  StmtHandle, SQLData);
345  end;
346 
347  DriverManager.LogMessage(lcExecute, GetPlainDriver.GetProtocol, SSQL);
348  { Execute prepared statement }
349  GetPlainDriver.isc_dsql_execute(@FStatusVector, GetTrHandle,
350  @StmtHandle, GetDialect, nil);
351  CheckInterbase6Error(LogSQL);
352  { Set updated rows count }
353  LastUpdateCount := GetAffectedRows(GetPlainDriver, StmtHandle, StatementType);
354 
355  case StatementType of
356  stInsert, stDelete, stUpdate, stSelectForUpdate: Result := False;
357  else
358  Result := True;
359  end;
360 
361  { Create ResultSet if possible else free Stateent Handle }
362  if (StatementType in [stSelect, stExecProc])
363  and (SQLData.GetFieldCount <> 0) then
364  begin
365  if CursorName <> '' then
366  begin
367  Cursor := CursorName;
368 
369  GetPlainDriver.isc_dsql_set_cursor_name(@FStatusVector,
370  @StmtHandle, PAnsiChar(Cursor), 0);
371  CheckInterbase6Error(sSQL);
372  end;
373 
374  LastResultSet := CreateIBResultSet(SSQL, Self,
375  TZInterbase6ResultSet.Create(Self, SSQL, StmtHandle, Cursor,
376  SQLData, FCachedBlob));
377  end
378  else
379  begin
380  LastResultSet := nil;
381  FreeStatement(GetPlainDriver, StmtHandle, DSQL_drop);
382  end;
383 
384  { Autocommit statement. }
385  if Connection.GetAutoCommit then
386  Connection.Commit;
387  except
388  on E: Exception do
389  begin
390  FreeStatement(GetPlainDriver, StmtHandle, DSQL_drop); //Free Stmt handle because of single executions without a prepared state
391  raise;
392  end;
393  end;
394  end;
395 end;
396 {$HINTS ON}
397 
398 { TZInterbase6PreparedStatement }
399 
400 procedure TZInterbase6PreparedStatement.PrepareInParameters;
401 var
402  StatusVector: TARRAY_ISC_STATUS;
403 begin
404  With FIBConnection do
405  begin
406  {create the parameter bind structure}
407  FParamSQLData := TZParamsSQLDA.Create(GetPlainDriver, GetDBHandle, GetTrHandle, ConSettings);
408  {check dynamic sql}
409  GetPlainDriver.isc_dsql_describe_bind(@StatusVector, @StmtHandle, GetDialect,
410  FParamSQLData.GetData);
411  ZDbcInterbase6Utils.CheckInterbase6Error(GetPlainDriver, StatusVector, lcExecute, SSQL);
412 
413  { Resize XSQLDA structure if needed }
414  if FParamSQLData.GetData^.sqld > FParamSQLData.GetData^.sqln then
415  begin
416  FParamSQLData.AllocateSQLDA;
417  GetPlainDriver.isc_dsql_describe_bind(@StatusVector, @StmtHandle, GetDialect,FParamSQLData.GetData);
418  ZDbcInterbase6Utils.CheckInterbase6Error(GetPlainDriver, StatusVector, lcExecute, SSQL);
419  end;
420 
421  FParamSQLData.InitFields(True);
422  end;
423  inherited PrepareInParameters;
424 end;
425 
426 procedure TZInterbase6PreparedStatement.SetASQL(const Value: RawByteString);
427 begin
428  if ( ASQL <> Value ) and Prepared then
429  Unprepare;
430  inherited SetASQL(Value);
431 end;
432 
433 procedure TZInterbase6PreparedStatement.SetWSQL(const Value: ZWideString);
434 begin
435  if ( WSQL <> Value ) and Prepared then
436  Unprepare;
437  inherited SetWSQL(Value);
438 end;
439 
440 procedure TZInterbase6PreparedStatement.BindInParameters;
441 begin
442  BindSQLDAInParameters(FIBConnection.GetPlainDriver, InParamValues,
443  InParamTypes, InParamCount, FParamSQLData, GetConnection.GetConSettings);
444  inherited BindInParameters;
445 end;
446 
447 procedure TZInterbase6PreparedStatement.UnPrepareInParameters;
448 begin
449  if assigned(FParamSQLData) then
450  FParamSQLData.FreeParamtersValues;
451 end;
452 
453 {**
454  Check interbase error status
455  @param Sql the used sql tring
456 
457  @return Integer - Error Code to test for graceful database disconnection
458 }
459 function TZInterbase6PreparedStatement.CheckInterbase6Error(const Sql: string) : Integer;
460 begin
461  Result := ZDbcInterbase6Utils.CheckInterbase6Error(FIBConnection.GetPlainDriver,
462  FStatusVector, lcExecute, SQL);
463 end;
464 
465 {**
466  Constructs this object and assignes the main properties.
467  @param Connection a database connection object.
468  @param Handle a connection handle pointer.
469  @param Dialect a dialect Interbase SQL must be 1 or 2 or 3.
470  @param Info a statement parameters.
471 }
472 constructor TZInterbase6PreparedStatement.Create(Connection: IZConnection;
473  const SQL: string; Info: TStrings);
474 begin
475  inherited Create(Connection, SQL, Info);
476 
477  FIBConnection := Connection as IZInterbase6Connection;
478  ResultSetType := rtScrollInsensitive;
479  FCachedBlob := StrToBoolEx(DefineStatementParameter(Self, 'cashedblob', 'true'));
480  StmtHandle := 0;
481 
482  Prepare;
483 end;
484 
485 destructor TZInterbase6PreparedStatement.Destroy;
486 begin
487  inherited Destroy;
488  FreeStatement(FIBConnection.GetPlainDriver, StmtHandle, DSQL_drop);
489 end;
490 
491 procedure TZInterbase6PreparedStatement.Prepare;
492 begin
493  with FIBConnection do
494  begin
495  StatementType := ZDbcInterbase6Utils.PrepareStatement(GetPlainDriver,
496  GetDBHandle, GetTrHandle, GetDialect, ASQL, LogSQL, StmtHandle); //allocate handle if required or reuse it
497 
498  if StatementType in [stSelect, stExecProc] then
499  begin
500  SQLData := TZResultSQLDA.Create(GetPlainDriver, GetDBHandle,
501  GetTrHandle , ConSettings);
502  PrepareResultSqlData(GetPlainDriver, GetDBHandle, GetDialect,
503  SQL, StmtHandle, SQLData);
504  end;
505  end;
506  CheckInterbase6Error(SQL);
507  LogPrepStmtMessage(lcPrepStmt, SQL);
508  inherited Prepare;
509 end;
510 
511 procedure TZInterbase6PreparedStatement.Unprepare;
512 begin
513  if StmtHandle <> 0 then //check if prepare did fail. otherwise we unprepare the handle
514  FreeStatement(FIBConnection.GetPlainDriver, StmtHandle, DSQL_UNPREPARE); //unprepare avoids new allocation for the stmt handle
515  inherited Unprepare;
516 end;
517 
518 {**
519  Executes any kind of SQL statement.
520  Some prepared statements return multiple results; the <code>execute</code>
521  method handles these complex statements as well as the simpler
522  form of statements handled by the methods <code>executeQuery</code>
523  and <code>executeUpdate</code>.
524  @see Statement#execute
525 }
526 {$HINTS OFF}
527 function TZInterbase6PreparedStatement.ExecutePrepared: Boolean;
528 begin
529  Result := False;
530  if not Prepared then
531  Prepare;
532 
533  with FIBConnection do
534  begin
535  try
536  BindInParameters;
537 
538  if (StatementType = stSelect) then //AVZ Get many rows - only need to use execute not execute2
539  GetPlainDriver.isc_dsql_execute(@FStatusVector, GetTrHandle, @StmtHandle,
540  GetDialect, FParamSQLData.GetData)
541  else
542  begin
543  CursorName := 'ExecProc'+RandomString(12); //AVZ - Need a way to return one row so we give the cursor a name
544  if (SQLData = nil) then
545  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @StmtHandle,
546  GetDialect, FParamSQLData.GetData, nil) //not expecting a result
547  else
548  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @StmtHandle,
549  GetDialect, FParamSQLData.GetData, SQLData.GetData); //expecting a result
550  end;
551 
552  CheckInterbase6Error(SQL);
553 
554  LastUpdateCount := GetAffectedRows(GetPlainDriver, StmtHandle, StatementType);
555 
556  case StatementType of
557  stInsert,
558  stDelete,
559  stUpdate,
560  stSelectForUpdate:
561  Result := False;
562  else
563  Result := True;
564  end;
565 
566  { Create ResultSet if possible else free Statement Handle }
567  if (StatementType in [stSelect, stExecProc])
568  and (SQLData.GetFieldCount <> 0) then
569  begin
570  LastResultSet := CreateIBResultSet(SQL, Self,
571  TZInterbase6ResultSet.Create(Self, SQL, StmtHandle, Cursor,
572  SQLData, FCachedBlob));
573  end
574  else
575  begin
576  LastResultSet := nil;
577  end;
578 
579  { Autocommit statement. }
580  if Connection.GetAutoCommit then
581  Connection.Commit;
582  except
583  on E: Exception do
584  begin
585  {EH: do not Close the Stmt if execution fails !!}
586  //FreeStatement(GetPlainDriver, StmtHandle, DSQL_CLOSE); //AVZ
587  raise;
588  end;
589  end;
590  end;
591  inherited ExecutePrepared;
592 end;
593 {$HINTS ON}
594 
595 {**
596  Executes the SQL query in this <code>PreparedStatement</code> object
597  and returns the result set generated by the query.
598 
599  @return a <code>ResultSet</code> object that contains the data produced by the
600  query; never <code>null</code>
601 }
602 {$HINTS OFF}
603 function TZInterbase6PreparedStatement.ExecuteQueryPrepared: IZResultSet;
604 var
605  iError : Integer; //Check for database disconnect AVZ
606 begin
607  if not Prepared then
608  Prepare;
609 
610  with FIBConnection do
611  begin
612  try
613  BindInParameters;
614 
615  if (StatementType = stSelect) then //AVZ Get many rows - only need to use execute not execute2
616  GetPlainDriver.isc_dsql_execute(@FStatusVector, GetTrHandle, @StmtHandle,
617  GetDialect, FParamSQLData.GetData)
618  else
619  begin
620  CursorName := 'ExecProc'+RandomString(12); //AVZ - Need a way to return one row so we give the cursor a name
621  if (SQLData = nil) then
622  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @StmtHandle,
623  GetDialect, FParamSQLData.GetData, nil) //not expecting a result
624  else
625  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @StmtHandle,
626  GetDialect, FParamSQLData.GetData, SQLData.GetData); //expecting a result
627  end;
628 
629  iError := CheckInterbase6Error(SQL);
630 
631  if (StatementType in [stSelect, stExecProc]) and (SQLData.GetFieldCount <> 0) then
632  begin
633  if CursorName <> '' then
634  begin
635  Cursor := CursorName;
636  GetPlainDriver.isc_dsql_set_cursor_name(@FStatusVector,
637  @StmtHandle, PAnsiChar(Cursor), 0);
638  iError := CheckInterbase6Error(SQL);
639  end;
640 
641  if (iError <> DISCONNECT_ERROR) then
642  Result := CreateIBResultSet(LogSQL, Self, TZInterbase6ResultSet.Create(Self, LogSQL, StmtHandle, Cursor, SQLData, FCachedBlob));
643  end
644  else
645  if (iError <> DISCONNECT_ERROR) then //AVZ
646  raise EZSQLException.Create(SCanNotRetrieveResultSetData)
647  else
648  Result := nil;
649  except
650  on E: Exception do
651  begin
652  //The cursor will be already closed for exec2
653  if (Pos('ExecProc', String(CursorName)) <> 0) then
654  StmtHandle := 0;
655 
656  {EH: do not Close the Stmt if execution fails !! This will be done on unprepare}
657  //FreeStatement(GetPlainDriver, StmtHandle, DSQL_CLOSE); //AVZ
658  raise;
659  end;
660  end;
661  end;
662  inherited ExecuteQueryPrepared;
663 end;
664 {$HINTS ON}
665 
666 {**
667  Executes the SQL INSERT, UPDATE or DELETE statement
668  in this <code>PreparedStatement</code> object.
669  In addition,
670  SQL statements that return nothing, such as SQL DDL statements,
671  can be executed.
672 
673  @return either the row count for INSERT, UPDATE or DELETE statements;
674  or 0 for SQL statements that return nothing
675 }
676 {$HINTS OFF}
677 function TZInterbase6PreparedStatement.ExecuteUpdatePrepared: Integer;
678 var
679  iError : Integer; //Implementation for graceful disconnect AVZ
680 begin
681  Result := -1;
682 
683  if not Prepared then
684  Prepare;
685 
686  with FIBConnection do
687  begin
688  BindInParameters;
689 
690  GetPlainDriver.isc_dsql_execute(@FStatusVector, GetTrHandle,
691  @StmtHandle, GetDialect, FParamSQLData.GetData);
692  iError := CheckInterbase6Error(SQL);
693 
694  Result := GetAffectedRows(GetPlainDriver, StmtHandle, StatementType);
695  LastUpdateCount := Result;
696 
697  case StatementType of
698  stCommit, stRollback, stUnknown: Result := -1;
699  stSelect: FreeStatement(GetPlainDriver, StmtHandle, DSQL_CLOSE); //AVZ
700  end;
701 
702  { Autocommit statement. }
703  if Connection.GetAutoCommit and ( StatementType <> stSelect ) then
704  Connection.Commit;
705  end;
706  inherited ExecuteUpdatePrepared;
707 
708  //Trail for the disconnection of the database gracefully - AVZ
709  if (iError = DISCONNECT_ERROR) then
710  begin
711  Result := DISCONNECT_ERROR;
712  end;
713 
714 end;
715 {$HINTS ON}
716 
717 
718 { TZInterbase6CallableStatement }
719 
720 {**
721  Check interbase error status
722  @param Sql the used sql tring
723 }
724 procedure TZInterbase6CallableStatement.CheckInterbase6Error(const Sql: string);
725 begin
726  ZDbcInterbase6Utils.CheckInterbase6Error(FIBConnection.GetPlainDriver,
727  FStatusVector, lcExecute, SQL);
728 end;
729 
730 {**
731  Constructs this object and assignes the main properties.
732  @param Connection a database connection object.
733  @param Handle a connection handle pointer.
734  @param Dialect a dialect Interbase SQL must be 1 or 2 or 3.
735  @param Info a statement parameters.
736 }
737 constructor TZInterbase6CallableStatement.Create(Connection: IZConnection;
738  const SQL: string; Info: TStrings);
739 begin
740  inherited Create(Connection, SQL, Info);
741 
742  FIBConnection := Connection as IZInterbase6Connection;
743  ResultSetType := rtScrollInsensitive;
744  FCachedBlob := StrToBoolEx(DefineStatementParameter(Self, 'cashedblob', 'true'));
745  with FIBConnection do
746  begin
747  FParamSQLData := TZParamsSQLDA.Create(GetPlainDriver, GetDBHandle,
748  GetTrHandle, ConSettings);
749  FResultSQLData := TZResultSQLDA.Create(GetPlainDriver, GetDBHandle,
750  GetTrHandle, ConSettings);
751  end;
752 end;
753 
754 procedure TZInterbase6CallableStatement.PrepareInParameters;
755 begin
756  with FIBConnection do
757  begin
758  { Prepare statement }
759  FStatementType := ZDbcInterbase6Utils.PrepareStatement(GetPlainDriver,
760  GetDBHandle, GetTrHandle, GetDialect, ZPlainString(ProcSql), ProcSQL, FStmtHandle);
761  PrepareResultSqlData(GetPlainDriver, GetDBHandle, GetDialect,
762  SQL, FStmtHandle, FResultSQLData);
763  PrepareParameters(GetPlainDriver, ProcSql, GetDialect, FStmtHandle, FParamSQLData);
764  end;
765 end;
766 
767 procedure TZInterbase6CallableStatement.BindInParameters;
768 begin
769  BindSQLDAInParameters(FIBConnection.GetPlainDriver, InParamValues,
770  InParamTypes, InParamCount, FParamSQLData, ConSettings);
771  inherited BindInParameters;
772 end;
773 
774 procedure TZInterbase6CallableStatement.UnPrepareInParameters;
775 begin
776  if assigned(FParamSQLData) then
777  FParamSQLData.FreeParamtersValues;
778 end;
779 
780 procedure TZInterbase6CallableStatement.Unprepare;
781 begin
782  inherited Unprepare;
783  FreeStatement(FIBConnection.GetPlainDriver, FStmtHandle, DSQL_unprepare);
784  if FStmtHandle <> 0 then // Free statement-hande! On the other hand: Exception!
785  begin
786  FreeStatement(FIBConnection.GetPlainDriver, FStmtHandle, DSQL_drop);
787  FStmtHandle := 0;
788  end;
789 end;
790 
791 destructor TZInterbase6CallableStatement.Destroy;
792 begin
793  inherited Destroy;
794  if FStmtHandle <> 0 then
795  FreeStatement(FIBConnection.GetPlainDriver, FStmtHandle, DSQL_drop);
796  FResultSQLData := nil;
797  FParamSQLData := nil;
798 end;
799 
800 {**
801  Executes any kind of SQL statement.
802  Some prepared statements return multiple results; the <code>execute</code>
803  method handles these complex statements as well as the simpler
804  form of statements handled by the methods <code>executeQuery</code>
805  and <code>executeUpdate</code>.
806  @see Statement#execute
807 }
808 {$HINTS OFF}
809 function TZInterbase6CallableStatement.ExecutePrepared: Boolean;
810 var
811  Cursor: AnsiString;
812 begin
813  Result := False;
814  with FIBConnection do
815  begin
816  ProcSql := GetProcedureSql(False);
817  BindInParameters;
818  DriverManager.LogMessage(lcExecute, GetPlainDriver.GetProtocol, SQL);
819  try
820  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @FStmtHandle,
821  GetDialect, FParamSQLData.GetData, Self.FResultSQLData.GetData);
822  CheckInterbase6Error(SQL);
823 
824  LastUpdateCount := GetAffectedRows(GetPlainDriver, FStmtHandle, FStatementType);
825 
826  case FStatementType of
827  stInsert, stDelete, stUpdate, stSelectForUpdate: Result := False;
828  else
829  Result := True;
830  end;
831 
832  { Create ResultSet if possible else free Stateent Handle, ResultSQlData and
833  ParamSqlData }
834  if (FStatementType in [stSelect, stExecProc])
835  and (FResultSQLData.GetFieldCount <> 0) then
836  begin
837  Cursor := RandomString(12);
838  LastResultSet := CreateIBResultSet(SQL, Self,
839  TZInterbase6ResultSet.Create(Self, SQL, FStmtHandle, Cursor, FResultSQLData, FCachedBlob));
840  end
841  else
842  begin
843  { Fetch data and fill Output params }
844  FetchOutParams(FResultSQLData);
845  FreeStatement(GetPlainDriver, FStmtHandle, DSQL_CLOSE); //AVZ
846  LastResultSet := nil;
847  end;
848 
849  { Autocommit statement. }
850  if Connection.GetAutoCommit then
851  Connection.Commit;
852 
853  except
854  on E: Exception do
855  begin
856  //FreeStatement(GetPlainDriver, FStmtHandle, DSQL_CLOSE); //AVZ
857  raise;
858  end;
859  end;
860  end;
861 end;
862 {$HINTS ON}
863 
864 {**
865  Executes the SQL query in this <code>PreparedStatement</code> object
866  and returns the result set generated by the query.
867 
868  @return a <code>ResultSet</code> object that contains the data produced by the
869  query; never <code>null</code>
870 }
871 {$HINTS OFF}
872 function TZInterbase6CallableStatement.ExecuteQueryPrepared: IZResultSet;
873 var
874  Cursor: AnsiString;
875 begin
876  with FIBConnection do
877  begin
878  ProcSql := GetProcedureSql(True); //Prepares the Statement
879  BindInParameters;
880  try
881  DriverManager.LogMessage(lcExecute, GetPlainDriver.GetProtocol, ProcSql);
882 
883  if (FStatementType = stSelect) then //AVZ Get many rows - only need to use execute not execute2
884  GetPlainDriver.isc_dsql_execute(@FStatusVector, GetTrHandle, @FStmtHandle,
885  GetDialect, FParamSQLData.GetData)
886  else
887  begin
888  CursorName := 'ExecProc'+RandomString(12); //AVZ - Need a way to return one row so we give the cursor a name
889  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @FStmtHandle,
890  GetDialect, FParamSQLData.GetData, FResultSQLData.GetData);
891  end;
892 
893  CheckInterbase6Error(ProcSql);
894 
895  if (FStatementType in [stSelect, stExecProc]) and (FResultSQLData.GetFieldCount <> 0) then
896  begin
897  if CursorName <> '' then
898  begin
899  Cursor := CursorName;
900  GetPlainDriver.isc_dsql_set_cursor_name(@FStatusVector, @FStmtHandle, PAnsiChar(Cursor), 0);
901  CheckInterbase6Error(ProcSql);
902  end;
903 
904  Result := CreateIBResultSet(ProcSql, Self,
905  TZInterbase6ResultSet.Create(Self, ProcSql, FStmtHandle, Cursor,
906  FResultSQLData, FCachedBlob));
907  end;
908 
909  except
910  on E: Exception do
911  begin
912  //FreeStatement(GetPlainDriver, FStmtHandle, DSQL_unprepare); //AVZ
913  raise;
914  end;
915  end;
916  end;
917 end;
918 {$HINTS ON}
919 
920 {**
921  Executes the SQL INSERT, UPDATE or DELETE statement
922  in this <code>PreparedStatement</code> object.
923  In addition,
924  SQL statements that return nothing, such as SQL DDL statements,
925  can be executed.
926 
927  @return either the row count for INSERT, UPDATE or DELETE statements;
928  or 0 for SQL statements that return nothing
929 }
930 function TZInterbase6CallableStatement.ExecuteUpdatePrepared: Integer;
931 begin
932  with FIBConnection do
933  begin
934  try
935  ProcSQL := Self.GetProcedureSql(False);
936  BindInParameters;
937 
938  DriverManager.LogMessage(lcExecute, GetPlainDriver.GetProtocol, ProcSQL);
939 
940  GetPlainDriver.isc_dsql_execute2(@FStatusVector, GetTrHandle, @FStmtHandle,
941  GetDialect, FParamSQLData.GetData, FResultSQLData.GetData);
942  CheckInterbase6Error(ProcSql);
943 
944  Result := GetAffectedRows(GetPlainDriver, FStmtHandle, FStatementType);
945  LastUpdateCount := Result;
946  { Fetch data and fill Output params }
947  FetchOutParams(FResultSQLData);
948  { Autocommit statement. }
949  if Connection.GetAutoCommit then
950  Connection.Commit;
951 
952  finally
953  //FreeStatement(GetPlainDriver, FStmtHandle, DSQL_unprepare); //AVZ -- unprepare the statement - not close it
954 
955  end;
956  end;
957 end;
958 
959 {**
960  Set output parameters values from TZResultSQLDA.
961  @param Value a TZResultSQLDA object.
962 }
963 procedure TZInterbase6CallableStatement.FetchOutParams(
964  Value: IZResultSQLDA);
965 var
966  ParamIndex, I: Integer;
967  Temp: TZVariant;
968 begin
969  I := 0;
970  for ParamIndex := 0 to OutParamCount - 1 do
971  begin
972  if not (FDBParamTypes[ParamIndex] in [2, 3, 4]) then // ptOutput, ptInputOutput, ptResult
973  Continue;
974 
975  if I >= Value.GetFieldCount then
976  Break;
977 
978  if Value.IsNull(I) then
979  DefVarManager.SetNull(Temp)
980  else
981  case Value.GetFieldSqlType(I) of
982  stBoolean:
983  DefVarManager.SetAsBoolean(Temp, Value.GetBoolean(I));
984  stByte:
985  DefVarManager.SetAsInteger(Temp, Value.GetByte(I));
986  stBytes:
987  DefVarManager.SetAsBytes(Temp, Value.GetBytes(I));
988  stShort:
989  DefVarManager.SetAsInteger(Temp, Value.GetShort(I));
990  stInteger:
991  DefVarManager.SetAsInteger(Temp, Value.GetInt(I));
992  stLong:
993  DefVarManager.SetAsInteger(Temp, Value.GetLong(I));
994  stFloat:
995  DefVarManager.SetAsFloat(Temp, Value.GetFloat(I));
996  stDouble:
997  DefVarManager.SetAsFloat(Temp, Value.GetDouble(I));
998  stBigDecimal:
999  DefVarManager.SetAsFloat(Temp, Value.GetBigDecimal(I));
1000  stString:
1001  DefVarManager.SetAsString(Temp, ZDbcString(Value.GetString(I)));
1002  stUnicodeString:
1003  DefVarManager.SetAsUnicodeString(Temp, ZDbcUnicodeString(Value.GetString(I)));
1004  stDate:
1005  DefVarManager.SetAsDateTime(Temp, Value.GetDate(I));
1006  stTime:
1007  DefVarManager.SetAsDateTime(Temp, Value.GetTime(I));
1008  stTimestamp:
1009  DefVarManager.SetAsDateTime(Temp, Value.GetTimestamp(I));
1010  end;
1011  OutParamValues[ParamIndex] := Temp;
1012  Inc(I);
1013  end;
1014 end;
1015 
1016 {**
1017  Create sql string for calling stored procedure.
1018  @param SelectProc indicate use <b>EXECUTE PROCEDURE</b> or
1019  <b>SELECT</b> staement
1020  @return a Stored Procedure SQL string
1021 }
1022 function TZInterbase6CallableStatement.GetProcedureSql(SelectProc: boolean): string;
1023 
1024  function GenerateParamsStr(Count: integer): string;
1025  var
1026  I: integer;
1027  begin
1028  Result := ''; //init Result -> FPC
1029  for I := 0 to Count - 1 do
1030  begin
1031  if I > 0 then
1032  Result := Result + ',';
1033  Result := Result + '?';
1034  end;
1035  end;
1036 
1037 var
1038  InParams: string;
1039 begin
1040  TrimInParameters;
1041  InParams := GenerateParamsStr(High(InParamValues) + 1);
1042  if InParams <> '' then
1043  InParams := '(' + InParams + ')';
1044 
1045  if SelectProc then
1046  Result := 'SELECT * FROM ' + SQL + InParams
1047  else
1048  Result := 'EXECUTE PROCEDURE ' + SQL + InParams;
1049 end;
1050 
1051 end.