zeoslib  UNKNOWN
 All Files
ZDbcInterbase6Utils.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 ZDbcInterbase6Utils;
53 
54 interface
55 
56 {$I ZDbc.inc}
57 
58 uses
59  SysUtils, Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} Types,
60  ZDbcIntfs, ZDbcStatement, ZPlainFirebirdDriver, ZCompatibility,
61  ZPlainFirebirdInterbaseConstants, ZDbcCachedResultSet, ZDbcLogging, ZMessages,
62  ZVariant, ZTokenizer;
63 
64 type
65  { Interbase Statement Type }
66  TZIbSqlStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
67  stDDL, stGetSegment, stPutSegment, stExecProc, stStartTrans, stCommit,
68  stRollback, stSelectForUpdate, stSetGenerator, stDisconnect);
69 
70  { Interbase Error Class}
71  EZIBConvertError = class(Exception);
72 
73  { Paparameter string name and it value}
74  TZIbParam = record
75  Name: AnsiString;
76  Number: word;
77  end;
78  PZIbParam = ^TZIbParam;
79 
80  { Interbase blob Information structure
81  contain iformation about blob size in bytes,
82  segments count, segment size in bytes and blob type
83  Note: blob type can be text an binary }
84  TIbBlobInfo = record
85  NumSegments: Word;
86  MaxSegmentSize: Word;
87  BlobType: SmallInt;
88  TotalSize: LongInt;
89  end;
90 
91  { Base interface for sqlda }
92  IZSQLDA = interface
93  ['{2D0D6029-B31C-4E39-89DC-D86D20437C35}']
94  procedure InitFields(Parameters: boolean);
95  procedure AllocateSQLDA;
96  procedure FreeParamtersValues;
97 
98  function GetData: PXSQLDA;
99  function IsBlob(const Index: Word): boolean;
100  function IsNullable(const Index: Word): boolean;
101 
102  function GetFieldCount: Integer;
103  function GetFieldSqlName(const Index: Word): String;
104  function GetFieldRelationName(const Index: Word): String;
105  function GetFieldOwnerName(const Index: Word): String;
106  function GetFieldAliasName(const Index: Word): String;
107  function GetFieldIndex(const Name: AnsiString): Word;
108  function GetFieldScale(const Index: Word): integer;
109  function GetFieldSqlType(const Index: Word): TZSQLType;
110  function GetFieldLength(const Index: Word): SmallInt;
111  function GetIbSqlType(const Index: Word): Smallint;
112  function GetIbSqlSubType(const Index: Word): Smallint;
113  function GetIbSqlLen(const Index: Word): Smallint;
114  end;
115 
116  { parameters interface sqlda}
117  IZParamsSQLDA = interface(IZSQLDA)
118  ['{D2C3D5E1-F3A6-4223-9A6E-3048B99A06C4}']
119  procedure WriteBlob(const Index: Integer; Stream: TStream);
120  procedure UpdateNull(const Index: Integer; Value: boolean);
121  procedure UpdateBoolean(const Index: Integer; Value: boolean);
122  procedure UpdateByte(const Index: Integer; Value: ShortInt);
123  procedure UpdateShort(const Index: Integer; Value: SmallInt);
124  procedure UpdateInt(const Index: Integer; Value: Integer);
125  procedure UpdateLong(const Index: Integer; Value: Int64);
126  procedure UpdateFloat(const Index: Integer; Value: Single);
127  procedure UpdateDouble(const Index: Integer; Value: Double);
128  procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
129  procedure UpdatePChar(const Index: Integer; Value: PAnsiChar);
130  procedure UpdateString(const Index: Integer; Value: RawByteString);
131  procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
132  procedure UpdateDate(const Index: Integer; Value: TDateTime);
133  procedure UpdateTime(const Index: Integer; Value: TDateTime);
134  procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
135  procedure UpdateQuad(const Index: Word; const Value: TISC_QUAD);
136  end;
137 
138  { Result interface for sqlda}
139  IZResultSQLDA = interface(IZSQLDA)
140  ['{D2C3D5E1-F3A6-4223-9A6E-3048B99A06C4}']
141  procedure ReadBlobFromStream(const Index: Word; Stream: TStream);
142  procedure ReadBlobFromString(const Index: Word; var str: AnsiString);
143  procedure ReadBlobFromVariant(const Index: Word; var Value: Variant);
144 
145  function IsNull(const Index: Integer): Boolean;
146  function GetPChar(const Index: Integer): PChar;
147  function GetString(const Index: Integer): RawByteString;
148  function GetBoolean(const Index: Integer): Boolean;
149  function GetByte(const Index: Integer): Byte;
150  function GetShort(const Index: Integer): SmallInt;
151  function GetInt(const Index: Integer): Integer;
152  function GetLong(const Index: Integer): Int64;
153  function GetFloat(const Index: Integer): Single;
154  function GetDouble(const Index: Integer): Double;
155  function GetBigDecimal(const Index: Integer): Extended;
156  function GetBytes(const Index: Integer): TByteDynArray;
157  function GetDate(const Index: Integer): TDateTime;
158  function GetTime(const Index: Integer): TDateTime;
159  function GetTimestamp(const Index: Integer): TDateTime;
160  function GetValue(const Index: Word): Variant;
161  function GetQuad(const Index: Integer): TISC_QUAD;
162  end;
163 
164  { Base class contain core functions to work with sqlda structure
165  Can allocate memory for sqlda structure get basic information }
166  TZSQLDA = class (TZCodePagedObject, IZSQLDA)
167  private
168  FHandle: PISC_DB_HANDLE;
169  FTransactionHandle: PISC_TR_HANDLE;
170  FXSQLDA: PXSQLDA;
171  FPlainDriver: IZInterbasePlainDriver;
172  Temp: AnsiString;
173  procedure CheckRange(const Index: Word);
174  procedure IbReAlloc(var P; OldSize, NewSize: Integer);
175  procedure SetFieldType(const Index: Word; Size: Integer; Code: Smallint;
176  Scale: Smallint);
177  public
178  constructor Create(PlainDriver: IZInterbasePlainDriver;
179  Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE;
180  ConSettings: PZConSettings); virtual;
181  procedure InitFields(Parameters: boolean);
182  procedure AllocateSQLDA; virtual;
183  procedure FreeParamtersValues;
184 
185  function IsBlob(const Index: Word): boolean;
186  function IsNullable(const Index: Word): boolean;
187 
188  function GetFieldCount: Integer;
189  function GetFieldSqlName(const Index: Word): String;
190  function GetFieldOwnerName(const Index: Word): String;
191  function GetFieldRelationName(const Index: Word): String;
192  function GetFieldAliasName(const Index: Word): String;
193  function GetFieldIndex(const Name: AnsiString): Word;
194  function GetFieldScale(const Index: Word): integer;
195  function GetFieldSqlType(const Index: Word): TZSQLType;
196  function GetFieldLength(const Index: Word): SmallInt;
197  function GetData: PXSQLDA;
198 
199  function GetIbSqlType(const Index: Word): Smallint;
200  function GetIbSqlSubType(const Index: Word): Smallint;
201  function GetIbSqlLen(const Index: Word): Smallint;
202  end;
203 
204  { Parameters class for sqlda structure.
205  It clas can only write data to parameters/fields }
206  TZParamsSQLDA = class (TZSQLDA, IZParamsSQLDA)
207  private
208  procedure EncodeString(Code: Smallint; const Index: Word; const Str: RawByteString);
209  procedure EncodeBytes(Code: Smallint; const Index: Word; const Value: TByteDynArray);
210  procedure UpdateDateTime(const Index: Integer; Value: TDateTime);
211  public
212  destructor Destroy; override;
213 
214  procedure WriteBlob(const Index: Integer; Stream: TStream);
215 
216  procedure UpdateNull(const Index: Integer; Value: boolean);
217  procedure UpdateBoolean(const Index: Integer; Value: boolean);
218  procedure UpdateByte(const Index: Integer; Value: ShortInt);
219  procedure UpdateShort(const Index: Integer; Value: SmallInt);
220  procedure UpdateInt(const Index: Integer; Value: Integer);
221  procedure UpdateLong(const Index: Integer; Value: Int64);
222  procedure UpdateFloat(const Index: Integer; Value: Single);
223  procedure UpdateDouble(const Index: Integer; Value: Double);
224  procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
225  procedure UpdatePChar(const Index: Integer; Value: PAnsiChar);
226  procedure UpdateString(const Index: Integer; Value: RawByteString);
227  procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
228  procedure UpdateDate(const Index: Integer; Value: TDateTime);
229  procedure UpdateTime(const Index: Integer; Value: TDateTime);
230  procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
231  procedure UpdateQuad(const Index: Word; const Value: TISC_QUAD);
232  end;
233 
234  { Resultset class for sqlda structure.
235  It class read data from sqlda fields }
236  TZResultSQLDA = class (TZSQLDA, IZResultSQLDA)
237  private
238  function DecodeString(const Code: Smallint; const Index: Word): RawByteString;
239  procedure DecodeString2(const Code: Smallint; const Index: Word; out Str: RawByteString);
240  protected
241  FDefaults: array of Variant;
242  public
243  destructor Destroy; override;
244 
245  procedure AllocateSQLDA; override;
246 
247  procedure ReadBlobFromStream(const Index: Word; Stream: TStream);
248  procedure ReadBlobFromString(const Index: Word; var str: AnsiString);
249  procedure ReadBlobFromVariant(const Index: Word; var Value: Variant);
250 
251  function IsNull(const Index: Integer): Boolean;
252  function GetPChar(const Index: Integer): PChar;
253  function GetString(const Index: Integer): RawByteString;
254  function GetBoolean(const Index: Integer): Boolean;
255  function GetByte(const Index: Integer): Byte;
256  function GetShort(const Index: Integer): SmallInt;
257  function GetInt(const Index: Integer): Integer;
258  function GetLong(const Index: Integer): Int64;
259  function GetFloat(const Index: Integer): Single;
260  function GetDouble(const Index: Integer): Double;
261  function GetBigDecimal(const Index: Integer): Extended;
262  function GetBytes(const Index: Integer): TByteDynArray;
263  function GetDate(const Index: Integer): TDateTime;
264  function GetTime(const Index: Integer): TDateTime;
265  function GetTimestamp(const Index: Integer): TDateTime;
266  function GetValue(const Index: Word): Variant;
267  function GetQuad(const Index: Integer): TISC_QUAD;
268  end;
269 
270  function RandomString(Len: integer): AnsiString;
271  function CreateIBResultSet(SQL: string; Statement: IZStatement;
272  NativeResultSet: IZResultSet): IZResultSet;
273 
274  {Interbase6 Connection Functions}
275  function GenerateDPB(Info: TStrings; var FDPBLength, Dialect: Word): PAnsiChar;
276  function GenerateTPB(Params: TStrings; var Handle: TISC_DB_HANDLE): PISC_TEB;
277  function GetInterbase6DatabaseParamNumber(const Value: AnsiString): word;
278  function GetInterbase6TransactionParamNumber(const Value: AnsiString): word;
279 
280  { Interbase6 errors functions }
281  function GetNameSqlType(Value: Word): AnsiString;
282  function CheckInterbase6Error(PlainDriver: IZInterbasePlainDriver;
283  StatusVector: TARRAY_ISC_STATUS; LoggingCategory: TZLoggingCategory = lcOther;
284  SQL: string = '') : Integer;
285 
286  { Interbase information functions}
287  function GetVersion(PlainDriver: IZInterbasePlainDriver;
288  Handle: PISC_DB_HANDLE): AnsiString;
289  function GetDBImplementationNo(PlainDriver: IZInterbasePlainDriver;
290  Handle: PISC_DB_HANDLE): LongInt;
291  function GetDBImplementationClass(PlainDriver: IZInterbasePlainDriver;
292  Handle: PISC_DB_HANDLE): LongInt;
293  function GetLongDbInfo(PlainDriver: IZInterbasePlainDriver;
294  Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): LongInt;
295  function GetStringDbInfo(PlainDriver: IZInterbasePlainDriver;
296  Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): AnsiString;
297  function GetDBSQLDialect(PlainDriver: IZInterbasePlainDriver;
298  Handle: PISC_DB_HANDLE): Integer;
299 
300  { Interbase statement functions}
301  function PrepareStatement(PlainDriver: IZInterbasePlainDriver;
302  Handle: PISC_DB_HANDLE; TrHandle: PISC_TR_HANDLE; Dialect: Word;
303  SQL: RawByteString; LogSQL: String;
304  var StmtHandle: TISC_STMT_HANDLE): TZIbSqlStatementType;
305  procedure PrepareResultSqlData(PlainDriver: IZInterbasePlainDriver;
306  Handle: PISC_DB_HANDLE; Dialect: Word; LogSQL: string;
307  var StmtHandle: TISC_STMT_HANDLE; SqlData: IZResultSQLDA);
308  procedure PrepareParameters(PlainDriver: IZInterbasePlainDriver; LogSQL: string;
309  Dialect: Word; var StmtHandle: TISC_STMT_HANDLE; ParamSqlData: IZParamsSQLDA);
310  procedure BindSQLDAInParameters(PlainDriver: IZInterbasePlainDriver;
311  InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray;
312  InParamCount: Integer; ParamSqlData: IZParamsSQLDA; ConSettings: PZConSettings);
313  procedure FreeStatement(PlainDriver: IZInterbasePlainDriver;
314  StatementHandle: TISC_STMT_HANDLE; Options : Word);
315  function GetStatementType(PlainDriver: IZInterbasePlainDriver;
316  StmtHandle: TISC_STMT_HANDLE): TZIbSqlStatementType;
317  function GetAffectedRows(PlainDriver: IZInterbasePlainDriver;
318  StmtHandle: TISC_STMT_HANDLE; StatementType: TZIbSqlStatementType): integer;
319 
320  function ConvertInterbase6ToSqlType(SqlType, SqlSubType: Integer;
321  const CtrlsCPType: TZControlsCodePage): TZSqlType;
322 
323  { interbase blob routines }
324  procedure GetBlobInfo(PlainDriver: IZInterbasePlainDriver;
325  BlobHandle: TISC_BLOB_HANDLE; var BlobInfo: TIbBlobInfo);
326  procedure ReadBlobBufer(PlainDriver: IZInterbasePlainDriver;
327  Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE;
328  BlobId: TISC_QUAD; var Size: Integer; var Buffer: Pointer);
329  function GetIBScaleDivisor(Scale: SmallInt): Int64;
330 
331 
332 const
333  { Default Interbase blob size for readig }
334  DefaultBlobSegmentSize = 16 * 1024;
335 
336  IBScaleDivisor: array[-15..-1] of Int64 = (1000000000000000,100000000000000,
337  10000000000000,1000000000000,100000000000,10000000000,1000000000,100000000,
338  10000000,1000000,100000,10000,1000,100,10);
339 
340  { count database parameters }
341  MAX_DPB_PARAMS = 67;
342  { prefix database parameters names it used in paramters scann procedure }
343  BPBPrefix = 'isc_dpb_';
344  { list database parameters and their apropriate numbers }
345  DatabaseParams: array [0..MAX_DPB_PARAMS]of TZIbParam = (
346  (Name:'isc_dpb_version1'; Number: isc_dpb_version1),
347  (Name:'isc_dpb_cdd_pathname'; Number: isc_dpb_cdd_pathname),
348  (Name:'isc_dpb_allocation'; Number: isc_dpb_allocation),
349  (Name:'isc_dpb_journal'; Number: isc_dpb_journal),
350  (Name:'isc_dpb_page_size'; Number: isc_dpb_page_size),
351  (Name:'isc_dpb_num_buffers'; Number: isc_dpb_num_buffers),
352  (Name:'isc_dpb_buffer_length'; Number: isc_dpb_buffer_length),
353  (Name:'isc_dpb_debug'; Number: isc_dpb_debug),
354  (Name:'isc_dpb_garbage_collect'; Number: isc_dpb_garbage_collect),
355  (Name:'isc_dpb_verify'; Number: isc_dpb_verify),
356  (Name:'isc_dpb_sweep'; Number: isc_dpb_sweep),
357  (Name:'isc_dpb_enable_journal'; Number: isc_dpb_enable_journal),
358  (Name:'isc_dpb_disable_journal'; Number: isc_dpb_disable_journal),
359  (Name:'isc_dpb_dbkey_scope'; Number: isc_dpb_dbkey_scope),
360  (Name:'isc_dpb_number_of_users'; Number: isc_dpb_number_of_users),
361  (Name:'isc_dpb_trace'; Number: isc_dpb_trace),
362  (Name:'isc_dpb_no_garbage_collect'; Number: isc_dpb_no_garbage_collect),
363  (Name:'isc_dpb_damaged'; Number: isc_dpb_damaged),
364  (Name:'isc_dpb_license'; Number: isc_dpb_license),
365  (Name:'isc_dpb_sys_user_name'; Number: isc_dpb_sys_user_name),
366  (Name:'isc_dpb_encrypt_key'; Number: isc_dpb_encrypt_key),
367  (Name:'isc_dpb_activate_shadow'; Number: isc_dpb_activate_shadow),
368  (Name:'isc_dpb_sweep_interval'; Number: isc_dpb_sweep_interval),
369  (Name:'isc_dpb_delete_shadow'; Number: isc_dpb_delete_shadow),
370  (Name:'isc_dpb_force_write'; Number: isc_dpb_force_write),
371  (Name:'isc_dpb_begin_log'; Number: isc_dpb_begin_log),
372  (Name:'isc_dpb_quit_log'; Number: isc_dpb_quit_log),
373  (Name:'isc_dpb_no_reserve'; Number: isc_dpb_no_reserve),
374  (Name:'isc_dpb_username'; Number: isc_dpb_user_name),
375  (Name:'isc_dpb_password'; Number: isc_dpb_password),
376  (Name:'isc_dpb_password_enc'; Number: isc_dpb_password_enc),
377  (Name:'isc_dpb_sys_user_name_enc'; Number: isc_dpb_sys_user_name_enc),
378  (Name:'isc_dpb_interp'; Number: isc_dpb_interp),
379  (Name:'isc_dpb_online_dump'; Number: isc_dpb_online_dump),
380  (Name:'isc_dpb_old_file_size'; Number: isc_dpb_old_file_size),
381  (Name:'isc_dpb_old_num_files'; Number: isc_dpb_old_num_files),
382  (Name:'isc_dpb_old_file'; Number: isc_dpb_old_file),
383  (Name:'isc_dpb_old_start_page'; Number: isc_dpb_old_start_page),
384  (Name:'isc_dpb_old_start_seqno'; Number: isc_dpb_old_start_seqno),
385  (Name:'isc_dpb_old_start_file'; Number: isc_dpb_old_start_file),
386  (Name:'isc_dpb_drop_walfile'; Number: isc_dpb_drop_walfile),
387  (Name:'isc_dpb_old_dump_id'; Number: isc_dpb_old_dump_id),
388  (Name:'isc_dpb_wal_backup_dir'; Number: isc_dpb_wal_backup_dir),
389  (Name:'isc_dpb_wal_chkptlen'; Number: isc_dpb_wal_chkptlen),
390  (Name:'isc_dpb_wal_numbufs'; Number: isc_dpb_wal_numbufs),
391  (Name:'isc_dpb_wal_bufsize'; Number: isc_dpb_wal_bufsize),
392  (Name:'isc_dpb_wal_grp_cmt_wait'; Number: isc_dpb_wal_grp_cmt_wait),
393  (Name:'isc_dpb_lc_messages'; Number: isc_dpb_lc_messages),
394  (Name:'isc_dpb_lc_ctype'; Number: isc_dpb_lc_ctype),
395  (Name:'isc_dpb_cache_manager'; Number: isc_dpb_cache_manager),
396  (Name:'isc_dpb_shutdown'; Number: isc_dpb_shutdown),
397  (Name:'isc_dpb_online'; Number: isc_dpb_online),
398  (Name:'isc_dpb_shutdown_delay'; Number: isc_dpb_shutdown_delay),
399  (Name:'isc_dpb_reserved'; Number: isc_dpb_reserved),
400  (Name:'isc_dpb_overwrite'; Number: isc_dpb_overwrite),
401  (Name:'isc_dpb_sec_attach'; Number: isc_dpb_sec_attach),
402  (Name:'isc_dpb_disable_wal'; Number: isc_dpb_disable_wal),
403  (Name:'isc_dpb_connect_timeout'; Number: isc_dpb_connect_timeout),
404  (Name:'isc_dpb_dummy_packet_interval'; Number: isc_dpb_dummy_packet_interval),
405  (Name:'isc_dpb_gbak_attach'; Number: isc_dpb_gbak_attach),
406  (Name:'isc_dpb_sql_role_name'; Number: isc_dpb_sql_role_name),
407  (Name:'isc_dpb_set_page_buffers'; Number: isc_dpb_set_page_buffers),
408  (Name:'isc_dpb_working_directory'; Number: isc_dpb_working_directory),
409  (Name:'isc_dpb_sql_dialect'; Number: isc_dpb_SQL_dialect),
410  (Name:'isc_dpb_set_db_readonly'; Number: isc_dpb_set_db_readonly),
411  (Name:'isc_dpb_set_db_sql_dialect'; Number: isc_dpb_set_db_SQL_dialect),
412  (Name:'isc_dpb_gfix_attach'; Number: isc_dpb_gfix_attach),
413  (Name:'isc_dpb_gstat_attach'; Number: isc_dpb_gstat_attach)
414  );
415 
416  { count transaction parameters }
417  MAX_TPB_PARAMS = 24;
418  { prefix transaction parameters names it used in paramters scann procedure }
419  TPBPrefix = 'isc_tpb_';
420  { list transaction parameters and their apropriate numbers }
421  TransactionParams: array [0..MAX_TPB_PARAMS-1]of TZIbParam = (
422  (Name:'isc_tpb_version1'; Number: isc_tpb_version1),
423  (Name:'isc_tpb_version3'; Number: isc_tpb_version3),
424  (Name:'isc_tpb_consistency'; Number: isc_tpb_consistency),
425  (Name:'isc_tpb_concurrency'; Number: isc_tpb_concurrency),
426  (Name:'isc_tpb_shared'; Number: isc_tpb_shared),
427  (Name:'isc_tpb_protected'; Number: isc_tpb_protected),
428  (Name:'isc_tpb_exclusive'; Number: isc_tpb_exclusive),
429  (Name:'isc_tpb_wait'; Number: isc_tpb_wait),
430  (Name:'isc_tpb_nowait'; Number: isc_tpb_nowait),
431  (Name:'isc_tpb_read'; Number: isc_tpb_read),
432  (Name:'isc_tpb_write'; Number: isc_tpb_write),
433  (Name:'isc_tpb_lock_read'; Number: isc_tpb_lock_read),
434  (Name:'isc_tpb_lock_write'; Number: isc_tpb_lock_write),
435  (Name:'isc_tpb_verb_time'; Number: isc_tpb_verb_time),
436  (Name:'isc_tpb_commit_time'; Number: isc_tpb_commit_time),
437  (Name:'isc_tpb_ignore_limbo'; Number: isc_tpb_ignore_limbo),
438  (Name:'isc_tpb_read_committed'; Number: isc_tpb_read_committed),
439  (Name:'isc_tpb_autocommit'; Number: isc_tpb_autocommit),
440  (Name:'isc_tpb_rec_version'; Number: isc_tpb_rec_version),
441  (Name:'isc_tpb_no_rec_version'; Number: isc_tpb_no_rec_version),
442  (Name:'isc_tpb_restart_requests'; Number: isc_tpb_restart_requests),
443  (Name:'isc_tpb_no_auto_undo'; Number: isc_tpb_no_auto_undo),
444  (Name:'isc_tpb_no_savepoint'; Number: isc_tpb_no_savepoint),// Since IB75+
445  (Name:'isc_tpb_lock_timeout'; Number: isc_tpb_lock_timeout) // Since FB20+
446  );
447 
448 implementation
449 
450 uses
451  Variants, ZSysUtils, Math, ZDbcInterbase6, ZEncoding
452  {$IFDEF WITH_UNITANSISTRINGS}, AnsiStrings{$ENDIF};
453 
454 {**
455  Generate specific length random string and return it
456  @param Len a length result string
457  @return random string
458 }
459 function RandomString(Len: integer): AnsiString;
460 begin
461  Result := '';
462  while Length(Result) < Len do
463  Result := Result + AnsiString(IntToStr(Trunc(Random(High(Integer)))));
464  if Length(Result) > Len then
465  Result := Copy(Result, 1, Len);
466 end;
467 
468 {**
469  Create CachedResultSet with using TZCachedResultSet and return it.
470  @param SQL a sql query command
471  @param Statement a zeos statement object
472  @param NativeResultSet a native result set
473  @return cached ResultSet
474 }
475 function CreateIBResultSet(SQL: string; Statement: IZStatement; NativeResultSet: IZResultSet): IZResultSet;
476 var
477  CachedResolver: TZInterbase6CachedResolver;
478  CachedResultSet: TZCachedResultSet;
479 begin
480  if (Statement.GetResultSetConcurrency <> rcReadOnly)
481  or (Statement.GetResultSetType <> rtForwardOnly) then
482  begin
483  CachedResolver := TZInterbase6CachedResolver.Create(Statement, NativeResultSet.GetMetadata);
484  CachedResultSet := TZCachedResultSet.Create(NativeResultSet, SQL,
485  CachedResolver, Statement.GetConnection.GetConSettings);
486  CachedResultSet.SetConcurrency(Statement.GetResultSetConcurrency);
487  Result := CachedResultSet;
488  end
489  else
490  Result := NativeResultSet;
491 end;
492 
493 {**
494  Generate database connection string by connection information
495  @param DPB - a database connection string
496  @param Dialect - a sql dialect number
497  @param Info - a list connection interbase parameters
498  @return a generated string length
499 }
500 function GenerateDPB(Info: TStrings; var FDPBLength, Dialect: Word): PAnsiChar;
501 var
502  I, Pos, PValue: Integer;
503  ParamNo: Word;
504  Buffer: String;
505  DPB, ParamName, ParamValue: AnsiString;
506 begin
507  FDPBLength := 1;
508  DPB := AnsiChar(isc_dpb_version1);
509 
510  for I := 0 to Info.Count - 1 do
511  begin
512  Buffer := Info.Strings[I];
513  Pos := FirstDelimiter(' ='#9#10#13, Buffer);
514  ParamName := AnsiString(Copy(Buffer, 1, Pos - 1));
515  Delete(Buffer, 1, Pos);
516  ParamValue := AnsiString(Buffer);
517  ParamNo := GetInterbase6DatabaseParamNumber(ParamName);
518 
519  case ParamNo of
520  0: Continue;
521  isc_dpb_set_db_SQL_dialect:
522  Dialect := StrToIntDef(String(ParamValue), 0);
523  isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
524  isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
525  isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_sql_role_name,
526  isc_dpb_connect_timeout:
527  begin
528  DPB := DPB + AnsiChar(ParamNo) + AnsiChar(Length(ParamValue)) + ParamValue;
529  Inc(FDPBLength, 2 + Length(ParamValue));
530  end;
531  isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
532  isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
533  begin
534  DPB := DPB + AnsiChar(ParamNo) + #1 + AnsiChar(StrToInt(String(ParamValue)));
535  Inc(FDPBLength, 3);
536  end;
537  isc_dpb_sweep:
538  begin
539  DPB := DPB + AnsiChar(ParamNo) + #1 + AnsiChar(isc_dpb_records);
540  Inc(FDPBLength, 3);
541  end;
542  isc_dpb_sweep_interval:
543  begin
544  PValue := StrToInt(String(ParamValue));
545  DPB := DPB + AnsiChar(ParamNo) + #4 + PAnsiChar(@PValue)[0] +
546  PAnsiChar(@PValue)[1] + PAnsiChar(@PValue)[2] + PAnsiChar(@PValue)[3];
547  Inc(FDPBLength, 6);
548  end;
549  isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
550  isc_dpb_quit_log:
551  begin
552  DPB := DPB + AnsiChar(ParamNo) + #1 + #0;
553  Inc(FDPBLength, 3);
554  end;
555  end;
556  end;
557 
558  {$IFDEF UNICODE}
559  Result := AnsiStrAlloc(FDPBLength + 1);
560  {$ELSE}
561  Result := StrAlloc(FDPBLength + 1);
562  {$ENDIF}
563 
564 
565  {$IFDEF WITH_STRPCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPCopy(Result, DPB);
566 end;
567 
568 {**
569  Generate transaction structuer by connection information
570  @param Params - a transaction parameters list
571  @param Dialect - a database connection handle
572  @return a transaction ISC structure
573 }
574 function GenerateTPB(Params: TStrings; var Handle: TISC_DB_HANDLE): PISC_TEB;
575 var
576  I: Integer;
577  TPBLength,ParamNo: Word;
578  TempStr, ParamValue: AnsiString;
579  TPB: PAnsiChar;
580  IsolationLevel: Boolean;
581 begin
582  TPBLength := 0;
583  TempStr := '';
584  IsolationLevel := False;
585 
586  { Prepare transaction parameters string }
587  for I := 0 to Params.Count - 1 do
588  begin
589  ParamValue := AnsiString(Params.Strings[I]);
590  ParamNo := GetInterbase6TransactionParamNumber(ParamValue);
591 
592  case ParamNo of
593  0: Continue;
594  isc_tpb_lock_read, isc_tpb_lock_write:
595  begin
596  TempStr := TempStr + AnsiChar(ParamNo) + AnsiChar(Length(ParamValue)) + ParamValue;
597  Inc(TPBLength, Length(ParamValue) + 2);
598  end;
599  else
600  begin
601  TempStr := TempStr + AnsiChar(ParamNo);
602  Inc(TPBLength, 1);
603  end;
604  end;
605 
606  { Check what was set use transaction isolation level }
607  if not IsolationLevel then
608  case ParamNo of
609  isc_tpb_concurrency, isc_tpb_consistency,
610  isc_tpb_read_committed:
611  IsolationLevel := True
612  else
613  IsolationLevel := False;
614  end;
615 
616  end;
617 
618  { Allocate transaction parameters PAnsiChar buffer
619  if temporally parameters string is empty the set null pointer for
620  default database transaction}
621  if (TPBLength > 0) and (IsolationLevel) then
622  begin
623  {$IFDEF UNICODE}
624  TPB := AnsiStrAlloc(TPBLength + 1);
625  {$ELSE}
626  TPB := StrAlloc(TPBLength + 1);
627  {$ENDIF}
628  TPB := {$IFDEF WITH_STRPCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPCopy(TPB, TempStr);
629 
630  end
631  else
632  TPB := nil;
633 
634  { Allocate transaction structure }
635  Result := AllocMem(SizeOf(TISC_TEB));
636  with Result^ do
637  begin
638  db_handle := @Handle;
639  tpb_length := TPBLength;
640  tpb_address := TPB;
641  end;
642 end;
643 
644 {**
645  Return interbase connection parameter number by it name
646  @param Value - a connection parameter name
647  @return - connection parameter number
648 }
649 function GetInterbase6DatabaseParamNumber(const Value: AnsiString): Word;
650 var
651  I: Integer;
652  ParamName: AnsiString;
653 begin
654  ParamName := {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings.{$ENDIF}AnsiLowerCase(Value);
655  Result := 0;
656  if System.Pos(BPBPrefix, String(ParamName)) = 1 then
657  for I := 1 to MAX_DPB_PARAMS do
658  begin
659  if ParamName = DatabaseParams[I].Name then
660  begin
661  Result := DatabaseParams[I].Number;
662  Break;
663  end;
664  end;
665 end;
666 
667 {**
668  Return interbase transaction parameter number by it name
669  @param Value - a transaction parameter name
670  @return - transaction parameter number
671 }
672 function GetInterbase6TransactionParamNumber(const Value: AnsiString): Word;
673 var
674  I: Integer;
675  ParamName: AnsiString;
676 begin
677  ParamName := {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings.{$ENDIF}AnsiLowerCase(Value);
678  Result := 0;
679  if System.Pos(TPBPrefix, String(ParamName)) = 1 then
680  for I := 1 to MAX_TPB_PARAMS do
681  begin
682  if ParamName = TransactionParams[I].Name then
683  begin
684  Result := TransactionParams[I].Number;
685  Break;
686  end;
687  end;
688 end;
689 
690 {**
691  Converts a Interbase6 native types into ZDBC SQL types.
692  @param the interbase type
693  @param the interbase subtype
694  @return a SQL undepended type.
695 
696  <b>Note:</b> The interbase type and subtype get from RDB$TYPES table
697 }
698 function ConvertInterbase6ToSqlType(SqlType, SqlSubType: Integer;
699  const CtrlsCPType: TZControlsCodePage): TZSQLType;
700 begin
701  Result := ZDbcIntfs.stUnknown;
702 
703  case SqlType of
704  blr_bool, blr_not_nullable: Result := stBoolean;
705  blr_varying2, blr_varying, blr_cstring, blr_cstring2, blr_domain_name,
706  blr_domain_name2, blr_column_name, blr_column_name2:
707  Result := stString;
708  blr_text, blr_text2:
709  case SqlSubType of
710  CS_BINARY: Result := stBytes;
711  else
712  Result := stString;
713  end;
714  blr_d_float: Result := stDouble;
715  blr_float: Result := stFloat;
716  blr_double: Result := stDouble;
717  blr_blob_id, blr_quad: Result := stLong;
718  blr_int64:
719  case SqlSubType of
720  RDB_NUMBERS_NONE: Result := stLong;
721  RDB_NUMBERS_NUMERIC: Result := stDouble;
722  RDB_NUMBERS_DECIMAL: Result := stBigDecimal;
723  end;
724  blr_long:
725  begin
726  case SqlSubType of
727  RDB_NUMBERS_NONE: Result := stInteger;
728  RDB_NUMBERS_NUMERIC: Result := stDouble;
729  RDB_NUMBERS_DECIMAL: Result := stBigDecimal;
730  end;
731  end;
732  blr_short:
733  begin
734  case SqlSubType of
735  RDB_NUMBERS_NONE: Result := stShort;
736  RDB_NUMBERS_NUMERIC: Result := stDouble;
737  RDB_NUMBERS_DECIMAL: Result := stDouble;
738  end;
739  end;
740  blr_sql_date: Result := stDate;
741  blr_sql_time: Result := stTime;
742  blr_timestamp: Result := stTimestamp;
743  blr_blob, blr_blob2:
744  begin
745  case SqlSubType of
746  { Blob Subtypes }
747  { types less than zero are reserved for customer use }
748  isc_blob_untyped: Result := stBinaryStream;
749 
750  { internal subtypes }
751  isc_blob_text: Result := stAsciiStream;
752  isc_blob_blr: Result := stBinaryStream;
753  isc_blob_acl: Result := stAsciiStream;
754  isc_blob_ranges: Result := stBinaryStream;
755  isc_blob_summary: Result := stBinaryStream;
756  isc_blob_format: Result := stAsciiStream;
757  isc_blob_tra: Result := stAsciiStream;
758  isc_blob_extfile: Result := stAsciiStream;
759  isc_blob_debug_info: Result := stBinaryStream;
760  end;
761  end;
762  else
763  Result := ZDbcIntfs.stUnknown;
764  end;
765  if ( CtrlsCPType = cCP_UTF16) then
766  case result of
767  stString: Result := stUnicodeString;
768  stAsciiStream: Result := stUnicodeStream;
769  end;
770 end;
771 
772 {**
773  Return Interbase SqlType by it number
774  @param Value the SqlType number
775 }
776 function GetNameSqlType(Value: Word): AnsiString;
777 begin
778  case Value of
779  SQL_VARYING: Result := 'SQL_VARYING';
780  SQL_TEXT: Result := 'SQL_TEXT';
781  SQL_DOUBLE: Result := 'SQL_DOUBLE';
782  SQL_FLOAT: Result := 'SQL_FLOAT';
783  SQL_LONG: Result := 'SQL_LONG';
784  SQL_SHORT: Result := 'SQL_SHORT';
785  SQL_TIMESTAMP: Result := 'SQL_TIMESTAMP';
786  SQL_BLOB: Result := 'SQL_BLOB';
787  SQL_D_FLOAT: Result := 'SQL_D_FLOAT';
788  SQL_ARRAY: Result := 'SQL_ARRAY';
789  SQL_QUAD: Result := 'SQL_QUAD';
790  SQL_TYPE_TIME: Result := 'SQL_TYPE_TIME';
791  SQL_TYPE_DATE: Result := 'SQL_TYPE_DATE';
792  SQL_INT64: Result := 'SQL_INT64';
793  SQL_BOOLEAN: Result := 'SQL_BOOLEAN';
794  else
795  Result := 'Unknown';
796  end
797 end;
798 
799 {**
800  Checks for possible sql errors.
801  @param PlainDriver a Interbase Plain drver
802  @param StatusVector a status vector. It contain information about error
803  @param Sql a sql query commend
804 
805  @Param Integer Return is the ErrorCode that happened - for disconnecting the database
806 }
807 function CheckInterbase6Error(PlainDriver: IZInterbasePlainDriver;
808  StatusVector: TARRAY_ISC_STATUS; LoggingCategory: TZLoggingCategory = lcOther;
809  SQL: string = '') : Integer;
810 var
811  Msg: array[0..1024] of AnsiChar;
812  PStatusVector: PISC_STATUS;
813  ErrorMessage, ErrorSqlMessage: string;
814  ErrorCode: LongInt;
815 begin
816  Result := 0;
817  if (StatusVector[0] = 1) and (StatusVector[1] > 0) then
818  begin
819  ErrorMessage := '';
820  PStatusVector := @StatusVector;
821  while PlainDriver.isc_interprete(Msg, @PStatusVector) > 0 do
822  ErrorMessage := ErrorMessage + ' ' + String(Msg);
823 
824  ErrorCode := PlainDriver.isc_sqlcode(@StatusVector);
825  PlainDriver.isc_sql_interprete(ErrorCode, Msg, 1024);
826  ErrorSqlMessage := String(Msg);
827 
828 {$IFDEF INTERBASE_EXTENDED_MESSAGES}
829  if SQL <> '' then
830  SQL := Format(' The SQL: %s; ', [SQL]);
831 {$ENDIF}
832 
833  if ErrorMessage <> '' then
834  begin
835  DriverManager.LogError(LoggingCategory, PlainDriver.GetProtocol,
836  ErrorMessage, ErrorCode, ErrorSqlMessage + SQL);
837 
838  //AVZ Ignore error codes for disconnected database -901, -902
839  if ((ErrorCode <> -901) and (ErrorCode <> -902)) then
840  begin
841 {$IFDEF INTERBASE_EXTENDED_MESSAGES}
842  raise EZSQLException.CreateWithCode(ErrorCode,
843  Format('SQL Error: %s. Error Code: %d. %s',
844  [ErrorMessage, ErrorCode, ErrorSqlMessage]) + SQL);
845 {$ELSE}
846  raise EZSQLException.CreateWithCode(ErrorCode,
847  Format('SQL Error: %s. Error Code: %d. %s',
848  [ErrorMessage, ErrorCode, ErrorSqlMessage]));
849 {$ENDIF}
850  end
851  else
852  begin //AVZ -- Added exception back in to help error trapping
853  raise EZSQLException.CreateWithCode(ErrorCode,
854  Format('SQL Error: %s. Error Code: %d. %s',
855  [ErrorMessage, ErrorCode, ErrorSqlMessage]));
856 
857  Result := DISCONNECT_ERROR;
858  end;
859  end;
860  end;
861 end;
862 
863 {**
864  Prepare statement and create statement handle.
865  @param PlainDriver a interbase plain driver
866  @param Handle a interbase connection handle
867  @param TrHandle a transaction handle
868  @param Dialect a interbase sql dialect number
869  @param Sql a sql query
870  @param StmtHandle a statement handle
871  @param SqlData a interbase sql result data
872  @return sql statement type
873 }
874 function PrepareStatement(PlainDriver: IZInterbasePlainDriver;
875  Handle: PISC_DB_HANDLE; TrHandle: PISC_TR_HANDLE; Dialect: Word;
876  SQL: RawByteString; LogSQL: String; var StmtHandle: TISC_STMT_HANDLE):
877  TZIbSqlStatementType;
878 var
879  StatusVector: TARRAY_ISC_STATUS;
880  iError : Integer; //Error for disconnect
881 begin
882  { Allocate an sql statement }
883  if StmtHandle = 0 then
884  begin
885  PlainDriver.isc_dsql_allocate_statement(@StatusVector, Handle, @StmtHandle);
886  CheckInterbase6Error(PlainDriver, StatusVector, lcOther, LogSQL);
887  end;
888  { Prepare an sql statement }
889  PlainDriver.isc_dsql_prepare(@StatusVector, TrHandle, @StmtHandle,
890  0, PAnsiChar(SQL), Dialect, nil);
891 
892  iError := CheckInterbase6Error(PlainDriver, StatusVector, lcPrepStmt, LogSQL); //Check for disconnect AVZ
893 
894  { Set Statement Type }
895  if (iError <> DISCONNECT_ERROR) then //AVZ
896  Result := GetStatementType(PlainDriver, StmtHandle)
897  else
898  Result := stDisconnect;
899 
900  if Result in [stUnknown, stGetSegment, stPutSegment, stStartTrans] then
901  begin
902  FreeStatement(PlainDriver, StmtHandle, DSQL_CLOSE); //AVZ
903  raise EZSQLException.Create(SStatementIsNotAllowed);
904  end;
905 end;
906 
907 {**
908  Describe SQLDA and allocate memory for result values.
909  @param PlainDriver a interbase plain driver
910  @param Handle a interbase connection handle
911  @param Dialect a interbase sql dialect number
912  @param Sql a sql query
913  @param StmtHandle a statement handle
914  @param SqlData a interbase sql result data
915 }
916 procedure PrepareResultSqlData(PlainDriver: IZInterbasePlainDriver;
917  Handle: PISC_DB_HANDLE; Dialect: Word; LogSQL: string;
918  var StmtHandle: TISC_STMT_HANDLE; SqlData: IZResultSQLDA);
919 var
920  StatusVector: TARRAY_ISC_STATUS;
921 begin
922  { Initialise ouput param and fields }
923  PlainDriver.isc_dsql_describe(@StatusVector, @StmtHandle, Dialect,
924  SqlData.GetData);
925  CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, LogSQL);
926 
927  if SqlData.GetData^.sqld > SqlData.GetData^.sqln then
928  begin
929  SqlData.AllocateSQLDA;
930  PlainDriver.isc_dsql_describe(@StatusVector, @StmtHandle,
931  Dialect, SqlData.GetData);
932  CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, LogSql);
933  end;
934  SqlData.InitFields(False);
935 end;
936 
937 {**
938  Return interbase statement type by statement handle
939  @param PlainDriver a interbase plain driver
940  @param StmtHandle a statement handle
941  @return interbase statement type
942 }
943 function GetStatementType(PlainDriver: IZInterbasePlainDriver;
944  StmtHandle: TISC_STMT_HANDLE): TZIbSqlStatementType;
945 var
946  TypeItem: AnsiChar;
947  StatusVector: TARRAY_ISC_STATUS;
948  StatementLength: integer;
949  StatementBuffer: array[0..7] of AnsiChar;
950 begin
951  Result := stUnknown;
952  TypeItem := AnsiChar(isc_info_sql_stmt_type);
953 
954  { Get information about a prepared DSQL statement. }
955  PlainDriver.isc_dsql_sql_info(@StatusVector, @StmtHandle, 1,
956  @TypeItem, SizeOf(StatementBuffer), StatementBuffer);
957  CheckInterbase6Error(PlainDriver, StatusVector);
958 
959  if StatementBuffer[0] = AnsiChar(isc_info_sql_stmt_type) then
960  begin
961  StatementLength := PlainDriver.isc_vax_integer(
962  @StatementBuffer[1], 2);
963  Result := TZIbSqlStatementType(PlainDriver.isc_vax_integer(
964  @StatementBuffer[3], StatementLength));
965  end;
966 end;
967 
968 {**
969  Free interbse allocated statement and SQLDA for input and utput parameters
970  @param the interbase plain driver
971  @param the interbse statement handle
972 }
973 procedure FreeStatement(PlainDriver: IZInterbasePlainDriver; StatementHandle: TISC_STMT_HANDLE; Options: Word);
974 var
975  StatusVector: TARRAY_ISC_STATUS;
976 begin
977  if StatementHandle <> 0 then
978  PlainDriver.isc_dsql_free_statement(@StatusVector, @StatementHandle, Options);
979  //CheckInterbase6Error(PlainDriver, StatusVector); //raises an unwanted exception if Connection was reopened See: http://sourceforge.net/p/zeoslib/tickets/40/
980 end;
981 
982 {**
983  Get affected rows.
984  <i>Note:<i> it function may call after statement execution
985  @param PlainDriver a interbase plain driver
986  @param StmtHandle a statement handle
987  @param StatementType a statement type
988  @return affected rows
989 }
990 function GetAffectedRows(PlainDriver: IZInterbasePlainDriver;
991  StmtHandle: TISC_STMT_HANDLE; StatementType: TZIbSqlStatementType): Integer;
992 var
993  ReqInfo: AnsiChar;
994  OutBuffer: array[0..255] of AnsiChar;
995  StatusVector: TARRAY_ISC_STATUS;
996 begin
997  Result := -1;
998  ReqInfo := AnsiChar(isc_info_sql_records);
999 
1000  if PlainDriver.isc_dsql_sql_info(@StatusVector, @StmtHandle, 1,
1001  @ReqInfo, SizeOf(OutBuffer), OutBuffer) > 0 then
1002  Exit;
1003  CheckInterbase6Error(PlainDriver, StatusVector);
1004  if OutBuffer[0] = AnsiChar(isc_info_sql_records) then
1005  begin
1006  case StatementType of
1007  stUpdate: Result := PlainDriver.isc_vax_integer(@OutBuffer[6], 4);
1008  stDelete: Result := PlainDriver.isc_vax_integer(@OutBuffer[13], 4);
1009  stSelect: Result := PlainDriver.isc_vax_integer(@OutBuffer[20], 4);
1010  stInsert: Result := PlainDriver.isc_vax_integer(@OutBuffer[27], 4);
1011  else
1012  Result := -1;
1013  end;
1014  end;
1015 end;
1016 
1017 {**
1018  Prepare sql statement parameters and fill parameters by values
1019  @param PlainDriver a interbase plain driver
1020  @param Dialect a interbase sql dialect number
1021  @param StmtHandle a statement handle
1022  @param SqlData a interbase sql result data
1023 }
1024 procedure PrepareParameters(PlainDriver: IZInterbasePlainDriver; LogSQL: string;
1025  Dialect: Word; var StmtHandle: TISC_STMT_HANDLE; ParamSqlData: IZParamsSQLDA);
1026 var
1027  StatusVector: TARRAY_ISC_STATUS;
1028 begin
1029  {check dynamic sql}
1030  PlainDriver.isc_dsql_describe_bind(@StatusVector, @StmtHandle, Dialect,
1031  ParamSqlData.GetData);
1032  CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, LogSQL);
1033 
1034  { Resize XSQLDA structure if needed }
1035  if ParamSqlData.GetData^.sqld > ParamSqlData.GetData^.sqln then
1036  begin
1037  ParamSqlData.AllocateSQLDA;
1038  PlainDriver.isc_dsql_describe_bind(@StatusVector, @StmtHandle, Dialect,
1039  ParamSqlData.GetData);
1040  CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, LogSQL);
1041  end;
1042 
1043  ParamSqlData.InitFields(True);
1044 end;
1045 
1046 procedure BindSQLDAInParameters(PlainDriver: IZInterbasePlainDriver;
1047  InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray;
1048  InParamCount: Integer; ParamSqlData: IZParamsSQLDA; ConSettings: PZConSettings);
1049 var
1050  I: Integer;
1051  TempBlob: IZBlob;
1052  TempStream: TStream;
1053 begin
1054  if InParamCount <> ParamSqlData.GetFieldCount then
1055  raise EZSQLException.Create(SInvalidInputParameterCount);
1056 
1057  {$R-}
1058  for I := 0 to ParamSqlData.GetFieldCount - 1 do
1059  begin
1060  ParamSqlData.UpdateNull(I, DefVarManager.IsNull(InParamValues[I]));
1061  if DefVarManager.IsNull(InParamValues[I])then
1062  Continue
1063  else
1064  case InParamTypes[I] of
1065  stBoolean:
1066  ParamSqlData.UpdateBoolean(I,
1067  SoftVarManager.GetAsBoolean(InParamValues[I]));
1068  stByte:
1069  ParamSqlData.UpdateByte(I,
1070  SoftVarManager.GetAsInteger(InParamValues[I]));
1071  stShort:
1072  ParamSqlData.UpdateShort(I,
1073  SoftVarManager.GetAsInteger(InParamValues[I]));
1074  stInteger:
1075  ParamSqlData.UpdateInt(I,
1076  SoftVarManager.GetAsInteger(InParamValues[I]));
1077  stLong:
1078  ParamSqlData.UpdateLong(I,
1079  SoftVarManager.GetAsInteger(InParamValues[I]));
1080  stFloat:
1081  ParamSqlData.UpdateFloat(I,
1082  SoftVarManager.GetAsFloat(InParamValues[I]));
1083  stDouble:
1084  ParamSqlData.UpdateDouble(I,
1085  SoftVarManager.GetAsFloat(InParamValues[I]));
1086  stBigDecimal:
1087  ParamSqlData.UpdateBigDecimal(I,
1088  SoftVarManager.GetAsFloat(InParamValues[I]));
1089  stString:
1090  if ( ConSettings.ClientCodePage.ID = CS_NONE ) and not
1091  (ParamSqlData.GetIbSqlSubType(I) = CS_NONE) then //CharSet 'NONE' writes data 'as is'!
1092  ParamSqlData.UpdateString(I,
1093  PlainDriver.ZPlainString(SoftVarManager.GetAsString(InParamValues[I]),
1094  ConSettings, PlainDriver.ValidateCharEncoding(ParamSqlData.GetIbSqlSubType(I)).CP))
1095  else
1096  ParamSqlData.UpdateString(I,
1097  PlainDriver.ZPlainString(SoftVarManager.GetAsString(InParamValues[I]), ConSettings));
1098  stUnicodeString:
1099  if ( ConSettings.ClientCodePage.ID = CS_NONE ) and not
1100  (ParamSqlData.GetIbSqlSubType(I) = CS_NONE) then //CharSet 'NONE' writes data 'as is'!
1101  ParamSqlData.UpdateString(I,
1102  PlainDriver.ZPlainString(SoftVarManager.GetAsUnicodeString(InParamValues[I]),
1103  ConSettings, PlainDriver.ValidateCharEncoding(ParamSqlData.GetIbSqlSubType(I)).CP))
1104  else
1105  ParamSqlData.UpdateString(I,
1106  PlainDriver.ZPlainString(SoftVarManager.GetAsUnicodeString(InParamValues[I]), ConSettings));
1107  stBytes:
1108  ParamSqlData.UpdateBytes(I, SoftVarManager.GetAsBytes(InParamValues[I]));
1109  stDate:
1110  ParamSqlData.UpdateDate(I,
1111  SoftVarManager.GetAsDateTime(InParamValues[I]));
1112  stTime:
1113  ParamSqlData.UpdateTime(I,
1114  SoftVarManager.GetAsDateTime(InParamValues[I]));
1115  stTimestamp:
1116  ParamSqlData.UpdateTimestamp(I,
1117  SoftVarManager.GetAsDateTime(InParamValues[I]));
1118  stAsciiStream,
1119  stUnicodeStream,
1120  stBinaryStream:
1121  begin
1122  TempBlob := DefVarManager.GetAsInterface(InParamValues[I]) as IZBlob;
1123  if not TempBlob.IsEmpty then
1124  begin
1125  if (ParamSqlData.GetFieldSqlType(i) in [stUnicodeStream, stAsciiStream] ) then
1126  TempStream := TStringStream.Create(GetValidatedAnsiStringFromBuffer(TempBlob.GetBuffer, TempBlob.Length,
1127  TempBlob.WasDecoded, ConSettings))
1128  else
1129  TempStream := TempBlob.GetStream;
1130  if Assigned(TempStream) then
1131  begin
1132  ParamSqlData.WriteBlob(I, TempStream);
1133  TempStream.Free;
1134  end;
1135  end;
1136  end
1137  else
1138  raise EZIBConvertError.Create(SUnsupportedParameterType);
1139  end;
1140  end;
1141  {$IFOPT D+}
1142 {$ENDIF}
1143 end;
1144 
1145 {**
1146  Read blob information by it handle such as blob segment size, segments count,
1147  blob size and type.
1148  @param PlainDriver
1149  @param BlobInfo the blob information structure
1150 }
1151 procedure GetBlobInfo(PlainDriver: IZInterbasePlainDriver;
1152  BlobHandle: TISC_BLOB_HANDLE; var BlobInfo: TIbBlobInfo);
1153 var
1154  Items: array[0..3] of AnsiChar;
1155  Results: array[0..99] of AnsiChar;
1156  I, ItemLength: Integer;
1157  Item: Integer;
1158  StatusVector: TARRAY_ISC_STATUS;
1159 begin
1160  I := 0;
1161  Items[0] := AnsiChar(isc_info_blob_num_segments);
1162  Items[1] := AnsiChar(isc_info_blob_max_segment);
1163  Items[2] := AnsiChar(isc_info_blob_total_length);
1164  Items[3] := AnsiChar(isc_info_blob_type);
1165 
1166  if PlainDriver.isc_blob_info(@StatusVector, @BlobHandle, 4, @items[0],
1167  SizeOf(Results), @Results[0]) > 0 then
1168  CheckInterbase6Error(PlainDriver, StatusVector);
1169 
1170  while (I < SizeOf(Results)) and (Results[I] <> AnsiChar(isc_info_end)) do
1171  begin
1172  Item := Integer(Results[I]);
1173  Inc(I);
1174  ItemLength := PlainDriver.isc_vax_integer(@results[I], 2);
1175  Inc(I, 2);
1176  case Item of
1177  isc_info_blob_num_segments:
1178  BlobInfo.NumSegments := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
1179  isc_info_blob_max_segment:
1180  BlobInfo.MaxSegmentSize := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
1181  isc_info_blob_total_length:
1182  BlobInfo.TotalSize := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
1183  isc_info_blob_type:
1184  BlobInfo.BlobType := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
1185  end;
1186  Inc(i, ItemLength);
1187  end;
1188 end;
1189 
1190 {**
1191  Read blob field data to stream by it ISC_QUAD value
1192  Note: DefaultBlobSegmentSize constant used for limit segment size reading
1193  @param Handle the database connection handle
1194  @param TransactionHandle the transaction handle
1195  @param BlobId the ISC_QUAD structure
1196  @param Size the result buffer size
1197  @param Buffer the pointer to result buffer
1198 
1199  Note: Buffer must be nill. Function self allocate memory for data
1200  and return it size
1201 }
1202 procedure ReadBlobBufer(PlainDriver: IZInterbasePlainDriver;
1203  Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE;
1204  BlobId: TISC_QUAD; var Size: Integer; var Buffer: Pointer);
1205 var
1206  TempBuffer: PAnsiChar;
1207  BlobInfo: TIbBlobInfo;
1208  BlobSize, CurPos: LongInt;
1209  BytesRead, SegmentLenght: UShort;
1210  BlobHandle: TISC_BLOB_HANDLE;
1211  StatusVector: TARRAY_ISC_STATUS;
1212 begin
1213  BlobHandle := 0;
1214  CurPos := 0;
1215 // SegmentLenght := UShort(DefaultBlobSegmentSize);
1216 
1217  { open blob }
1218  PlainDriver.isc_open_blob2(@StatusVector, Handle,
1219  TransactionHandle, @BlobHandle, @BlobId, 0 , nil);
1220  CheckInterbase6Error(PlainDriver, StatusVector);
1221 
1222  { get blob info }
1223  GetBlobInfo(PlainDriver, BlobHandle, BlobInfo);
1224  BlobSize := BlobInfo.TotalSize;
1225  Size := BlobSize;
1226 
1227  SegmentLenght := BlobInfo.MaxSegmentSize;
1228 
1229  { Allocates a blob buffer }
1230  Buffer := AllocMem(BlobSize);
1231  TempBuffer := Buffer;
1232 
1233  { Copies data to blob buffer }
1234  while CurPos < BlobSize do
1235  begin
1236  if (CurPos + SegmentLenght > BlobSize) then
1237  SegmentLenght := BlobSize - CurPos;
1238  if not(PlainDriver.isc_get_segment(@StatusVector, @BlobHandle,
1239  @BytesRead, SegmentLenght, TempBuffer) = 0) or
1240  (StatusVector[1] <> isc_segment) then
1241  CheckInterbase6Error(PlainDriver, StatusVector);
1242  Inc(CurPos, BytesRead);
1243  Inc(TempBuffer, BytesRead);
1244  BytesRead := 0;
1245  end;
1246 
1247  { close blob handle }
1248  PlainDriver.isc_close_blob(@StatusVector, @BlobHandle);
1249  CheckInterbase6Error(PlainDriver, StatusVector);
1250 end;
1251 
1252 function GetIBScaleDivisor(Scale: SmallInt): Int64;
1253 var
1254  i: Integer;
1255 begin
1256  Result := 1;
1257  if Scale > 0 then
1258  for i := 1 to Scale do
1259  Result := Result * 10
1260  else
1261  if Scale < 0 then
1262  for i := -1 downto Scale do
1263  Result := Result * 10;
1264 end;
1265 {**
1266  Return interbase server version string
1267  @param PlainDriver a interbase plain driver
1268  @param Handle the database connection handle
1269  @return interbase version string
1270 }
1271 function GetVersion(PlainDriver: IZInterbasePlainDriver;
1272  Handle: PISC_DB_HANDLE): AnsiString;
1273 var
1274  DatabaseInfoCommand: AnsiChar;
1275  StatusVector: TARRAY_ISC_STATUS;
1276  Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
1277 begin
1278  DatabaseInfoCommand := AnsiChar(isc_info_version);
1279  PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand,
1280  IBBigLocalBufferLength, Buffer);
1281  CheckInterbase6Error(PlainDriver, StatusVector);
1282  Buffer[5 + Integer(Buffer[4])] := #0;
1283  result := AnsiString(PAnsiChar(@Buffer[5]));
1284 end;
1285 
1286 {**
1287  Return interbase database implementation
1288  @param PlainDriver a interbase plain driver
1289  @param Handle the database connection handle
1290  @return interbase database implementation
1291 }
1292 function GetDBImplementationNo(PlainDriver: IZInterbasePlainDriver;
1293  Handle: PISC_DB_HANDLE): LongInt;
1294 var
1295  DatabaseInfoCommand: AnsiChar;
1296  StatusVector: TARRAY_ISC_STATUS;
1297  Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
1298 begin
1299  DatabaseInfoCommand := AnsiChar(isc_info_implementation);
1300  PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand,
1301  IBLocalBufferLength, Buffer);
1302  CheckInterbase6Error(PlainDriver, StatusVector);
1303  result := PlainDriver.isc_vax_integer(@Buffer[3], 1);
1304 end;
1305 
1306 {**
1307  Return interbase database implementation class
1308  @param PlainDriver a interbase plain driver
1309  @param Handle the database connection handle
1310  @return interbase database implementation class
1311 }
1312 function GetDBImplementationClass(PlainDriver: IZInterbasePlainDriver;
1313  Handle: PISC_DB_HANDLE): LongInt;
1314 var
1315  DatabaseInfoCommand: AnsiChar;
1316  StatusVector: TARRAY_ISC_STATUS;
1317  Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
1318 begin
1319  DatabaseInfoCommand := AnsiChar(isc_info_implementation);
1320  PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand,
1321  IBLocalBufferLength, Buffer);
1322  CheckInterbase6Error(PlainDriver, StatusVector);
1323  result := PlainDriver.isc_vax_integer(@Buffer[4], 1);
1324 end;
1325 
1326 {**
1327  Return interbase database info
1328  @param PlainDriver a interbase plain driver
1329  @param Handle the database connection handle
1330  @param DatabaseInfoCommand a database information command
1331  @return interbase database info
1332 }
1333 function GetLongDbInfo(PlainDriver: IZInterbasePlainDriver;
1334  Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): LongInt;
1335 var
1336  Length: Integer;
1337  DatabaseInfoCommand1: AnsiChar;
1338  StatusVector: TARRAY_ISC_STATUS;
1339  Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
1340 begin
1341  DatabaseInfoCommand1 := AnsiChar(DatabaseInfoCommand);
1342  PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand1,
1343  IBLocalBufferLength, Buffer);
1344  CheckInterbase6Error(PlainDriver, StatusVector);
1345  Length := PlainDriver.isc_vax_integer(@Buffer[1], 2);
1346  Result := PlainDriver.isc_vax_integer(@Buffer[4], Length);
1347 end;
1348 
1349 {**
1350  Return interbase database info string
1351  @param PlainDriver a interbase plain driver
1352  @param Handle a database connection handle
1353  @param DatabaseInfoCommand a database information command
1354  @return interbase database info string
1355 }
1356 function GetStringDbInfo(PlainDriver: IZInterbasePlainDriver;
1357  Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): AnsiString;
1358 var
1359  DatabaseInfoCommand1: AnsiChar;
1360  StatusVector: TARRAY_ISC_STATUS;
1361  Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
1362 begin
1363  DatabaseInfoCommand1 := AnsiChar(DatabaseInfoCommand);
1364  PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand1,
1365  IBLocalBufferLength, Buffer);
1366  CheckInterbase6Error(PlainDriver, StatusVector);
1367  Buffer[4 + Integer(Buffer[3])] := #0;
1368  Result := AnsiString(PAnsiChar(@Buffer[4]));
1369 end;
1370 
1371 {**
1372  Return interbase database dialect
1373  @param PlainDriver a interbase plain driver
1374  @param Handle the database connection handle
1375  @return interbase database dialect
1376 }
1377 function GetDBSQLDialect(PlainDriver: IZInterbasePlainDriver;
1378  Handle: PISC_DB_HANDLE): Integer;
1379 var
1380  Length: Integer;
1381  DatabaseInfoCommand1: AnsiChar;
1382  StatusVector: TARRAY_ISC_STATUS;
1383  Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
1384 begin
1385  DatabaseInfoCommand1 := AnsiChar(isc_info_db_SQL_Dialect);
1386  PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand1,
1387  IBLocalBufferLength, Buffer);
1388  CheckInterbase6Error(PlainDriver, StatusVector);
1389  if (Buffer[0] <> AnsiChar(isc_info_db_SQL_dialect)) then
1390  Result := 1
1391  else
1392  begin
1393  Length := PlainDriver.isc_vax_integer(@Buffer[1], 2);
1394  Result := PlainDriver.isc_vax_integer(@Buffer[3], Length);
1395  end;
1396 end;
1397 
1398 { TSQLDA }
1399 constructor TZSQLDA.Create(PlainDriver: IZInterbasePlainDriver;
1400  Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE;
1401  ConSettings: PZConSettings);
1402 begin
1403  Self.ConSettings := ConSettings;
1404  FPlainDriver := PlainDriver;
1405  FHandle := Handle;
1406  FTransactionHandle := TransactionHandle;
1407 
1408  GetMem(FXSQLDA, XSQLDA_LENGTH(0));
1409  FillChar(FXSQLDA^, XSQLDA_LENGTH(0), 0);
1410  FXSQLDA.sqln := 0;
1411  FXSQLDA.sqld := 0;
1412 
1413  FXSQLDA.version := SQLDA_VERSION1;
1414 end;
1415 {**
1416  Allocate memory for SQLVar in SQLDA structure for every
1417  fields by it length.
1418 }
1419 procedure TZSQLDA.InitFields(Parameters: boolean);
1420 var
1421  I: Integer;
1422  SqlVar: PXSQLVAR;
1423 begin
1424  {$R-}
1425  for I := 0 to FXSQLDA.sqld - 1 do
1426  begin
1427  SqlVar := @FXSQLDA.SqlVar[I];
1428  case SqlVar.sqltype and (not 1) of
1429  SQL_BOOLEAN, SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_DATE,
1430  SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1431  SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1432  begin
1433  if SqlVar.sqllen = 0 then
1434  IbReAlloc(SqlVar.sqldata, 0, 1)
1435  else
1436  IbReAlloc(SqlVar.sqldata, 0, SqlVar.sqllen)
1437  end;
1438  SQL_VARYING:
1439  IbReAlloc(SqlVar.sqldata, 0, SqlVar.sqllen + 2)
1440  end;
1441 
1442  if Parameters = True then
1443  begin
1444  //This code used when allocated sqlind parameter for Param SQLDA
1445  SqlVar.sqltype := SqlVar.sqltype or 1;
1446  IbReAlloc(SqlVar.sqlind, 0, SizeOf(Short))
1447  end
1448  else
1449  begin
1450  //This code used when allocated sqlind parameter for Result SQLDA
1451  if (SqlVar.sqltype and 1) <> 0 then
1452  ReallocMem(SqlVar.sqlind, SizeOf(Short))
1453  else
1454  SqlVar.sqlind := nil;
1455  end;
1456  end;
1457  {$IFOPT D+}
1458 {$R+}
1459 {$ENDIF}
1460 end;
1461 
1462 {**
1463  Clear allocated data for SQLDA paramters
1464 }
1465 procedure TZSQLDA.FreeParamtersValues;
1466 var
1467  I: Integer;
1468  SqlVar: PXSQLVAR;
1469 begin
1470  {$R-}
1471  for I := 0 to FXSQLDA.sqln - 1 do
1472  begin
1473  SqlVar := @FXSQLDA.SqlVar[I];
1474  FreeMem(SqlVar.sqldata);
1475  FreeMem(SqlVar.sqlind);
1476  SqlVar.sqldata := nil;
1477  SqlVar.sqlind := nil;
1478  end;
1479  {$IFOPT D+}
1480 {$R+}
1481 {$ENDIF}
1482 end;
1483 
1484 {**
1485  Chech reange count fields. If index out of range raised exception.
1486  @param Index the index field
1487 }
1488 procedure TZSQLDA.CheckRange(const Index: Word);
1489 begin
1490  Assert(Index < Word(FXSQLDA.sqln), 'Out of Range.');
1491 end;
1492 
1493 {**
1494  Return alias name for field
1495  @param Index the index fields
1496  @return the alias name
1497 }
1498 function TZSQLDA.GetFieldAliasName(const Index: Word): String;
1499 begin
1500  CheckRange(Index);
1501  {$R-}
1502  SetString(Temp, FXSQLDA.sqlvar[Index].aliasname, FXSQLDA.sqlvar[Index].aliasname_length);
1503  Result := ZDbcString(Temp);
1504  {$IFOPT D+}
1505 {$R+}
1506 {$ENDIF}
1507 end;
1508 
1509 {**
1510  Return pointer to SQLDA structure
1511 }
1512 function TZSQLDA.GetData: PXSQLDA;
1513 begin
1514  result := FXSQLDA;
1515 end;
1516 
1517 {**
1518  Get fields count not allocated.
1519  @return fields count
1520 }
1521 function TZSQLDA.GetFieldCount: Integer;
1522 begin
1523  Result := FXSQLDA.sqld;
1524 end;
1525 
1526 {**
1527  Return field index by it name
1528  @param Index the index fields
1529  @return the index field
1530 }
1531 function TZSQLDA.GetFieldIndex(const Name: AnsiString): Word;
1532 begin
1533  {$R-}
1534  for Result := 0 to GetFieldCount - 1 do
1535  if FXSQLDA.sqlvar[Result].aliasname_length = Length(name) then
1536  if {$IFDEF WITH_STRLICOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrLIComp(@FXSQLDA.sqlvar[Result].aliasname, PAnsiChar(Name), FXSQLDA.sqlvar[Result].aliasname_length) = 0 then
1537  Exit;
1538  raise Exception.Create(Format(SFieldNotFound1, [name]));
1539  {$IFOPT D+}
1540 {$R+}
1541 {$ENDIF}
1542 end;
1543 
1544 {**
1545  Return field length
1546  @param Index the index fields
1547  @return the field lenth
1548 }
1549 function TZSQLDA.GetFieldLength(const Index: Word): SmallInt;
1550 begin
1551  {$R-}
1552  case GetIbSqlType(Index) of
1553  SQL_TEXT: Result := GetIbSqlLen(Index);
1554  SQL_VARYING: Result := GetIbSqlLen(Index);
1555  //SQL_VARYING: Result := FPlainDriver.isc_vax_integer(GetData.sqlvar[Index].sqldata, 2); //AVZ
1556  else
1557  Result := GetIbSqlLen(Index);
1558  end;
1559  {$IFOPT D+}
1560 {$R+}
1561 {$ENDIF}
1562 end;
1563 
1564 {**
1565  Return field scale
1566  @param Index the index fields
1567  @return the field scale
1568 }
1569 function TZSQLDA.GetFieldScale(const Index: Word): integer;
1570 begin
1571  CheckRange(Index);
1572  {$R-}
1573  Result := Abs(FXSQLDA.sqlvar[Index].sqlscale);
1574  {$IFOPT D+}
1575 {$R+}
1576 {$ENDIF}
1577 end;
1578 
1579 {**
1580  Convert Interbase sql type to SQLType
1581  @param Index the index fields
1582  @return the SQLType
1583 }
1584 function TZSQLDA.GetFieldSqlType(const Index: Word): TZSQLType;
1585 var
1586  SqlScale: Integer;
1587  SqlSubType: Integer;
1588 begin
1589  SqlScale := GetFieldScale(Index);
1590  SqlSubType := GetIbSqlSubType(Index);
1591 
1592  case GetIbSqlType(Index) of
1593  SQL_VARYING, SQL_TEXT:
1594  case SqlSubType of
1595  1: {Octets} Result := stBytes;
1596  else
1597  Result := stString;
1598  end;
1599  SQL_LONG:
1600  begin
1601  if SqlScale = 0 then
1602  Result := stInteger
1603  else
1604  Result := stDouble;
1605  end;
1606  SQL_SHORT:
1607  begin
1608  if SqlScale = 0 then
1609  Result := stShort
1610  else
1611  Result := stFloat; //Numeric with low precision
1612  end;
1613  SQL_FLOAT: Result := stFloat;
1614  SQL_DOUBLE: Result := stDouble;
1615  SQL_DATE: Result := stTimestamp;
1616  SQL_TYPE_TIME: Result := stTime;
1617  SQL_TYPE_DATE: Result := stDate;
1618  SQL_INT64:
1619  begin
1620  if SqlScale = 0 then
1621  Result := stLong
1622  else if Abs(SqlScale) <= 4 then
1623  Result := stDouble
1624  else
1625  Result := stBigDecimal;
1626  end;
1627  SQL_QUAD, SQL_ARRAY, SQL_BLOB:
1628  begin
1629  if SqlSubType = isc_blob_text then
1630  Result := stAsciiStream
1631  else
1632  Result := stBinaryStream;
1633  end;
1634  //SQL_ARRAY: Result := stBytes;
1635  else
1636  Result := stString;
1637  end;
1638  if ( ConSettings.CPType = cCP_UTF16 ) then
1639  case result of
1640  stString: Result := stUnicodeString;
1641  stAsciiStream: Result := stUnicodeStream;
1642  end;
1643 end;
1644 
1645 {**
1646  Return own name for field
1647  @param Index the index fields
1648  @return the own name
1649 }
1650 function TZSQLDA.GetFieldOwnerName(const Index: Word): String;
1651 begin
1652  CheckRange(Index);
1653  {$R-}
1654  {$IFDEF WITH_RAWBYTESTRING}
1655  SetLength(Temp, FXSQLDA.sqlvar[Index].OwnName_length);
1656  System.Move(FXSQLDA.sqlvar[Index].OwnName, PAnsiChar(Temp)^, FXSQLDA.sqlvar[Index].OwnName_length);
1657  {$ELSE}
1658  SetString(Temp, FXSQLDA.sqlvar[Index].OwnName, FXSQLDA.sqlvar[Index].OwnName_length);
1659  {$ENDIF}
1660  Result := ZDbcString(Temp);
1661  {$IFOPT D+}
1662 {$R+}
1663 {$ENDIF}
1664 end;
1665 
1666 {**
1667  Return real name for field
1668  @param Index the index fields
1669  @return the real name
1670 }
1671 function TZSQLDA.GetFieldRelationName(const Index: Word): String;
1672 begin
1673  CheckRange(Index);
1674  {$R-}
1675  {$IFDEF WITH_RAWBYTESTRING}
1676  SetLength(Temp, FXSQLDA.sqlvar[Index].RelName_length);
1677  System.Move(FXSQLDA.sqlvar[Index].RelName, PAnsiChar(Temp)^, FXSQLDA.sqlvar[Index].RelName_length);
1678  {$ELSE}
1679  SetString(Temp, FXSQLDA.sqlvar[Index].RelName, FXSQLDA.sqlvar[Index].RelName_length);
1680  {$ENDIF}
1681  Result := ZDbcString(Temp);
1682  {$IFOPT D+}
1683 {$R+}
1684 {$ENDIF}
1685 end;
1686 
1687 {**
1688  Get Interbase sql fields lenth
1689  @param Index the index fields
1690  @return Interbase sql fields lenth
1691 }
1692 function TZSQLDA.GetIbSqlLen(const Index: Word): Smallint;
1693 begin
1694  CheckRange(Index);
1695  {$R-}
1696  result := FXSQLDA.sqlvar[Index].sqllen;
1697  {$IFOPT D+}
1698 {$R+}
1699 {$ENDIF}
1700 end;
1701 
1702 {**
1703  Return sql name for field
1704  @param Index the index fields
1705  @return the sql name
1706 }
1707 function TZSQLDA.GetFieldSqlName(const Index: Word): String;
1708 begin
1709  CheckRange(Index);
1710  {$R-}
1711  {$IFDEF WITH_RAWBYTESTRING}
1712  SetLength(Temp, FXSQLDA.sqlvar[Index].sqlname_length);
1713  System.Move(FXSQLDA.sqlvar[Index].sqlname, PAnsiChar(Temp)^, FXSQLDA.sqlvar[Index].sqlname_length);
1714  {$ELSE}
1715  SetString(Temp, FXSQLDA.sqlvar[Index].sqlname, FXSQLDA.sqlvar[Index].sqlname_length);
1716  {$ENDIF}
1717  Result := ZDbcString(Temp);
1718  {$IFOPT D+}
1719 {$R+}
1720 {$ENDIF}
1721 end;
1722 
1723 {**
1724  Get Interbase subsql type
1725  @param Index the index fields
1726  @return the Interbase subsql
1727 }
1728 function TZSQLDA.GetIbSqlSubType(const Index: Word): Smallint;
1729 begin
1730  CheckRange(Index);
1731  {$R-}
1732  result := FXSQLDA.sqlvar[Index].sqlsubtype;
1733  {$IFOPT D+}
1734 {$R+}
1735 {$ENDIF}
1736 end;
1737 
1738 {**
1739  Get Interbase sql type
1740  @param Index the index fields
1741  @return the interbase sql type
1742 }
1743 function TZSQLDA.GetIbSqlType(const Index: Word): Smallint;
1744 begin
1745  CheckRange(Index);
1746  {$R-}
1747  result := FXSQLDA.sqlvar[Index].sqltype and not (1);
1748  {$IFOPT D+}
1749 {$R+}
1750 {$ENDIF}
1751 end;
1752 
1753 {**
1754  Reallocate memory and fill memory by #0
1755  @param pointer to memory block
1756  @param old size of memory block
1757  @param new size of memory block
1758 }
1759 procedure TZSQLDA.IbReAlloc(var P; OldSize, NewSize: Integer);
1760 begin
1761  ReallocMem(Pointer(P), NewSize);
1762  if NewSize > OldSize then
1763  Fillchar((PAnsiChar(P) + OldSize)^, NewSize - OldSize, #0);
1764 end;
1765 
1766 procedure TZSQLDA.SetFieldType(const Index: Word; Size: Integer; Code: Smallint;
1767  Scale: Smallint);
1768 begin
1769  CheckRange(Index);
1770  {$R-}
1771  with FXSQLDA.sqlvar[Index] do
1772  begin
1773  sqltype := Code;
1774  if Scale <= 0 then
1775  sqlscale := Scale;
1776  sqllen := Size;
1777  if (Size > 0) then
1778  IbReAlloc(sqldata, 0, Size)
1779  else
1780  begin
1781  FreeMem(sqldata);
1782  sqldata := nil;
1783  end;
1784  end;
1785  {$IFOPT D+}
1786 {$R+}
1787 {$ENDIF}
1788 end;
1789 
1790 {**
1791  Indicate blob field
1792  @param Index the index fields
1793  @return true if blob field overwise false
1794 }
1795 function TZSQLDA.IsBlob(const Index: Word): boolean;
1796 begin
1797  CheckRange(Index);
1798  {$R-}
1799  result := ((FXSQLDA.sqlvar[Index].sqltype and not(1)) = SQL_BLOB);
1800  {$IFOPT D+}
1801 {$R+}
1802 {$ENDIF}
1803 end;
1804 
1805 {**
1806  Indicate blob field
1807  @param Index the index fields
1808  @return true if field nullable overwise false
1809 }
1810 function TZSQLDA.IsNullable(const Index: Word): boolean;
1811 begin
1812  CheckRange(Index);
1813  {$R-}
1814  Result := FXSQLDA.sqlvar[Index].sqltype and 1 = 1
1815  {$IFOPT D+}
1816 {$R+}
1817 {$ENDIF}
1818 end;
1819 
1820 {**
1821  Reallocate SQLDA to fields count length
1822  @param Value the count fields
1823 }
1824 procedure TZSQLDA.AllocateSQLDA;
1825 begin
1826  IbReAlloc(FXSQLDA, XSQLDA_LENGTH(FXSQLDA.sqln), XSQLDA_LENGTH(FXSQLDA.sqld));
1827  FXSQLDA.sqln := FXSQLDA.sqld;
1828 end;
1829 
1830 { TParamsSQLDA }
1831 
1832 {**
1833  Free allocated memory and free object
1834 }
1835 destructor TZParamsSQLDA.Destroy;
1836 begin
1837  FreeParamtersValues;
1838  FreeMem(FXSQLDA);
1839  inherited Destroy;
1840 end;
1841 
1842 {**
1843  Encode pascal string to Interbase paramter buffer
1844  @param Code the Interbase data type
1845  @param Index the index target filed
1846  @param Str the source string
1847 }
1848 
1849 procedure TZParamsSQLDA.EncodeString(Code: Smallint; const Index: Word;
1850  const Str: RawByteString);
1851 var
1852  Len: Cardinal;
1853 begin
1854  Len := Length(Str);
1855  {$R-}
1856  with FXSQLDA.sqlvar[Index] do
1857  case Code of
1858  SQL_TEXT :
1859  begin
1860  if (sqllen = 0) and (Str <> '') then //Manits: #0000249/pktfag
1861  GetMem(sqldata, Len)
1862  else
1863  IbReAlloc(sqldata, 0, Len + 1);
1864  sqllen := Len;
1865  Move(PAnsiChar(Str)^, sqldata^, sqllen);
1866  end;
1867  SQL_VARYING :
1868  begin
1869  sqllen := Len + 2;
1870  if sqllen = 0 then //Egonhugeist: Todo: Need test case. Can't believe this line is correct! sqllen is min 2
1871  GetMem(sqldata, Len + 2)
1872  else
1873  IbReAlloc(sqldata, 0, Len + 2);
1874  PISC_VARYING(sqldata).strlen := Len;
1875  Move(PAnsiChar(Str)^, PISC_VARYING(sqldata).str, PISC_VARYING(sqldata).strlen);
1876  end;
1877  end;
1878  {$IFOPT D+}
1879 {$R+}
1880 {$ENDIF}
1881 end;
1882 
1883 {**
1884  Encode Bytes dynamic array to Interbase paramter buffer
1885  @param Code the Interbase data type
1886  @param Index the index target filed
1887  @param Value the source array
1888 }
1889 
1890 procedure TZParamsSQLDA.EncodeBytes(Code: Smallint; const Index: Word;
1891  const Value: TByteDynArray);
1892 var
1893  Len: Cardinal;
1894 begin
1895  Len := Length(Value);
1896  {$R-}
1897  with FXSQLDA.sqlvar[Index] do
1898  case Code of
1899  SQL_TEXT :
1900  begin
1901  if (sqllen = 0) and ( Len <> 0 ) then //Manits: #0000249/pktfag
1902  GetMem(sqldata, Len)
1903  else
1904  IbReAlloc(sqldata, 0, Len + 1);
1905  sqllen := Len;
1906  Move(Pointer(Value)^, sqldata^, sqllen);
1907  end;
1908  SQL_VARYING :
1909  begin
1910  sqllen := Len + 2;
1911  if sqllen = 0 then //Egonhugeist: Todo: Need test case. Can't believe this line is correct! sqllen is min 2
1912  GetMem(sqldata, Len + 2)
1913  else
1914  IbReAlloc(sqldata, 0, Len + 2);
1915  PISC_VARYING(sqldata).strlen := Len;
1916  Move(Pointer(Value)^, PISC_VARYING(sqldata).str, PISC_VARYING(sqldata).strlen);
1917  end;
1918  end;
1919  {$IFOPT D+}
1920 {$R+}
1921 {$ENDIF}
1922 end;
1923 
1924 {**
1925  Set up parameter BigDecimal value
1926  @param Index the target parameter index
1927  @param Value the source value
1928 }
1929 procedure TZParamsSQLDA.UpdateBigDecimal(const Index: Integer; Value: Extended);
1930 var
1931  SQLCode: SmallInt;
1932 begin
1933  CheckRange(Index);
1934 
1935  {$R-}
1936  with FXSQLDA.sqlvar[Index] do
1937  begin
1938  if (sqlind <> nil) and (sqlind^ = -1) then
1939  Exit;
1940 
1941  SQLCode := (sqltype and not(1));
1942 
1943  if (sqlscale < 0) then
1944  begin //http://code.google.com/p/fbclient/wiki/DatatypeMapping
1945  case SQLCode of
1946  SQL_SHORT : PSmallInt(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
1947  SQL_LONG : PInteger(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
1948  SQL_INT64,
1949  SQL_QUAD : //PInt64(sqldata)^ := Trunc(Value * GetIBScaleDivisor(sqlscale)); EgonHugeist: Trunc seems to have rounding issues!
1950  //remain issues if decimal digits > scale than we've school learned rounding success randomly only
1951  //each aproach did fail: RoundTo(Value, sqlscale*-1), Round etc.
1952  //so the developer has to take
1953  PInt64(sqldata)^ := StrToInt64(FloatToStrF(RoundTo(Value, sqlscale) * GetIBScaleDivisor(sqlscale), ffFixed, 18, 0));
1954  SQL_DOUBLE : PDouble(sqldata)^ := Value; //I have tested with Query.ParamByName ().AsCurrency to check this, problem does not lie with straight SQL
1955  else
1956  raise EZIBConvertError.Create(SUnsupportedDataType);
1957  end;
1958  end
1959  else
1960  case SQLCode of
1961  SQL_DOUBLE : PDouble(sqldata)^ := Value;
1962  SQL_LONG : PInteger(sqldata)^ := Trunc(Value);
1963  SQL_D_FLOAT,
1964  SQL_FLOAT : PSingle(sqldata)^ := Value;
1965  SQL_BOOLEAN : PSmallint(sqldata)^ := Trunc(Value);
1966  SQL_SHORT : PSmallint(sqldata)^ := Trunc(Value);
1967  SQL_INT64 : PInt64(sqldata)^ := Trunc(Value);
1968  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(FloatToStr(Value)));
1969  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(FloatToStr(Value)));
1970  else
1971  raise EZIBConvertError.Create(SUnsupportedDataType);
1972  end;
1973  if (sqlind <> nil) then
1974  sqlind^ := 0; // not null
1975  end;
1976  {$IFOPT D+}
1977 {$R+}
1978 {$ENDIF}
1979 end;
1980 
1981 {**
1982  Set up parameter Boolean value
1983  @param Index the target parameter index
1984  @param Value the source value
1985 }
1986 procedure TZParamsSQLDA.UpdateBoolean(const Index: Integer; Value: boolean);
1987 var
1988  SQLCode: SmallInt;
1989 begin
1990  CheckRange(Index);
1991  {$R-}
1992  with FXSQLDA.sqlvar[Index] do
1993  begin
1994  if (sqlind <> nil) and (sqlind^ = -1) then
1995  Exit;
1996  SQLCode := (sqltype and not(1));
1997 
1998  if (sqlscale < 0) then
1999  begin
2000  case SQLCode of
2001  SQL_SHORT : PSmallInt(sqldata)^ := ord(Value) * IBScaleDivisor[sqlscale];
2002  SQL_LONG : PInteger(sqldata)^ := ord(Value) * IBScaleDivisor[sqlscale];
2003  SQL_INT64,
2004  SQL_QUAD : PInt64(sqldata)^ := ord(Value) * IBScaleDivisor[sqlscale];
2005  SQL_DOUBLE : PDouble(sqldata)^ := ord(Value);
2006  else
2007  raise EZIBConvertError.Create(SUnsupportedParameterType);
2008  end;
2009  end
2010  else
2011  case SQLCode of
2012  SQL_DOUBLE : PDouble(sqldata)^ := ord(Value);
2013  SQL_LONG : PInteger(sqldata)^ := ord(Value);
2014  SQL_D_FLOAT,
2015  SQL_FLOAT : PSingle(sqldata)^ := ord(Value);
2016  SQL_BOOLEAN : PSmallint(sqldata)^ := ord(Value);
2017  SQL_SHORT : PSmallint(sqldata)^ := ord(Value);
2018  SQL_INT64 : PInt64(sqldata)^ := ord(Value);
2019  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(IntToStr(ord(Value))));
2020  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(IntToStr(ord(Value))));
2021  else
2022  raise EZIBConvertError.Create(SUnsupportedParameterType);
2023  end;
2024  if (sqlind <> nil) then
2025  sqlind^ := 0; // not null
2026  end;
2027  {$IFOPT D+}
2028 {$R+}
2029 {$ENDIF}
2030 end;
2031 
2032 {**
2033  Set up parameter Byte value
2034  @param Index the target parameter index
2035  @param Value the source value
2036 }
2037 procedure TZParamsSQLDA.UpdateByte(const Index: Integer; Value: ShortInt);
2038 var
2039  SQLCode: SmallInt;
2040 begin
2041  CheckRange(Index);
2042  SetFieldType(Index, sizeof(Smallint), SQL_SHORT + 1, 0);
2043  {$R-}
2044  with FXSQLDA.sqlvar[Index] do
2045  begin
2046  if (sqlind <> nil) and (sqlind^ = -1) then
2047  Exit;
2048  SQLCode := (sqltype and not(1));
2049 
2050  if (sqlscale < 0) then
2051  begin
2052  case SQLCode of
2053  SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2054  SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2055  SQL_INT64,
2056  SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2057  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2058  else
2059  raise EZIBConvertError.Create(SUnsupportedParameterType);
2060  end;
2061  end
2062  else
2063  case SQLCode of
2064  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2065  SQL_LONG : PInteger(sqldata)^ := Value;
2066  SQL_D_FLOAT,
2067  SQL_FLOAT : PSingle(sqldata)^ := Value;
2068  SQL_BOOLEAN:
2069  begin
2070  if FPlainDriver.GetProtocol <> 'interbase-7' then
2071  raise EZIBConvertError.Create(SUnsupportedDataType);
2072  PSmallint(sqldata)^ := Value;
2073  end;
2074  SQL_SHORT : PSmallint(sqldata)^ := Value;
2075  SQL_INT64 : PInt64(sqldata)^ := Value;
2076  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(IntToStr(Value)));
2077  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(IntToStr(Value)));
2078  else
2079  raise EZIBConvertError.Create(SUnsupportedParameterType);
2080  end;
2081  if (sqlind <> nil) then
2082  sqlind^ := 0; // not null
2083  end;
2084  {$IFOPT D+}
2085 {$R+}
2086 {$ENDIF}
2087 end;
2088 
2089 {**
2090  Set up parameter byte value
2091  @param Index the target parameter index
2092  @param Value the source value
2093 }
2094 procedure TZParamsSQLDA.UpdateBytes(const Index: Integer; Value: TByteDynArray);
2095 var
2096  SQLCode: SmallInt;
2097  Stream: TStream;
2098  Len: Integer;
2099 begin
2100  CheckRange(Index);
2101 // SetFieldType(Index, Length(Value) + 1, SQL_TEXT + 1, 0);
2102  {$R-}
2103  with FXSQLDA.sqlvar[Index] do
2104  begin
2105  if (sqlind <> nil) and (sqlind^ = -1) then
2106  Exit;
2107  SQLCode := (sqltype and not(1));
2108  case SQLCode of
2109  SQL_TEXT : EncodeBytes(SQL_TEXT, Index, Value);
2110  SQL_VARYING : EncodeBytes(SQL_VARYING, Index, Value);
2111  SQL_LONG : PInteger (sqldata)^ := Round(ZStrToFloat(BytesToStr(Value)) * IBScaleDivisor[sqlscale]); //AVZ
2112  SQL_SHORT : PInteger (sqldata)^ := StrToInt(String(BytesToStr(Value)));
2113  SQL_TYPE_DATE : EncodeString(SQL_DATE, Index, BytesToStr(Value));
2114  SQL_DOUBLE : PDouble (sqldata)^ := ZStrToFloat(BytesToStr(Value)) * IBScaleDivisor[sqlscale]; //AVZ
2115  SQL_D_FLOAT,
2116  SQL_FLOAT : PSingle (sqldata)^ := ZStrToFloat(BytesToStr(Value)) * IBScaleDivisor[sqlscale]; //AVZ
2117  SQL_INT64 : PInt64(sqldata)^ := Trunc(ZStrToFloat(BytesToStr(Value)) * IBScaleDivisor[sqlscale]); //AVZ - INT64 value was not recognized
2118  SQL_BLOB, SQL_QUAD:
2119  begin
2120  Stream := TMemoryStream.Create;
2121  try
2122  Len := Length(Value);
2123  Stream.Size := Len;
2124  System.Move(Pointer(Value)^, TMemoryStream(Stream).Memory^, Len);
2125  WriteBlob(index, Stream);
2126  finally
2127  Stream.Free;
2128  end;
2129  end;
2130  else
2131  raise EZIBConvertError.Create(SErrorConvertion);
2132  end;
2133  if (sqlind <> nil) then
2134  sqlind^ := 0; // not null
2135  end;
2136  {$IFOPT D+}
2137 {$R+}
2138 {$ENDIF}
2139 end;
2140 
2141 {**
2142  Set up parameter Date value
2143  @param Index the target parameter index
2144  @param Value the source value
2145 }
2146 procedure TZParamsSQLDA.UpdateDate(const Index: Integer; Value: TDateTime);
2147 begin
2148  SetFieldType(Index, sizeof(Integer), SQL_TYPE_DATE + 1, 0);
2149  UpdateDateTime(Index, Value);
2150 end;
2151 
2152 {**
2153  Set up parameter DateTime value
2154  @param Index the target parameter index
2155  @param Value the source value
2156 }
2157 procedure TZParamsSQLDA.UpdateDateTime(const Index: Integer;
2158  Value: TDateTime);
2159 var
2160  y, m, d: word;
2161  hr, min, sec, msec: word;
2162  SQLCode: SmallInt;
2163  TmpDate: TCTimeStructure;
2164 begin
2165  CheckRange(Index);
2166  {$R-}
2167  with FXSQLDA.sqlvar[Index] do
2168  begin
2169  DecodeDate(Value, y, m, d);
2170  DecodeTime(Value, hr, min, sec, msec);
2171  TmpDate.tm_year := y - 1900;
2172  TmpDate.tm_mon := m - 1;
2173  TmpDate.tm_mday := d;
2174  TmpDate.tm_hour := hr;
2175  TmpDate.tm_min := min;
2176  TmpDate.tm_sec := sec;
2177  TmpDate.tm_wday := 0;
2178  TmpDate.tm_yday := 0;
2179  TmpDate.tm_isdst := 0;
2180 
2181  if (sqlind <> nil) and (sqlind^ = -1) then
2182  Exit;
2183  SQLCode := (sqltype and not(1));
2184 
2185  case SQLCode of
2186  SQL_TYPE_DATE : FPlainDriver.isc_encode_sql_date(@TmpDate, PISC_DATE(sqldata));
2187  SQL_TYPE_TIME : begin
2188  FPlainDriver.isc_encode_sql_time(@TmpDate, PISC_TIME(sqldata));
2189  PISC_TIME(sqldata)^ := PISC_TIME(sqldata)^ + msec*10;
2190  end;
2191  SQL_TIMESTAMP : begin
2192  FPlainDriver.isc_encode_timestamp(@TmpDate,PISC_TIMESTAMP(sqldata));
2193  PISC_TIMESTAMP(sqldata).timestamp_time :=PISC_TIMESTAMP(sqldata).timestamp_time + msec*10;
2194  end;
2195  else
2196  raise EZIBConvertError.Create(SInvalidState);
2197  end;
2198  if (sqlind <> nil) then
2199  sqlind^ := 0; // not null
2200  end;
2201  {$IFOPT D+}
2202 {$R+}
2203 {$ENDIF}
2204 end;
2205 
2206 {**
2207  Set up parameter Double value
2208  @param Index the target parameter index
2209  @param Value the source value
2210 }
2211 procedure TZParamsSQLDA.UpdateDouble(const Index: Integer; Value: Double);
2212 var
2213  SQLCode: SmallInt;
2214 begin
2215  CheckRange(Index);
2216  SetFieldType(Index, sizeof(double), SQL_DOUBLE + 1, 0);
2217  {$R-}
2218  with FXSQLDA.sqlvar[Index] do
2219  begin
2220  if (sqlind <> nil) and (sqlind^ = -1) then
2221  Exit;
2222  SQLCode := (sqltype and not(1));
2223 
2224  if (sqlscale < 0) then
2225  begin
2226  case SQLCode of
2227  SQL_SHORT : PSmallInt(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
2228  SQL_LONG : PInteger(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
2229  SQL_INT64,
2230  SQL_QUAD : PInt64(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
2231  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2232  else
2233  raise EZIBConvertError.Create(SUnsupportedDataType);
2234  end;
2235  end
2236  else
2237  case SQLCode of
2238  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2239  SQL_LONG : PInteger(sqldata)^ := Trunc(Value);
2240  SQL_D_FLOAT,
2241  SQL_FLOAT : PSingle(sqldata)^ := Value;
2242  SQL_BOOLEAN : PSmallint(sqldata)^ := Trunc(Value);
2243  SQL_SHORT : PSmallint(sqldata)^ := Trunc(Value);
2244  SQL_INT64 : PInt64(sqldata)^ := Trunc(Value);
2245  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(FloatToStr(Value)));
2246  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(FloatToStr(Value)));
2247  else
2248  raise EZIBConvertError.Create(SUnsupportedDataType);
2249  end;
2250  if (sqlind <> nil) then
2251  sqlind^ := 0; // not null
2252  end;
2253  {$IFOPT D+}
2254 {$R+}
2255 {$ENDIF}
2256 end;
2257 
2258 {**
2259  Set up parameter Float value
2260  @param Index the target parameter index
2261  @param Value the source value
2262 }
2263 procedure TZParamsSQLDA.UpdateFloat(const Index: Integer; Value: Single);
2264 var
2265  SQLCode: SmallInt;
2266 begin
2267  CheckRange(Index);
2268  SetFieldType(Index, sizeof(Single), SQL_FLOAT + 1, 1);
2269  {$R-}
2270  with FXSQLDA.sqlvar[Index] do
2271  begin
2272  if (sqlind <> nil) and (sqlind^ = -1) then
2273  Exit;
2274  SQLCode := (sqltype and not(1));
2275 
2276  if (sqlscale < 0) then
2277  begin
2278  case SQLCode of
2279  SQL_SHORT : PSmallInt(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
2280  SQL_LONG : PInteger(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
2281  SQL_INT64,
2282  SQL_QUAD : PInt64(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
2283  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2284  SQL_D_FLOAT,
2285  SQL_FLOAT : PSingle(sqldata)^ := Value;
2286  else
2287  raise EZIBConvertError.Create(SUnsupportedDataType);
2288  end;
2289  end
2290  else
2291  case SQLCode of
2292  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2293  SQL_LONG : PInteger(sqldata)^ := Trunc(Value);
2294  SQL_D_FLOAT,
2295  SQL_FLOAT : PSingle(sqldata)^ := Value;
2296  SQL_BOOLEAN : PSmallint(sqldata)^ := Trunc(Value);
2297  SQL_SHORT : PSmallint(sqldata)^ := Trunc(Value);
2298  SQL_INT64 : PInt64(sqldata)^ := Trunc(Value);
2299  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(FloatToStr(Value)));
2300  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(FloatToStr(Value)));
2301  else
2302  raise EZIBConvertError.Create(SUnsupportedDataType);
2303  end;
2304  if (sqlind <> nil) then
2305  sqlind^ := 0; // not null
2306  end;
2307  {$IFOPT D+}
2308 {$R+}
2309 {$ENDIF}
2310 end;
2311 
2312 {**
2313  Set up parameter integer value
2314  @param Index the target parameter index
2315  @param Value the source value
2316 }
2317 procedure TZParamsSQLDA.UpdateInt(const Index: Integer; Value: Integer);
2318 var
2319  SQLCode: SmallInt;
2320 begin
2321  CheckRange(Index);
2322  SetFieldType(Index, sizeof(Integer), SQL_LONG + 1, 0);
2323  {$R-}
2324  with FXSQLDA.sqlvar[Index] do
2325  begin
2326  if (sqlind <> nil) and (sqlind^ = -1) then
2327  Exit;
2328  SQLCode := (sqltype and not(1));
2329 
2330  if (sqlscale < 0) then
2331  begin
2332  case SQLCode of
2333  SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2334  SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2335  SQL_INT64,
2336  SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2337  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2338  else
2339  raise EZIBConvertError.Create(SUnsupportedDataType);
2340  end;
2341  end
2342  else
2343  case SQLCode of
2344  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2345  SQL_LONG : PInteger(sqldata)^ := Value;
2346  SQL_D_FLOAT,
2347  SQL_FLOAT : PSingle(sqldata)^ := Value;
2348  SQL_BOOLEAN : PSmallint(sqldata)^ := Value;
2349  SQL_SHORT : PSmallint(sqldata)^ := Value;
2350  SQL_INT64 : PInt64(sqldata)^ := Value;
2351  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(IntToStr(Value)));
2352  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(IntToStr(Value)));
2353  else
2354  raise EZIBConvertError.Create(SUnsupportedDataType);
2355  end;
2356  if (sqlind <> nil) then
2357  sqlind^ := 0; // not null
2358  end;
2359  {$IFOPT D+}
2360 {$R+}
2361 {$ENDIF}
2362 end;
2363 
2364 {**
2365  Set up parameter Long value
2366  @param Index the target parameter index
2367  @param Value the source value
2368 }
2369 procedure TZParamsSQLDA.UpdateLong(const Index: integer; Value: Int64);
2370 var
2371  SQLCode: SmallInt;
2372 begin
2373  CheckRange(Index);
2374  SetFieldType(Index, sizeof(Int64), SQL_INT64 + 1, 0);
2375  {$R-}
2376  with FXSQLDA.sqlvar[Index] do
2377  begin
2378  if (sqlind <> nil) and (sqlind^ = -1) then
2379  Exit;
2380  SQLCode := (sqltype and not(1));
2381 
2382  if (sqlscale < 0) then
2383  begin
2384  case SQLCode of
2385  SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2386  SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2387  SQL_INT64,
2388  SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2389  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2390  else
2391  raise EZIBConvertError.Create(SUnsupportedDataType);
2392  end;
2393  end
2394  else
2395  case SQLCode of
2396  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2397  SQL_LONG : PInteger(sqldata)^ := Value;
2398  SQL_D_FLOAT,
2399  SQL_FLOAT : PSingle(sqldata)^ := Value;
2400  SQL_BOOLEAN : PSmallint(sqldata)^ := Value;
2401  SQL_SHORT : PSmallint(sqldata)^ := Value;
2402  SQL_INT64 : PInt64(sqldata)^ := Value;
2403  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(IntToStr(Value)));
2404  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(IntToStr(Value)));
2405  else
2406  raise EZIBConvertError.Create(SUnsupportedDataType);
2407  end;
2408  if (sqlind <> nil) then
2409  sqlind^ := 0; // not null
2410  end;
2411  {$IFOPT D+}
2412 {$R+}
2413 {$ENDIF}
2414 end;
2415 
2416 {**
2417  Set up parameter null value
2418  @param Index the target parameter index
2419  @param Value the source value
2420 }
2421 procedure TZParamsSQLDA.UpdateNull(const Index: Integer; Value: boolean);
2422 begin
2423  CheckRange(Index);
2424  {$R-}
2425  with FXSQLDA.sqlvar[Index] do
2426  if (sqlind <> nil) then
2427  case Value of
2428  True : sqlind^ := -1; //NULL
2429  False : sqlind^ := 0; //NOT NULL
2430  end;
2431  {$IFOPT D+}
2432 {$R+}
2433 {$ENDIF}
2434 end;
2435 
2436 {**
2437  Set up parameter PAnsiChar value
2438  @param Index the target parameter index
2439  @param Value the source value
2440 }
2441 procedure TZParamsSQLDA.UpdatePChar(const Index: Integer; Value: PAnsiChar);
2442 var
2443  TempString: AnsiString;
2444 begin
2445  TempString := Value;
2446  UpdateString(Index, TempString);
2447 end;
2448 
2449 {**
2450  Set up parameter Interbase QUAD value
2451  @param Index the target parameter index
2452  @param Value the source value
2453 }
2454 procedure TZParamsSQLDA.UpdateQuad(const Index: Word; const Value: TISC_QUAD);
2455 begin
2456  CheckRange(Index);
2457  SetFieldType(Index, sizeof(TISC_QUAD), SQL_QUAD + 1, 0);
2458  {$R-}
2459  with FXSQLDA.sqlvar[Index] do
2460  if not ((sqlind <> nil) and (sqlind^ = -1)) then
2461  begin
2462  case (sqltype and not(1)) of
2463  SQL_QUAD, SQL_DOUBLE, SQL_INT64, SQL_BLOB, SQL_ARRAY: PISC_QUAD(sqldata)^ := Value;
2464  else
2465  raise EZIBConvertError.Create(SUnsupportedDataType);
2466  end;
2467  if (sqlind <> nil) then
2468  sqlind^ := 0; // not null
2469  end
2470  else
2471  raise EZIBConvertError.Create(SUnsupportedDataType);
2472  {$IFOPT D+}
2473 {$R+}
2474 {$ENDIF}
2475 end;
2476 
2477 {**
2478  Set up parameter short value
2479  @param Index the target parameter index
2480  @param Value the source value
2481 }
2482 procedure TZParamsSQLDA.UpdateShort(const Index: Integer; Value: SmallInt);
2483 var
2484  SQLCode: SmallInt;
2485 begin
2486  CheckRange(Index);
2487  SetFieldType(Index, sizeof(Smallint), SQL_SHORT + 1, 0);
2488  {$R-}
2489  with FXSQLDA.sqlvar[Index] do
2490  begin
2491  if (sqlind <> nil) and (sqlind^ = -1) then
2492  Exit;
2493  SQLCode := (sqltype and not(1));
2494 
2495  if (sqlscale < 0) then
2496  begin
2497  case SQLCode of
2498  SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2499  SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2500  SQL_INT64,
2501  SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
2502  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2503  else
2504  raise EZIBConvertError.Create(SUnsupportedDataType);
2505  end;
2506  end
2507  else
2508  case SQLCode of
2509  SQL_DOUBLE : PDouble(sqldata)^ := Value;
2510  SQL_LONG : PInteger(sqldata)^ := Value;
2511  SQL_D_FLOAT,
2512  SQL_FLOAT : PSingle(sqldata)^ := Value;
2513  SQL_BOOLEAN : PSmallint(sqldata)^ := Value;
2514  SQL_SHORT : PSmallint(sqldata)^ := Value;
2515  SQL_INT64 : PInt64(sqldata)^ := Value;
2516  SQL_TEXT : EncodeString(SQL_TEXT, Index, AnsiString(IntToStr(Value)));
2517  SQL_VARYING : EncodeString(SQL_VARYING, Index, AnsiString(IntToStr(Value)));
2518  else
2519  raise EZIBConvertError.Create(SUnsupportedDataType);
2520  end;
2521  if (sqlind <> nil) then
2522  sqlind^ := 0; // not null
2523  end;
2524  {$IFOPT D+}
2525 {$R+}
2526 {$ENDIF}
2527 end;
2528 
2529 {**
2530  Set up parameter String value
2531  @param Index the target parameter index
2532  @param Value the source value
2533 }
2534 
2535 procedure TZParamsSQLDA.UpdateString(const Index: Integer; Value: RawByteString);
2536 var
2537  SQLCode: SmallInt;
2538  Stream: TStream;
2539 begin
2540  CheckRange(Index);
2541 // SetFieldType(Index, Length(Value) + 1, SQL_TEXT + 1, 0);
2542  {$R-}
2543  with FXSQLDA.sqlvar[Index] do
2544  begin
2545  if (sqlind <> nil) and (sqlind^ = -1) then
2546  Exit;
2547  SQLCode := (sqltype and not(1));
2548  case SQLCode of
2549  SQL_TEXT : EncodeString(SQL_TEXT, Index, Value);
2550  SQL_VARYING : EncodeString(SQL_VARYING, Index, Value);
2551  SQL_LONG : PInteger (sqldata)^ := StrToInt(String(Value)); //AVZ
2552  SQL_SHORT : PSmallInt (sqldata)^ := StrToInt(String(Value));
2553  SQL_TYPE_DATE : EncodeString(SQL_DATE, Index, Value);
2554  SQL_DOUBLE : PDouble (sqldata)^ := ZStrToFloat(Value) * IBScaleDivisor[sqlscale]; //AVZ
2555  SQL_D_FLOAT,
2556  SQL_FLOAT : PSingle (sqldata)^ := ZStrToFloat(Value) * IBScaleDivisor[sqlscale]; //AVZ
2557  SQL_INT64 : PInt64(sqldata)^ := Trunc(ZStrToFloat(Value) * IBScaleDivisor[sqlscale]); //AVZ - INT64 value was not recognized
2558  SQL_BLOB, SQL_QUAD:
2559  begin
2560  Stream := TStringStream.Create(Value);
2561  try
2562  WriteBlob(index, Stream);
2563  finally
2564  Stream.Free;
2565  end;
2566  end;
2567  else
2568  raise EZIBConvertError.Create(SErrorConvertion);
2569  end;
2570  if (sqlind <> nil) then
2571  sqlind^ := 0; // not null
2572  end;
2573  {$IFOPT D+}
2574 {$R+}
2575 {$ENDIF}
2576 end;
2577 
2578 {**
2579  Set up parameter Time value
2580  @param Index the target parameter index
2581  @param Value the source value
2582 }
2583 procedure TZParamsSQLDA.UpdateTime(const Index: Integer; Value: TDateTime);
2584 begin
2585  SetFieldType(Index, sizeof(Cardinal), SQL_TYPE_TIME + 1, 0);
2586  UpdateDateTime(Index, Value);
2587 end;
2588 
2589 {**
2590  Set up parameter Timestamp value
2591  @param Index the target parameter index
2592  @param Value the source value
2593 }
2594 procedure TZParamsSQLDA.UpdateTimestamp(const Index: Integer; Value: TDateTime);
2595 begin
2596  SetFieldType(Index, sizeof(TISC_QUAD), SQL_TIMESTAMP + 1, 0);
2597  UpdateDateTime(Index, Value);
2598 end;
2599 
2600 {**
2601  Write stream to blob field
2602  @param Index an index field number
2603  @param Stream the souse data stream
2604 }
2605 procedure TZParamsSQLDA.WriteBlob(const Index: Integer; Stream: TStream);
2606 var
2607  Buffer: PAnsiChar;
2608  BlobId: TISC_QUAD;
2609  BlobHandle: TISC_BLOB_HANDLE;
2610  StatusVector: TARRAY_ISC_STATUS;
2611  BlobSize, CurPos, SegLen: Integer;
2612 begin
2613  BlobHandle := 0;
2614  Stream.Seek(0, 0);
2615 
2616  { create blob handle }
2617  FPlainDriver.isc_create_blob2(@StatusVector, FHandle, FTransactionHandle,
2618  @BlobHandle, @BlobId, 0, nil);
2619  CheckInterbase6Error(FPlainDriver, StatusVector);
2620 
2621  Stream.Position := 0;
2622  BlobSize := Stream.Size;
2623  Buffer := AllocMem(BlobSize);
2624  Try
2625  Stream.ReadBuffer(Buffer^, BlobSize);
2626 
2627  { put data to blob }
2628  CurPos := 0;
2629  SegLen := DefaultBlobSegmentSize;
2630  while (CurPos < BlobSize) do
2631  begin
2632  if (CurPos + SegLen > BlobSize) then
2633  SegLen := BlobSize - CurPos;
2634  if FPlainDriver.isc_put_segment(@StatusVector, @BlobHandle, SegLen,
2635  PAnsiChar(@Buffer[CurPos])) > 0 then
2636  CheckInterbase6Error(FPlainDriver, StatusVector);
2637  Inc(CurPos, SegLen);
2638  end;
2639 
2640  { close blob handle }
2641  FPlainDriver.isc_close_blob(@StatusVector, @BlobHandle);
2642  CheckInterbase6Error(FPlainDriver, StatusVector);
2643 
2644  Stream.Seek(0, 0);
2645  UpdateQuad(Index, BlobId);
2646  Finally
2647  Freemem(Buffer);
2648  End;
2649 end;
2650 
2651 { TResultSQLDA }
2652 
2653 {**
2654  Decode Interbase field value to pascal string
2655  @param Code the Interbase data type
2656  @param Index field index
2657  @result the field string
2658 }
2659 function TZResultSQLDA.DecodeString(const Code: Smallint;
2660  const Index: Word): RawByteString;
2661 var
2662  l: integer;
2663  procedure SetAnsi(Ansi: PAnsiChar; Len: Longint);
2664  begin
2665  SetLength(Result, Len);
2666  System.Move(Ansi^, PAnsiChar(Result)^, Len);
2667  end;
2668 begin
2669  {$R-}
2670  with FXSQLDA.sqlvar[Index] do
2671  case Code of
2672  SQL_TEXT:
2673  begin
2674  SetAnsi(sqldata, sqllen);
2675  // Trim only spaces. TrimRight also removes other characters)
2676  l := sqllen;
2677  while (l > 0) and (Result[l] = ' ') do
2678  dec(l);
2679  if l < sqllen then
2680  result := copy(result, 1, l);
2681  end;
2682  SQL_VARYING : SetAnsi(PISC_VARYING(sqldata).str, PISC_VARYING(sqldata).strlen);
2683  end;
2684  {$IFOPT D+}
2685 {$R+}
2686 {$ENDIF}
2687 end;
2688 
2689 {**
2690  Decode Interbase field value to pascal string
2691  @param Code the Interbase data type
2692  @param Index field index
2693  @param Str the field string
2694 }
2695 procedure TZResultSQLDA.DecodeString2(const Code: Smallint; const Index: Word;
2696  out Str: RawByteString);
2697 begin
2698  Str := DecodeString(Code, Index);
2699 end;
2700 
2701 {**
2702  Return BigDecimal field value
2703  @param Index the field index
2704  @return the field BigDecimal value
2705 }
2706 function TZResultSQLDA.GetBigDecimal(const Index: Integer): Extended;
2707 var
2708  SQLCode: SmallInt;
2709 begin
2710  CheckRange(Index);
2711  {$R-}
2712  with FXSQLDA.sqlvar[Index] do
2713  begin
2714  Result := 0;
2715  if (sqlind <> nil) and (sqlind^ = -1) then
2716  Exit;
2717  SQLCode := (sqltype and not(1));
2718 
2719  if (sqlscale < 0) then
2720  begin
2721  case SQLCode of
2722  SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
2723  SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
2724  SQL_INT64,
2725  SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
2726  SQL_DOUBLE : Result := PDouble(sqldata)^;
2727  else
2728  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2729  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2730  end;
2731  end
2732  else
2733  case SQLCode of
2734  SQL_DOUBLE : Result := PDouble(sqldata)^;
2735  SQL_LONG : Result := PInteger(sqldata)^;
2736  SQL_D_FLOAT,
2737  SQL_FLOAT : Result := PSingle(sqldata)^;
2738  SQL_BOOLEAN : Result := PSmallint(sqldata)^;
2739  SQL_SHORT : Result := PSmallint(sqldata)^;
2740  SQL_INT64 : Result := PInt64(sqldata)^;
2741  SQL_TEXT : Result := StrToFloat(String(DecodeString(SQL_TEXT, Index)));
2742  SQL_VARYING : Result := StrToFloat(String(DecodeString(SQL_VARYING, Index)));
2743  else
2744  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2745  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2746  end;
2747  end;
2748  {$IFOPT D+}
2749 {$R+}
2750 {$ENDIF}
2751 end;
2752 
2753 {**
2754  Return Boolean field value
2755  @param Index the field index
2756  @return the field boolean value
2757 }
2758 function TZResultSQLDA.GetBoolean(const Index: Integer): Boolean;
2759 var
2760  SQLCode: SmallInt;
2761 begin
2762  CheckRange(Index);
2763  {$R-}
2764  with FXSQLDA.sqlvar[Index] do
2765  begin
2766  Result := False;
2767  if (sqlind <> nil) and (sqlind^ = -1) then
2768  Exit;
2769  SQLCode := (sqltype and not(1));
2770 
2771  if (sqlscale < 0) then
2772  begin
2773  case SQLCode of
2774  SQL_SHORT : Result := PSmallInt(sqldata)^ div IBScaleDivisor[sqlscale] <> 0;
2775  SQL_LONG : Result := PInteger(sqldata)^ div IBScaleDivisor[sqlscale] <> 0;
2776  SQL_INT64,
2777  SQL_QUAD : Result := PInt64(sqldata)^ div IBScaleDivisor[sqlscale] <> 0;
2778  SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^) > 0;
2779  else
2780  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2781  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2782  end;
2783  end
2784  else
2785  case SQLCode of
2786  SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^) <> 0;
2787  SQL_LONG : Result := PInteger(sqldata)^ <> 0;
2788  SQL_D_FLOAT,
2789  SQL_FLOAT : Result := Trunc(PSingle(sqldata)^) <> 0;
2790  SQL_BOOLEAN : Result := PSmallint(sqldata)^ <> 0;
2791  SQL_SHORT : Result := PSmallint(sqldata)^ <> 0;
2792  SQL_INT64 : Result := PInt64(sqldata)^ <> 0;
2793  SQL_TEXT : Result := StrToInt(String(DecodeString(SQL_TEXT, Index))) <> 0;
2794  SQL_VARYING : Result := StrToInt(String(DecodeString(SQL_VARYING, Index))) <> 0;
2795  else
2796  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2797  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2798  end;
2799  end;
2800  {$IFOPT D+}
2801 {$R+}
2802 {$ENDIF}
2803 end;
2804 
2805 {**
2806  Return Byte field value
2807  @param Index the field index
2808  @return the field Byte value
2809 }
2810 function TZResultSQLDA.GetByte(const Index: Integer): Byte;
2811 begin
2812  Result := Byte(GetShort(Index));
2813 end;
2814 
2815 {**
2816  Return Bytes field value
2817  @param Index the field index
2818  @return the field Bytes value
2819 }
2820 function TZResultSQLDA.GetBytes(const Index: Integer): TByteDynArray;
2821 var
2822  SQLCode: SmallInt;
2823 begin
2824  CheckRange(Index);
2825  Result := nil;
2826  {$R-}
2827  with FXSQLDA.sqlvar[Index] do
2828  begin
2829  if (sqlind <> nil) and (sqlind^ = -1) then
2830  Exit;
2831  SQLCode := (sqltype and not(1));
2832 
2833  case SQLCode of
2834  SQL_TEXT, SQL_VARYING:
2835  begin
2836  SetLength(Result, sqllen);
2837  System.Move(PAnsiChar(sqldata)^, Pointer(Result)^, sqllen);
2838  end;
2839  else
2840  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2841  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2842  end;
2843  end;
2844  {$IFOPT D+}
2845 {$R+}
2846 {$ENDIF}
2847 end;
2848 
2849 {**
2850  Return Date field value
2851  @param Index the field index
2852  @return the field Date value
2853 }
2854 function TZResultSQLDA.GetDate(const Index: Integer): TDateTime;
2855 begin
2856  Result := Trunc(GetTimestamp(Index));
2857 end;
2858 
2859 {**
2860  Return Double field value
2861  @param Index the field index
2862  @return the field Double value
2863 }
2864 function TZResultSQLDA.GetDouble(const Index: Integer): Double;
2865 var
2866  SQLCode: SmallInt;
2867 begin
2868  CheckRange(Index);
2869  {$R-}
2870  with FXSQLDA.sqlvar[Index] do
2871  begin
2872  Result := 0;
2873  if (sqlind <> nil) and (sqlind^ = -1) then
2874  Exit;
2875  SQLCode := (sqltype and not(1));
2876 
2877  if (sqlscale < 0) then
2878  begin
2879  case SQLCode of
2880  SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
2881  SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
2882  SQL_INT64,
2883  SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
2884  SQL_DOUBLE : Result := PDouble(sqldata)^;
2885  else
2886  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2887  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2888  end;
2889  end
2890  else
2891  case SQLCode of
2892  SQL_DOUBLE : Result := PDouble(sqldata)^;
2893  SQL_LONG : Result := PInteger(sqldata)^;
2894  SQL_D_FLOAT,
2895  SQL_FLOAT : Result := PSingle(sqldata)^;
2896  SQL_BOOLEAN : Result := PSmallint(sqldata)^;
2897  SQL_SHORT : Result := PSmallint(sqldata)^;
2898  SQL_INT64 : Result := PInt64(sqldata)^;
2899  SQL_TEXT : Result := StrToFloat(String(DecodeString(SQL_TEXT, Index)));
2900  SQL_VARYING : Result := StrToFloat(String(DecodeString(SQL_VARYING, Index)));
2901  else
2902  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2903  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2904  end;
2905  end;
2906  {$IFOPT D+}
2907 {$R+}
2908 {$ENDIF}
2909 end;
2910 
2911 {**
2912  Return Float field value
2913  @param Index the field index
2914  @return the field Float value
2915 }
2916 function TZResultSQLDA.GetFloat(const Index: Integer): Single;
2917 var
2918  SQLCode: SmallInt;
2919 begin
2920  CheckRange(Index);
2921  {$R-}
2922  with FXSQLDA.sqlvar[Index] do
2923  begin
2924  Result := 0;
2925  if (sqlind <> nil) and (sqlind^ = -1) then
2926  Exit;
2927  SQLCode := (sqltype and not(1));
2928 
2929  if (sqlscale < 0) then
2930  begin
2931  case SQLCode of
2932  SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
2933  SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
2934  SQL_INT64,
2935  SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
2936  SQL_DOUBLE : Result := PDouble(sqldata)^;
2937  else
2938  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2939  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2940  end;
2941  end
2942  else
2943  case SQLCode of
2944  SQL_DOUBLE : Result := PDouble(sqldata)^;
2945  SQL_LONG : Result := PInteger(sqldata)^;
2946  SQL_D_FLOAT,
2947  SQL_FLOAT : Result := PSingle(sqldata)^;
2948  SQL_BOOLEAN : Result := PSmallint(sqldata)^;
2949  SQL_SHORT : Result := PSmallint(sqldata)^;
2950  SQL_INT64 : Result := PInt64(sqldata)^;
2951  SQL_TEXT : Result := StrToFloat(String(DecodeString(SQL_TEXT, Index)));
2952  SQL_VARYING : Result := StrToFloat(String(DecodeString(SQL_VARYING, Index)));
2953  else
2954  raise EZIBConvertError.Create(Format(SErrorConvertionField,
2955  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
2956  end;
2957  end;
2958  {$IFOPT D+}
2959 {$R+}
2960 {$ENDIF}
2961 end;
2962 
2963 {**
2964  Return Integer field value
2965  @param Index the field index
2966  @return the field Integer value
2967 }
2968 function TZResultSQLDA.GetInt(const Index: Integer): Integer;
2969 begin
2970  Result := Integer(GetLong(Index));
2971 end;
2972 
2973 {**
2974  Return Long field value
2975  @param Index the field index
2976  @return the field Long value
2977 }
2978 function TZResultSQLDA.GetLong(const Index: Integer): Int64;
2979 var
2980  SQLCode: SmallInt;
2981 begin
2982  CheckRange(Index);
2983  {$R-}
2984  with FXSQLDA.sqlvar[Index] do
2985  begin
2986  Result := 0;
2987  if (sqlind <> nil) and (sqlind^ = -1) then
2988  Exit;
2989  SQLCode := (sqltype and not(1));
2990 
2991  if (sqlscale < 0) then
2992  begin
2993  case SQLCode of
2994  SQL_SHORT : Result := PSmallInt(sqldata)^ div IBScaleDivisor[sqlscale];
2995  SQL_LONG : Result := PInteger(sqldata)^ div IBScaleDivisor[sqlscale];
2996  SQL_INT64,
2997  SQL_QUAD : Result := PInt64(sqldata)^ div IBScaleDivisor[sqlscale];
2998  SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
2999  else
3000  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3001  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3002  end;
3003  end
3004  else
3005  case SQLCode of
3006  SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
3007  SQL_LONG : Result := PInteger(sqldata)^;
3008  SQL_D_FLOAT,
3009  SQL_FLOAT : Result := Trunc(PSingle(sqldata)^);
3010  SQL_BOOLEAN : Result := PSmallint(sqldata)^;
3011  SQL_SHORT : Result := PSmallint(sqldata)^;
3012  SQL_INT64 : Result := PInt64(sqldata)^;
3013  SQL_TEXT : Result := StrToInt(String(DecodeString(SQL_TEXT, Index)));
3014  SQL_VARYING : Result := StrToInt(String(DecodeString(SQL_VARYING, Index)));
3015  else
3016  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3017  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3018  end;
3019  end;
3020  {$IFOPT D+}
3021 {$R+}
3022 {$ENDIF}
3023 end;
3024 
3025 {**
3026  Return PAnsiChar field value
3027  @param Index the field index
3028  @return the field PAnsiChar value
3029 }
3030 function TZResultSQLDA.GetPChar(const Index: Integer): PChar;
3031 var
3032  TempStr: String;
3033 begin
3034  TempStr := ZDbcString(GetString(Index));
3035  Result := PChar(TempStr);
3036 end;
3037 
3038 {**
3039  Return Short field value
3040  @param Index the field index
3041  @return the field Short value
3042 }
3043 function TZResultSQLDA.GetShort(const Index: Integer): SmallInt;
3044 var
3045  SQLCode: SmallInt;
3046 begin
3047  CheckRange(Index);
3048  {$R-}
3049  with FXSQLDA.sqlvar[Index] do
3050  begin
3051  Result := 0;
3052  if (sqlind <> nil) and (sqlind^ = -1) then
3053  Exit;
3054  SQLCode := (sqltype and not(1));
3055 
3056  if (sqlscale < 0) then
3057  begin
3058  case SQLCode of
3059  SQL_SHORT : Result := PSmallInt(sqldata)^ div IBScaleDivisor[sqlscale];
3060  SQL_LONG : Result := PInteger(sqldata)^ div IBScaleDivisor[sqlscale];
3061  SQL_INT64,
3062  SQL_QUAD : Result := PInt64(sqldata)^ div IBScaleDivisor[sqlscale];
3063  SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
3064  else
3065  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3066  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3067  end;
3068  end
3069  else
3070  case SQLCode of
3071  SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
3072  SQL_LONG : Result := PInteger(sqldata)^;
3073  SQL_D_FLOAT,
3074  SQL_FLOAT : Result := Trunc(PSingle(sqldata)^);
3075  SQL_BOOLEAN : Result := PSmallint(sqldata)^;
3076  SQL_SHORT : Result := PSmallint(sqldata)^;
3077  SQL_INT64 : Result := PInt64(sqldata)^;
3078  SQL_TEXT : Result := StrToInt(String(DecodeString(SQL_TEXT, Index)));
3079  SQL_VARYING : Result := StrToInt(String(DecodeString(SQL_VARYING, Index)));
3080  else
3081  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3082  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3083  end;
3084  end;
3085  {$IFOPT D+}
3086 {$R+}
3087 {$ENDIF}
3088 end;
3089 
3090 {**
3091  Return String field value
3092  @param Index the field index
3093  @return the field String value
3094 }
3095 function TZResultSQLDA.GetString(const Index: Integer): RawByteString;
3096 var
3097  SQLCode: SmallInt;
3098  TempAnsi: AnsiString;
3099 begin
3100  CheckRange(Index);
3101  Result := '';
3102  {$R-}
3103  with FXSQLDA.sqlvar[Index] do
3104  begin
3105  if (sqlind <> nil) and (sqlind^ = -1) then
3106  Exit;
3107  SQLCode := (sqltype and not(1));
3108 
3109  if (sqlscale < 0) then
3110  begin
3111  case SQLCode of
3112  SQL_SHORT : Result := RawByteString(FloatToStr(PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale]));
3113  SQL_LONG : Result := RawByteString(FloatToStr(PInteger(sqldata)^ / IBScaleDivisor[sqlscale]));
3114  SQL_INT64,
3115  SQL_QUAD : Result := RawByteString(FloatToStr(PInt64(sqldata)^ / IBScaleDivisor[sqlscale]));
3116  SQL_DOUBLE : Result := RawByteString(FloatToStr(PDouble(sqldata)^));
3117  else
3118  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3119  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3120  end;
3121  end
3122  else
3123  case SQLCode of
3124  SQL_DOUBLE : Result := RawByteString(FloatToStr(PDouble(sqldata)^));
3125  SQL_LONG : Result := RawByteString(IntToStr(PInteger(sqldata)^));
3126  SQL_D_FLOAT,
3127  SQL_FLOAT : Result := RawByteString(FloatToStr(PSingle(sqldata)^));
3128  SQL_BOOLEAN :
3129  if Boolean(PSmallint(sqldata)^) = True then
3130  Result := 'YES'
3131  else
3132  Result := 'NO';
3133  SQL_SHORT : Result := RawByteString(IntToStr(PSmallint(sqldata)^));
3134  SQL_INT64 : Result := RawByteString(IntToStr(PInt64(sqldata)^));
3135  SQL_TEXT : DecodeString2(SQL_TEXT, Index, Result);
3136  SQL_VARYING : DecodeString2(SQL_VARYING, Index, Result);
3137  SQL_BLOB : if VarIsEmpty(FDefaults[Index]) then
3138  begin
3139  ReadBlobFromString(Index, TempAnsi);
3140  FDefaults[Index] := TempAnsi;
3141  end
3142  else
3143  Result := {$IFDEF WITH_FPC_STRING_CONVERSATION}AnsiString{$ELSE}RawByteString{$ENDIF}(FDefaults[Index]);
3144 
3145  else
3146  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3147  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3148  end;
3149  end;
3150  {$IFOPT D+}
3151 {$R+}
3152 {$ENDIF}
3153 end;
3154 
3155 {**
3156  Return Time field value
3157  @param Index the field index
3158  @return the field Time value
3159 }
3160 function TZResultSQLDA.GetTime(const Index: Integer): TDateTime;
3161 begin
3162  Result := Frac(GetTimestamp(Index));
3163 end;
3164 
3165 {**
3166  Return Timestamp field value
3167  @param Index the field index
3168  @return the field Timestamp value
3169 }
3170 function TZResultSQLDA.GetTimestamp(const Index: Integer): TDateTime;
3171 var
3172  TempDate: TCTimeStructure;
3173 begin
3174  CheckRange(Index);
3175  {$R-}
3176  with FXSQLDA.sqlvar[Index] do
3177  begin
3178  Result := 0;
3179  if (sqlind <> nil) and (sqlind^ = -1) then
3180  Exit;
3181 
3182  case (sqltype and not(1)) of
3183  SQL_TIMESTAMP : begin
3184  FPlainDriver.isc_decode_timestamp(PISC_TIMESTAMP(sqldata), @TempDate);
3185  Result := SysUtils.EncodeDate(TempDate.tm_year + 1900,
3186  TempDate.tm_mon + 1, TempDate.tm_mday) + EncodeTime(TempDate.tm_hour,
3187  TempDate.tm_min, TempDate.tm_sec, Word((PISC_TIMESTAMP(sqldata).timestamp_time mod 10000) div 10));
3188  end;
3189  SQL_TYPE_DATE : begin
3190  FPlainDriver.isc_decode_sql_date(PISC_DATE(sqldata), @TempDate);
3191  Result := SysUtils.EncodeDate(Word(TempDate.tm_year + 1900),
3192  Word(TempDate.tm_mon + 1), Word(TempDate.tm_mday));
3193  end;
3194  SQL_TYPE_TIME : begin
3195  FPlainDriver.isc_decode_sql_time(PISC_TIME(sqldata), @TempDate);
3196  Result := SysUtils.EncodeTime(Word(TempDate.tm_hour), Word(TempDate.tm_min),
3197  Word(TempDate.tm_sec), Word((PISC_TIME(sqldata)^ mod 10000) div 10));
3198  end;
3199  else
3200  Result := Trunc(GetDouble(Index));
3201  end;
3202  end;
3203  {$IFOPT D+}
3204 {$R+}
3205 {$ENDIF}
3206 end;
3207 
3208 {**
3209  Indicate field null
3210  @param Index the field index
3211  @return true if fied value NULL overwise false
3212 }
3213 function TZResultSQLDA.IsNull(const Index: Integer): Boolean;
3214 begin
3215  CheckRange(Index);
3216  {$R-}
3217  with FXSQLDA.sqlvar[Index] do
3218  Result := (sqlind <> nil) and (sqlind^ = ISC_NULL);
3219  {$IFOPT D+}
3220 {$R+}
3221 {$ENDIF}
3222 end;
3223 
3224 {**
3225  Return Interbase QUAD field value
3226  @param Index the field index
3227  @return the field Interbase QUAD value
3228 }
3229 function TZResultSQLDA.GetQuad(const Index: Integer): TISC_QUAD;
3230 begin
3231  CheckRange(Index);
3232  {$R-}
3233  with FXSQLDA.sqlvar[Index] do
3234  if not ((sqlind <> nil) and (sqlind^ = -1)) then
3235  case (sqltype and not(1)) of
3236  SQL_QUAD, SQL_DOUBLE, SQL_INT64, SQL_BLOB, SQL_ARRAY: result := PISC_QUAD(sqldata)^;
3237  else
3238  raise EZIBConvertError.Create(SUnsupportedDataType + ' ' + inttostr((sqltype and not(1))));
3239  end
3240  else
3241  raise EZIBConvertError.Create('Invalid State.');
3242  {$IFOPT D+}
3243 {$R+}
3244 {$ENDIF}
3245 end;
3246 
3247 {**
3248  Return Variant field value
3249  @param Index the field index
3250  @return the field Variant value
3251 }
3252 function TZResultSQLDA.GetValue(const Index: Word): Variant;
3253 var
3254  SQLCode: SmallInt;
3255 begin
3256  CheckRange(Index);
3257  with FXSQLDA.sqlvar[Index] do
3258  begin
3259  VarClear(Result);
3260  if (sqlind <> nil) and (sqlind^ = -1) then
3261  Exit;
3262  SQLCode := (sqltype and not(1));
3263 
3264  if (sqlscale < 0) then
3265  begin
3266  case SQLCode of
3267  SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
3268  SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
3269  SQL_INT64,
3270  SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
3271  SQL_DOUBLE : Result := PDouble(sqldata)^;
3272  else
3273  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3274  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3275  end;
3276  end
3277  else
3278  case SQLCode of
3279  SQL_DOUBLE : Result := PDouble(sqldata)^;
3280  SQL_TIMESTAMP : Result := GetTimestamp(Index);
3281  SQL_TYPE_DATE : Result := GetDate(Index);
3282  SQL_TYPE_TIME : Result := GetTime(Index);
3283  SQL_LONG : Result := PInteger(sqldata)^;
3284  SQL_D_FLOAT,
3285  SQL_FLOAT : Result := PSingle(sqldata)^;
3286  SQL_BOOLEAN:
3287  begin
3288  if FPlainDriver.GetProtocol <> 'interbase-7' then
3289  raise EZIBConvertError.Create(SUnsupportedDataType);
3290  Result := IntToStr(PSmallint(sqldata)^);
3291  end;
3292  SQL_SHORT : Result := PSmallint(sqldata)^;
3293  SQL_INT64 : Result := PInt64(sqldata)^;
3294  SQL_TEXT : Result := DecodeString(SQL_TEXT, Index);
3295  SQL_VARYING : Result := DecodeString(SQL_VARYING, Index);
3296  SQL_BLOB : if VarIsEmpty(FDefaults[Index]) then
3297  begin
3298  ReadBlobFromVariant(Index, FDefaults[Index]);
3299  Result := FDefaults[Index];
3300  end
3301  else
3302  Result := Double(FDefaults[Index]);
3303  else
3304  raise EZIBConvertError.Create(Format(SErrorConvertionField,
3305  [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
3306  end;
3307  end;
3308 end;
3309 
3310 destructor TZResultSQLDA.Destroy;
3311 begin
3312  FreeParamtersValues;
3313  FreeMem(FXSQLDA);
3314  inherited Destroy;
3315 end;
3316 
3317 {**
3318  Read blob data to string
3319  @param Index an filed index
3320  @param Str destination string
3321 }
3322 procedure TZResultSQLDA.ReadBlobFromString(const Index: Word; var Str: AnsiString);
3323 var
3324  Size: LongInt;
3325  Buffer: Pointer;
3326 begin
3327  ReadBlobBufer(FPlainDriver, FHandle, FTransactionHandle, GetQuad(Index),
3328  Size, Buffer);
3329  try
3330  SetLength(Str, Size);
3331  SetString(Str, PAnsiChar(Buffer), Size);
3332  finally
3333  FreeMem(Buffer, Size);
3334  end;
3335 end;
3336 
3337 {**
3338  Read blob data to stream
3339  @param Index an filed index
3340  @param Stream destination stream object
3341 }
3342 procedure TZResultSQLDA.ReadBlobFromStream(const Index: Word; Stream: TStream);
3343 var
3344  Size: LongInt;
3345  Buffer: Pointer;
3346 begin
3347  ReadBlobBufer(FPlainDriver, FHandle, FTransactionHandle, GetQuad(Index),
3348  Size, Buffer);
3349  try
3350  Stream.Seek(0, 0);
3351  Stream.Write(Buffer^, Size);
3352  Stream.Seek(0, 0);
3353  finally
3354  FreeMem(Buffer, Size);
3355  end;
3356 end;
3357 
3358 {**
3359  Read blob data to variant value
3360  @param Index an filed index
3361  @param Value destination variant value
3362 }
3363 procedure TZResultSQLDA.ReadBlobFromVariant(const Index: Word;
3364  var Value: Variant);
3365 var
3366  Size: LongInt;
3367  Buffer: Pointer;
3368  PData: Pointer;
3369 begin
3370  ReadBlobBufer(FPlainDriver, FHandle, FTransactionHandle, GetQuad(Index),
3371  Size, Buffer);
3372  Value := VarArrayCreate([0, Size-1], varByte);
3373  PData := VarArrayLock(Value);
3374  try
3375  move(Buffer^, PData^, Size);
3376  finally
3377  VarArrayUnlock(Value);
3378  FreeMem(Buffer, Size);
3379  end;
3380 end;
3381 
3382 procedure TZResultSQLDA.AllocateSQLDA;
3383 begin
3384  inherited AllocateSQLDA;
3385  SetLength(FDefaults, GetFieldCount);
3386 end;
3387 
3388 
3389 end.
3390